Update PUI to use ffi-curl
[sxemacs] / contrib / smtpmail.el.patch
1 --- smtpmail.el 2006-03-08 10:12:55.000000000 +0000
2 +++ smtpmail.el.mod     2007-03-19 12:03:47.000000000 +0000
3 @@ -441,6 +441,29 @@
4  (defsubst smtpmail-cred-cert (cred)
5    (nth 3 cred))
6  
7 +(defsubst smtpmail-cred-ca (cred)
8 +  (let* ((optca (nthcdr 4 cred)))
9 +    (when optca
10 +      (car optca))))
11 +
12 +(defsubst smtpmail-push-cred-key (key)
13 +  (when (and (stringp key)
14 +             (file-regular-p key))
15 +    (push (expand-file-name key) starttls-extra-arguments)
16 +    (push "--x509keyfile" starttls-extra-arguments)))
17 +
18 +(defsubst smtpmail-push-cred-cert (cert)
19 +  (when (and (stringp cert)
20 +             (file-regular-p cert))
21 +    (push (expand-file-name cert) starttls-extra-arguments)
22 +    (push "--x509certfile" starttls-extra-arguments)))
23 +
24 +(defsubst smtpmail-push-cred-ca (ca)
25 +  (when (and (stringp ca)
26 +             (file-regular-p ca))
27 +    (push (expand-file-name ca) starttls-extra-arguments)
28 +    (push "--x509cafile" starttls-extra-arguments)))
29 +
30  (defsubst smtpmail-cred-passwd (cred)
31    (nth 3 cred))
32  
33 @@ -469,38 +492,7 @@
34  (defvar starttls-extra-arguments)
35  
36  (defun smtpmail-open-stream (process-buffer host port)
37 -  (let ((cred (smtpmail-find-credentials
38 -              smtpmail-starttls-credentials host port)))
39 -    (if (null (and cred (condition-case ()
40 -                           (with-no-warnings
41 -                             (require 'starttls)
42 -                             (call-process (if starttls-use-gnutls
43 -                                               starttls-gnutls-program
44 -                                             starttls-program)))
45 -                         (error nil))))
46 -       ;; The normal case.
47 -       (open-network-stream "SMTP" process-buffer host port)
48 -      (let* ((cred-key (smtpmail-cred-key cred))
49 -            (cred-cert (smtpmail-cred-cert cred))
50 -            (starttls-extra-args
51 -             (append
52 -              starttls-extra-args
53 -              (when (and (stringp cred-key) (stringp cred-cert)
54 -                         (file-regular-p
55 -                          (setq cred-key (expand-file-name cred-key)))
56 -                         (file-regular-p
57 -                          (setq cred-cert (expand-file-name cred-cert))))
58 -                (list "--key-file" cred-key "--cert-file" cred-cert))))
59 -            (starttls-extra-arguments
60 -             (append
61 -              starttls-extra-arguments
62 -              (when (and (stringp cred-key) (stringp cred-cert)
63 -                         (file-regular-p
64 -                          (setq cred-key (expand-file-name cred-key)))
65 -                         (file-regular-p
66 -                          (setq cred-cert (expand-file-name cred-cert))))
67 -                (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
68 -       (starttls-open-stream "SMTP" process-buffer host port)))))
69 +  (open-network-stream "SMTP" process-buffer host port))
70  
71  (defun smtpmail-try-auth-methods (process supported-extensions host port)
72    (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
73 @@ -668,19 +660,32 @@
74                                (smtpmail-warn-about-unknown-extensions
75                               (message "Unknown extension %s" name)))))))
76  
77 -           (if (and do-starttls
78 -                    (smtpmail-find-credentials smtpmail-starttls-credentials host port)
79 -                    (member 'starttls supported-extensions)
80 -                    (numberp (process-id process)))
81 -               (progn
82 -                 (smtpmail-send-command process (format "STARTTLS"))
83 -                 (if (or (null (car (setq response-code (smtpmail-read-response process))))
84 -                         (not (integerp (car response-code)))
85 -                         (>= (car response-code) 400))
86 -                     (throw 'done nil))
87 -                 (starttls-negotiate process)
88 -                 (setq do-starttls nil))
89 -             (setq do-ehlo nil))))
90 +            (let* ((cred (smtpmail-find-credentials
91 +                          smtpmail-starttls-credentials host port))
92 +                   (cred-key (smtpmail-cred-key cred))
93 +                   (cred-cert (smtpmail-cred-cert cred))
94 +                   (cred-ca (smtpmail-cred-ca cred)))
95 +              (if (and do-starttls cred
96 +                       (member 'starttls supported-extensions)
97 +                       (process-live-p process))
98 +                  (progn
99 +                    (smtpmail-send-command process (format "STARTTLS"))
100 +                    (when (or (null
101 +                               (car (setq response-code
102 +                                          (smtpmail-read-response process))))
103 +                              (not (integerp (car response-code)))
104 +                              (>= (car response-code) 400))
105 +                      (throw 'done nil))
106 +                    (let* (starttls-extra-arguments)
107 +                      (smtpmail-push-cred-key cred-key)
108 +                      (smtpmail-push-cred-cert cred-cert)
109 +                      (smtpmail-push-cred-ca cred-ca)
110 +                      (starttls-negotiate process))
111 +                    (setq do-starttls nil))
112 +                (setq do-ehlo nil)))))
113 +
114 +            (unless (process-live-p process)
115 +              (throw 'done nil))
116  
117             (smtpmail-try-auth-methods process supported-extensions host port)