cgit.sxemacs.org Git - sxemacs/blob - 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)