Question

有人可以通过SSL / TLS向我发送一个Common Lisp库（特别是Linux上的SBCL）吗？ Cl-pop似乎很好，但它似乎不支持SSL，我不知道如何将其包装到CL+SSL（假设它是可能的）。有没有人提出任何建议？

Answer 1

您可以重新定义usocket-connect函数以生成SSL库返回的流类型。然后，您可以使用常规字符串定义通过此流发送和接收数据的方法（SSL库默认情况下仅支持二进制文件，但CL-POP假定可以发送字符串）。您需要依赖FLEXI-STREAMS库来在文本和二进制文件之间进行转换。 (ql:quickload :flexi-streams)

以下是进行更改并定义所需方法的代码。由于usocket-connect被替换，我提供了:unencrypted关键字来创建常规套接字。

代码可能会更有效率。

string-to-octets和octets-to-string函数支持:external-format参数，允许它们编码/解码许多字符编码方案，包括UTF-8，ISO-8859- *等。支持的编码的完整列表是documented here。我在此答案中没有使用:external-format，因此默认为:latin-1。

代码是针对旧版本的CL + SSL编写的，似乎已由Debian软件包管理器安装在我的系统上。当前版本的make-ssl-client-stream和make-ssl-server-stream支持的关键字参数多于我的计算机上的版本所支持的关键字参数。但是，这并不重要，因为CL-POP不会使用这些关键字参数。

(defpackage :ssl-pop
  (:use :common-lisp :cl+ssl :usocket :flexi-streams))

(in-package :ssl-pop)    

(let ((old-connect (symbol-function 'socket-connect)))
  (defun socket-connect (host port &key (protocol :stream)
                         external-format certificate key crypto-password
                         (clientp t) close-callback unencrypted
                         (unwrap-streams-p t) crypto-hostname
                         (element-type '(unsigned-byte 8)) timeout deadline
                         (nodelay t nodelay-specified) local-host
                         local-port)
    (let* ((old-connect-args
            `(,host ,port :protocol ,protocol
                    :element-type ,element-type
                    :timeout ,timeout :deadline ,deadline
                    ,@(if nodelay-specified
                          `(:nodelay ,nodelay))
                    :local-host ,local-host
                    :local-port ,local-port))
           (plain-socket (apply old-connect old-connect-args)))
      (if unencrypted
          plain-socket
          (let ((socket-stream (socket-stream plain-socket)))
            (assert (streamp socket-stream))
            (if clientp
                (make-ssl-client-stream socket-stream
                                        :external-format external-format
                                        :certificate certificate
                                        :key key 
                                        :close-callback close-callback)
                (make-ssl-server-stream socket-stream
                                        :external-format external-format
                                        :certificate certificate
                                        :key key)))))))

(defmethod socket-stream ((object cl+ssl::ssl-stream))
  object)

(defmethod socket-receive ((socket cl+ssl::ssl-stream) buffer length
                           &key (element-type '(unsigned-byte 8)))
  (let ((buffer (or buffer (make-array length
                                       :element-type element-type))))
    (loop for ix from 0 below length
         do
         (restart-case
             (setf (aref buffer ix) (read-byte socket))
           (thats-ok () :report "Return the bytes that were successfully read"
                (return-from socket-receive (subseq buffer 0 ix)))))
    buffer))

(defmethod socket-send ((socket cl+ssl::ssl-stream) buffer length
                        &key host port)
  (declare (ignore host port)) ;; They're for UDP
  (loop for byte across buffer
       do (write-byte byte socket)))

(defmethod sb-gray:stream-read-line ((socket cl+ssl::ssl-stream))
  (let ((result (make-array 0 :adjustable t :fill-pointer t
                            :element-type '(unsigned-byte 8))))
    (loop for next-byte = (read-byte socket)
          until (and (>= (length result) 1)
                     (= next-byte 10)
                     (= (aref result (- (length result) 1)) 13))
         do
         (vector-push-extend next-byte result))
    (octets-to-string
     (concatenate 'vector
                  (subseq result 0 (- (length result) 1))))))

(defmethod trivial-gray-streams:stream-write-sequence
    ((stream cl+ssl::ssl-stream) (sequence string) start end
     &key &allow-other-keys)
  (trivial-gray-streams:stream-write-sequence stream
                                              (string-to-octets sequence)
                                              start end))

(defmethod sb-gray:stream-write-char ((stream cl+ssl::ssl-stream)
                                      (char character))
  (let ((string (make-string 1 :initial-element char)))
    (write-sequence (string-to-octets string) stream)))

(defmethod socket-close ((socket cl+ssl::ssl-stream))
  (close socket))

Common Lisp中的Pop3 over SSL / TLS

1 个答案: