Common Lisp 中的基于 SSL/TLS 的 Pop3

Question

任何人都可以指点我一个 Common Lisp 库（特别是针对 Linux 上的 SBCL）来通过 SSL/TLS 提取 pop3 电子邮件吗？ Cl-pop看起来不错，但它似乎不支持 SSL，我不确定如何将它包装到CL+SSL（假设可能）中。除了自己动手之外，有人有什么建议吗？

Answer 1

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

以下是进行更改和定义所需方法的代码。由于usocket-connect是Replace，我提供了:unencrypted关键字来创建一个普通的套接字。

代码可能会更高效。

的string-to-octets和octets-to-string功能支持:external-format参数，该参数允许他们编码/解码许多字符编码方案，包括UTF-8，ISO-8859- *，以及其他。支持的编码的完整列表记录在此处。我没有: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))