公共Lisp中SSL/TLS上的Pop3

有人能告诉我一个公共Lisp库（特别是Linux上的SBCL）用于通过SSL/TLS拉pop3电子邮件吗？看起来不错，但它似乎不支持SSL，我也不确定如何将其封装到中（假设可能）。除了您自己的滚动之外，还有人有什么建议吗？

您可以重新定义

usocket connect

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

下面是进行更改和定义所需方法的代码。由于

usocketconnect

已被替换，因此我提供

：unencrypted

关键字来创建常规套接字

代码可能会变得更有效

字符串到八位字节

和

八位字节到字符串

函数支持一个

：外部格式

参数，该参数允许对许多字符编码方案进行编码/解码，包括UTF-8、ISO-8859-*等。支持的编码的完整列表如下所示。我在这个答案中没有使用

：外部格式

，所以它默认为

：拉丁语-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))

---

谢谢你尝试一下。但它得到了协议错误：[code]句柄#（SB-SYS:INT-SAP#X0071F720）（返回代码：1）上的SSL库发生故障。SSL错误队列：错误：140770FC:SSL例程：SSL23_GET_SERVER_HELLO:未知协议[类型CL+SSL:：SSL-error-SSL的条件]回溯：0:（CL+SSL:：SSL-SIGNAL-error#（SB-SYS:INT-SAP#X0071F720）#1-1）局部：SB-DEBUG:：ARG-0=#（SB-SYS:INT-SAP#X0071F720）SB-DEBUG:：ARG-1=#SB-DEBUG:：ARG-2=1 SB-DEBUG:：ARG-3=-1[/code]另外，

SB-gray:stream read line

缺少一个paren（看起来应该在

向量推送扩展之后），这是我添加来产生此错误的。这很奇怪。它在我的机器上工作。paren一定是复制/粘贴错误或其他什么。通过连接到未加密的POP服务器，我能够复制涉及
SSL23\u GET\u SERVER\u HELLO
的准确错误代码（140770FC）。加密的POP3使用端口995而不是110。感谢您的持续努力，但我在pop.gmail.com和inbound.att.net上得到的是端口995上的错误，而不是110。