Update PUI to use ffi-curl
[sxemacs] / 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"))