cgit.sxemacs.org Git - sxemacs/blob - contrib/pop3.el.patch

   1 --- pop3.el     2007-08-15 12:30:12.000000000 +0000
   2 +++ pop3.el.mod 2007-08-15 12:30:30.000000000 +0000
   3 @@ -142,6 +142,9 @@
   4  (defvar pop3-utab nil
   5    "Uidl hash table.")
   6
   7 +(defvar pop3-stream-type nil
   8 +  "Defined dynamically in Gnus")
   9 +
  10  ;;;###autoload
  11  (defun pop3-nnmail-movemail (inbox crashbox)
  12    "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
  13 @@ -187,6 +190,9 @@
  14      (message (format "Retrieving message list...%d unread" message-count))
  15      ;; now get messages
  16      (unwind-protect
  17 +        (with-current-buffer
  18 +            (get-buffer-create "*POP3 sessions*")
  19 +          (insert (format "Message count %d\n" message-count)))
  20         (while (<= n message-count)
  21           (setq msgid (car (car message-list)))
  22           (setq msglen (cdr (car message-list)))
  23 @@ -204,14 +210,23 @@
  24                        pop3-retr-regexp
  25                        (not (string-match pop3-retr-regexp
  26                                           (pop3-top process msgid)))))
  27 -             (message (format "Ignoring message %d of %d from %s..."
  28 -                              n message-count pop3-mailhost))
  29 +             (with-current-buffer
  30 +                    (get-buffer-create "*POP3 sessions*")
  31 +                  (insert (format "Ignoring %S\n" msgid))
  32 +                  (message (format "Ignoring message %d of %d from %s..."
  33 +                                   n message-count pop3-mailhost)))
  34             (message (format "Retrieving message %d of %d from %s..."
  35                              n message-count pop3-mailhost))
  36             (if (pop3-retr process msgid crashbuf)
  37 -               (setq retrieved-messages (cons msgid retrieved-messages))
  38 -             (message (format "Retrieving message %d of %d from %s...ignored"
  39 -                              n message-count pop3-mailhost))))
  40 +               (with-current-buffer
  41 +                    (get-buffer-create "*POP3 sessions*")
  42 +                  (insert (format "not ignored %S\n" msgid))
  43 +                  (setq retrieved-messages (cons msgid retrieved-messages)))
  44 +              (with-current-buffer
  45 +                  (get-buffer-create "*POP3 sessions*")
  46 +                (insert (format "ignored %S\n" msgid))
  47 +                (message (format "Retrieving message %d of %d from %s...ignored"
  48 +                                 n message-count pop3-mailhost)))))
  49           ;; deleted a whole bunch of stuff here that updates the crashbox
  50           ;; incrementally. This is way slow and mostly uneccessary, gnus
  51           ;; and others will simply slurp the whole mail buffer anyway so
  52 @@ -226,6 +241,8 @@
  53         (pop3-save-uidls))
  54        ;; now delete the messages we have retrieved
  55        (unless (and pop3-leave-mail-on-server (null pop3-delete-retrieved-mail))
  56 +        (with-current-buffer (get-buffer-create "*POP3 sessions*")
  57 +          (insert (format "Messages: %S\n" retrieved-messages)))
  58         (mapcar
  59          '(lambda (n)
  60             (message (format "Deleting message %d of %d from %s..."
  61 @@ -244,18 +261,36 @@
  62         (process)
  63         (coding-system-for-read 'binary)
  64         (coding-system-for-write 'binary))
  65 -    (save-excursion
  66 -      (set-buffer process-buffer)
  67 -      (erase-buffer))
  68 -    (setq process
  69 -         (open-network-stream "POP" process-buffer mailhost port))
  70 -    (setq pop3-read-point (point-min))
  71 -    (let ((response (pop3-read-response process t)))
  72 -      (setq pop3-timestamp
  73 -           (substring response (or (string-match "<" response) 0)
  74 -                      (+ 1 (or (string-match ">" response) -1)))))
  75 -    process
  76 -    ))
  77 +    (flet ((maybe-handshake (proc)
  78 +             (when (featurep (and 'openssl 'openssl-ssl))
  79 +               (unless (ossl-ssl-handshake proc 'ssl23)
  80 +                 (error "Cannot establish TLS connection")))))
  81 +      (save-excursion
  82 +        (set-buffer process-buffer)
  83 +        (erase-buffer))
  84 +      (setq process
  85 +            (open-network-stream "POP" process-buffer mailhost port))
  86 +
  87 +      (when (eq pop3-stream-type 'ssl)
  88 +        (maybe-handshake process))
  89 +
  90 +      (when (process-live-p process)
  91 +        (setq pop3-read-point (point-min))
  92 +        (let ((response (pop3-read-response process t)))
  93 +          (setq pop3-timestamp
  94 +                (substring response (or (string-match "<" response) 0)
  95 +                           (+ 1 (or (string-match ">" response) -1))))))
  96 +
  97 +      (when (eq pop3-stream-type 'starttls)
  98 +        (pop3-send-command process "STLS")
  99 +        (let ((response (pop3-read-response process t)))
 100 +          ;; waiting for the +OK STLS
 101 +          (unless (and response (string-match "STLS" response))
 102 +            (error "STLS not provided on remote machine")))
 103 +        (maybe-handshake process))
 104 +
 105 +      process
 106 +      )))
 107
 108  ;; Support functions
 109
 110 @@ -268,9 +303,10 @@
 111  (defun pop3-send-command (process command)
 112      (set-buffer (process-buffer process))
 113      (goto-char (point-max))
 114 -;;    (if (= (aref command 0) ?P)
 115 -;;     (insert "PASS <omitted>\r\n")
 116 -;;      (insert command "\r\n"))
 117 +    (with-current-buffer (get-buffer-create "*POP3 sessions*")
 118 +      (if (= (aref command 0) ?P)
 119 +          (insert "PASS <omitted>\r\n")
 120 +        (insert command "\r\n")))
 121      (setq pop3-read-point (point))
 122      (goto-char (point-max))
 123      (process-send-string process (concat command "\r\n"))