+(defsubst smtpmail-cred-server (cred)
+ (nth 0 cred))
+
+(defsubst smtpmail-cred-port (cred)
+ (nth 1 cred))
+
+(defsubst smtpmail-cred-key (cred)
+ (nth 2 cred))
+
+(defsubst smtpmail-cred-user (cred)
+ (nth 2 cred))
+
+(defsubst smtpmail-cred-cert (cred)
+ (nth 3 cred))
+
+(defsubst smtpmail-cred-passwd (cred)
+ (nth 3 cred))
+
+(defun smtpmail-find-credentials (cred server port)
+ (catch 'done
+ (let ((l cred) el)
+ (while (setq el (pop l))
+ (when (and (equal server (smtpmail-cred-server el))
+ (equal port (smtpmail-cred-port el)))
+ (throw 'done el))))))
+
+(defun smtpmail-maybe-append-domain (recipient)
+ (if (or (not smtpmail-sendto-domain)
+ (string-match "@" recipient))
+ recipient
+ (concat recipient "@" smtpmail-sendto-domain)))
+
+(defun smtpmail-intersection (list1 list2)
+ (let ((result nil))
+ (dolist (el2 list2)
+ (when (memq el2 list1)
+ (push el2 result)))
+ (nreverse result)))
+
+(defun smtpmail-open-stream (process-buffer host port)
+ (let ((cred (smtpmail-find-credentials
+ smtpmail-starttls-credentials host port)))
+ (if (null (and cred (condition-case ()
+ (progn
+ (require 'starttls)
+ (call-process starttls-program))
+ (error nil))))
+ ;; The normal case.
+ (open-network-stream "SMTP" process-buffer host port)
+ (let* ((cred-key (smtpmail-cred-key cred))
+ (cred-cert (smtpmail-cred-cert cred))
+ (starttls-extra-args
+ (when (and (stringp cred-key) (stringp cred-cert)
+ (file-regular-p
+ (setq cred-key (expand-file-name cred-key)))
+ (file-regular-p
+ (setq cred-cert (expand-file-name cred-cert))))
+ (list "--key-file" cred-key "--cert-file" cred-cert)))
+ (starttls-extra-arguments
+ (when (and (stringp cred-key) (stringp cred-cert)
+ (file-regular-p
+ (setq cred-key (expand-file-name cred-key)))
+ (file-regular-p
+ (setq cred-cert (expand-file-name cred-cert))))
+ (list "--x509keyfile" cred-key "--x509certfile" cred-cert))))
+ (starttls-open-stream "SMTP" process-buffer host port)))))
+
+(defun smtpmail-try-auth-methods (process supported-extensions host port)
+ (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
+ (mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
+ (cred (if (stringp smtpmail-auth-credentials)
+ (let* ((netrc (netrc-parse smtpmail-auth-credentials))
+ (port-name (format "%s" (or port "smtp")))
+ (hostentry (netrc-machine netrc host port-name
+ port-name)))
+ (when hostentry
+ (list host port
+ (netrc-get hostentry "login")
+ (netrc-get hostentry "password"))))
+ (smtpmail-find-credentials
+ smtpmail-auth-credentials host port)))
+ (passwd (when cred
+ (or (smtpmail-cred-passwd cred)
+ (read-passwd
+ (format "SMTP password for %s:%s: "
+ (smtpmail-cred-server cred)
+ (smtpmail-cred-port cred))))))
+ ret)
+ (when (and cred mech)
+ (cond
+ ((eq mech 'cram-md5)
+ (smtpmail-send-command process (format "AUTH %s" mech))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil))
+ (when (eq (car ret) 334)
+ (let* ((challenge (substring (cadr ret) 4))
+ (decoded (base64-decode-string challenge))
+ (hash (rfc2104-hash 'md5 64 16 passwd decoded))
+ (response (concat (smtpmail-cred-user cred) " " hash))
+ (encoded (base64-encode-string response)))
+ (smtpmail-send-command process (format "%s" encoded))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil)))))
+ ((eq mech 'login)
+ (smtpmail-send-command process "AUTH LOGIN")
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil))
+ (smtpmail-send-command
+ process (base64-encode-string (smtpmail-cred-user cred)))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil))
+ (smtpmail-send-command process (base64-encode-string passwd))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil)))
+ (t
+ (error "Mechanism %s not implemented" mech)))
+ ;; Remember the password.
+ (when (and (not (stringp smtpmail-auth-credentials))
+ (null (smtpmail-cred-passwd cred)))
+ (setcar (cdr (cdr (cdr cred))) passwd)))))
+