From: Lars Magne Ingebrigtsen <larsi@gnus.org>
To: emacs-devel@gnu.org
Subject: Re: netrc field encryption in auth-source
Date: Wed, 15 Jun 2011 23:21:08 +0200 [thread overview]
Message-ID: <m3oc1yu6yj.fsf@quimbies.gnus.org> (raw)
In-Reply-To: m362o7ukvg.fsf@quimbies.gnus.org
[-- Attachment #1: Type: text/plain, Size: 504 bytes --]
Lars Magne Ingebrigtsen <larsi@gnus.org> writes:
> So please apply and I'll get started with the smtpmail.el stuff. :-)
I'm basically done with the smtpmail.el STARTTLS/AUTH/startup things,
and I've tested it with all the error cases I could think of (and beefed
up the error reporting significantly), so I think we're good to go.
But I'll wait until Tuesday to check this in.
It's a pretty big patch, but the good news is that the result is about
50 lines shorter than it was when I started. :-)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: smtpmail.diff --]
[-- Type: text/x-diff, Size: 28848 bytes --]
=== modified file 'lisp/mail/smtpmail.el'
*** lisp/mail/smtpmail.el 2011-05-30 17:23:47 +0000
--- lisp/mail/smtpmail.el 2011-06-15 20:33:56 +0000
***************
*** 34,47 ****
;;
;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
! ;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-debug-info t) ; only to debug problems
;;(setq smtpmail-auth-credentials ; or use ~/.authinfo
;; '(("YOUR SMTP HOST" 25 "username" "password")))
- ;;(setq smtpmail-starttls-credentials
- ;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
;; integer or a string, just as long as they match (eq).
--- 34,45 ----
;;
;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
! ;;(setq smtpmail-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-debug-info t) ; only to debug problems
;;(setq smtpmail-auth-credentials ; or use ~/.authinfo
;; '(("YOUR SMTP HOST" 25 "username" "password")))
;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
;; integer or a string, just as long as they match (eq).
***************
*** 58,74 ****
;; Authentication by the AUTH mechanism.
;; See http://www.ietf.org/rfc/rfc2554.txt
- ;; Modified by Simon Josefsson <simon@josefsson.org>, 2000-10-07, to support
- ;; STARTTLS. Requires external program
- ;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz.
- ;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt
-
;;; Code:
(require 'sendmail)
- (autoload 'starttls-any-program-available "starttls")
- (autoload 'starttls-open-stream "starttls")
- (autoload 'starttls-negotiate "starttls")
(autoload 'mail-strip-quoted-names "mail-utils")
(autoload 'message-make-date "message")
(autoload 'message-make-message-id "message")
--- 56,64 ----
***************
*** 85,95 ****
:group 'mail)
! (defcustom smtpmail-default-smtp-server nil
"Specify default SMTP server.
! This only has effect if you specify it before loading the smtpmail library."
! :type '(choice (const nil) string)
! :group 'smtpmail)
(defcustom smtpmail-smtp-server
(or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
--- 75,83 ----
:group 'mail)
! (defvar smtpmail-default-smtp-server nil
"Specify default SMTP server.
! This only has effect if you specify it before loading the smtpmail library.")
(defcustom smtpmail-smtp-server
(or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
***************
*** 110,115 ****
--- 98,113 ----
:type '(choice (const nil) string)
:group 'smtpmail)
+ (defcustom smtpmail-stream-type nil
+ "Connection type SMTP connections.
+ This may be either nil (plain connection) or `starttls' (use the
+ starttls mechanism to turn on TLS security after opening the
+ stream)."
+ :version "24.1"
+ :group 'smtpmail
+ :type '(choice (const :tag "Plain" nil)
+ (const starttls)))
+
(defcustom smtpmail-sendto-domain nil
"Local domain name without a host name.
This is appended (with an @-sign) to any specified recipients which do
***************
*** 174,195 ****
:version "22.1"
:group 'smtpmail)
- (defcustom smtpmail-starttls-credentials '(("" 25 "" ""))
- "Specify STARTTLS keys and certificates for servers.
- This is a list of four-element list with `servername' (a string),
- `port' (an integer), `key' (a filename) and `certificate' (a
- filename).
- If you do not have a certificate/key pair, leave the `key' and
- `certificate' fields as `nil'. A key/certificate pair is only
- needed if you want to use X.509 client authenticated
- connections."
- :type '(repeat (list (string :tag "Server")
- (integer :tag "Port")
- (file :tag "Key")
- (file :tag "Certificate")))
- :version "21.1"
- :group 'smtpmail)
-
(defcustom smtpmail-warn-about-unknown-extensions nil
"If set, print warnings about unknown SMTP extensions.
This is mainly useful for development purposes, to learn about
--- 172,177 ----
***************
*** 230,235 ****
--- 212,218 ----
(tembuf (generate-new-buffer " smtpmail temp"))
(case-fold-search nil)
delimline
+ result
(mailbuf (current-buffer))
;; Examine this variable now, so that
;; local binding in the mail buffer will take effect.
***************
*** 373,381 ****
;; Send or queue
(if (not smtpmail-queue-mail)
(if (not (null smtpmail-recipient-address-list))
! (if (not (smtpmail-via-smtp
! smtpmail-recipient-address-list tembuf))
! (error "Sending failed; SMTP protocol error"))
(error "Sending failed; no recipients"))
(let* ((file-data
(expand-file-name
--- 356,365 ----
;; Send or queue
(if (not smtpmail-queue-mail)
(if (not (null smtpmail-recipient-address-list))
! (when (setq result
! (smtpmail-via-smtp
! smtpmail-recipient-address-list tembuf))
! (error "Sending failed: %s" result))
(error "Sending failed; no recipients"))
(let* ((file-data
(expand-file-name
***************
*** 432,438 ****
;; mail, send it, etc...
(let ((file-msg "")
(qfile (expand-file-name smtpmail-queue-index-file
! smtpmail-queue-dir)))
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
--- 416,423 ----
;; mail, send it, etc...
(let ((file-msg "")
(qfile (expand-file-name smtpmail-queue-index-file
! smtpmail-queue-dir))
! result)
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
***************
*** 448,464 ****
(or (and mail-specify-envelope-from (mail-envelope-from))
user-mail-address)))
(if (not (null smtpmail-recipient-address-list))
! (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
! (current-buffer)))
! (error "Sending failed; SMTP protocol error"))
(error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
(delete-region (point-at-bol) (point-at-bol 2)))
(write-region (point-min) (point-max) qfile))))
- ;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
-
(defun smtpmail-fqdn ()
(if smtpmail-local-domain
(concat (system-name) "." smtpmail-local-domain)
--- 433,448 ----
(or (and mail-specify-envelope-from (mail-envelope-from))
user-mail-address)))
(if (not (null smtpmail-recipient-address-list))
! (when (setq result (smtpmail-via-smtp
! smtpmail-recipient-address-list
! (current-buffer)))
! (error "Sending failed: %s" result))
(error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
(delete-region (point-at-bol) (point-at-bol 2)))
(write-region (point-min) (point-max) qfile))))
(defun smtpmail-fqdn ()
(if smtpmail-local-domain
(concat (system-name) "." smtpmail-local-domain)
***************
*** 503,548 ****
(push el2 result)))
(nreverse result)))
- (defvar starttls-extra-args)
- (defvar starttls-extra-arguments)
-
- (defun smtpmail-open-stream (process-buffer host port)
- (let ((cred (smtpmail-find-credentials
- smtpmail-starttls-credentials host port)))
- (if (null (and cred (starttls-any-program-available)))
- ;; 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
- (append
- 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
- (append
- 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)))))
-
;; `password-read' autoloads password-cache.
(declare-function password-cache-add "password-cache" (key password))
! (defun smtpmail-try-auth-methods (process supported-extensions host port)
(let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
(mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
(auth-info (auth-source-search :max 1
:host host
! :port (or port "smtp")))
(auth-user (plist-get (nth 0 auth-info) :user))
(auth-pass (plist-get (nth 0 auth-info) :secret))
(auth-pass (if (functionp auth-pass)
--- 487,511 ----
(push el2 result)))
(nreverse result)))
;; `password-read' autoloads password-cache.
(declare-function password-cache-add "password-cache" (key password))
! (defun smtpmail-command-or-throw (process string &optional code)
! (let (ret)
! (smtpmail-send-command process string)
! (unless (smtpmail-ok-p (setq ret (smtpmail-read-response process))
! code)
! (throw 'done (smtpmail-response-text ret)))
! ret))
!
! (defun smtpmail-try-auth-methods (process supported-extensions host port
! &optional ask-for-password)
(let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
(mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
(auth-info (auth-source-search :max 1
:host host
! :port (or port "smtp")
! :create ask-for-password))
(auth-user (plist-get (nth 0 auth-info) :user))
(auth-pass (plist-get (nth 0 auth-info) :secret))
(auth-pass (if (functionp auth-pass)
***************
*** 571,584 ****
(or (smtpmail-cred-passwd cred)
(password-read prompt prompt))))
ret)
! (when (and cred mech)
(cond
((eq mech 'cram-md5)
! (smtpmail-send-command process (upcase (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))
--- 534,545 ----
(or (smtpmail-cred-passwd cred)
(password-read prompt prompt))))
ret)
! (if (not (and cred mech))
! mech
(cond
((eq mech 'cram-md5)
! (setq ret (smtpmail-command-or-throw
! process (format "AUTH %s" (upcase mech))))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
(decoded (base64-decode-string challenge))
***************
*** 596,648 ****
;; are taken as a response to the server, and the
;; authentication fails.
(encoded (base64-encode-string response t)))
! (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) t))
! (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 t))
! (if (or (null (car (setq ret (smtpmail-read-response process))))
! (not (integerp (car ret)))
! (>= (car ret) 400))
! (throw 'done nil)))
((eq mech 'plain)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
;; is not sent if the server did not advertise AUTH PLAIN in
;; the EHLO response. See RFC 2554 for more info.
! (smtpmail-send-command process
! (concat "AUTH PLAIN "
! (base64-encode-string
! (concat "\0"
! (smtpmail-cred-user cred)
! "\0"
! passwd) t)))
! (if (or (null (car (setq ret (smtpmail-read-response process))))
! (not (integerp (car ret)))
! (not (equal (car ret) 235)))
! (throw 'done nil)))
!
(t
(error "Mechanism %s not implemented" mech)))
;; Remember the password.
(when (null (smtpmail-cred-passwd cred))
! (password-cache-add prompt passwd)))))
! (defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
(let ((process nil)
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
--- 557,610 ----
;; are taken as a response to the server, and the
;; authentication fails.
(encoded (base64-encode-string response t)))
! (smtpmail-command-or-throw process encoded))))
((eq mech 'login)
! (smtpmail-command-or-throw process "AUTH LOGIN")
! (smtpmail-command-or-throw
process (base64-encode-string (smtpmail-cred-user cred) t))
! (smtpmail-command-or-throw process (base64-encode-string passwd t)))
((eq mech 'plain)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
;; is not sent if the server did not advertise AUTH PLAIN in
;; the EHLO response. See RFC 2554 for more info.
! (smtpmail-command-or-throw
! process
! (concat "AUTH PLAIN "
! (base64-encode-string
! (concat "\0"
! (smtpmail-cred-user cred)
! "\0"
! passwd) t))
! 235))
(t
(error "Mechanism %s not implemented" mech)))
;; Remember the password.
(when (null (smtpmail-cred-passwd cred))
! (password-cache-add prompt passwd))
! nil)))
!
! (defun smtpmail-response-code (string)
! (when string
! (with-temp-buffer
! (insert string)
! (goto-char (point-min))
! (and (re-search-forward "^\\([0-9]+\\) " nil t)
! (string-to-number (match-string 1))))))
!
! (defun smtpmail-ok-p (response &optional code)
! (and (car response)
! (integerp (car response))
! (< (car response) 400)
! (or (null code)
! (= code (car response)))))
!
! (defun smtpmail-response-text (response)
! (mapconcat 'identity (cdr response) "\n"))
! (defun smtpmail-via-smtp (recipient smtpmail-text-buffer
! &optional ask-for-password)
(let ((process nil)
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
***************
*** 654,667 ****
(mail-envelope-from))
user-mail-address))
response-code
- greeting
process-buffer
(supported-extensions '()))
(unwind-protect
(catch 'done
;; get or create the trace buffer
(setq process-buffer
! (get-buffer-create (format "*trace of SMTP session to %s*" host)))
;; clear the trace buffer of old output
(with-current-buffer process-buffer
--- 616,631 ----
(mail-envelope-from))
user-mail-address))
response-code
process-buffer
+ result
+ auth-mechanisms
(supported-extensions '()))
(unwind-protect
(catch 'done
;; get or create the trace buffer
(setq process-buffer
! (get-buffer-create
! (format "*trace of SMTP session to %s*" host)))
;; clear the trace buffer of old output
(with-current-buffer process-buffer
***************
*** 669,773 ****
(erase-buffer))
;; open the connection to the server
! (setq process (smtpmail-open-stream process-buffer host port))
! (and (null process) (throw 'done nil))
;; set the send-filter
(set-process-filter process 'smtpmail-process-filter)
(with-current-buffer process-buffer
(set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
(make-local-variable 'smtpmail-read-point)
(setq smtpmail-read-point (point-min))
!
! (if (or (null (car (setq greeting (smtpmail-read-response process))))
! (not (integerp (car greeting)))
! (>= (car greeting) 400))
! (throw 'done nil))
!
! (let ((do-ehlo t)
! (do-starttls t))
! (while do-ehlo
! ;; EHLO
! (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
!
! (if (or (null (car (setq response-code
! (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (progn
! ;; HELO
! (smtpmail-send-command
! process (format "HELO %s" (smtpmail-fqdn)))
!
! (if (or (null (car (setq response-code
! (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil)))
! (dolist (line (cdr (cdr response-code)))
! (let ((name
! (with-case-table ascii-case-table
! (mapcar (lambda (s) (intern (downcase s)))
! (split-string (substring line 4) "[ ]")))))
! (and (eq (length name) 1)
! (setq name (car name)))
! (and name
! (cond ((memq (if (consp name) (car name) name)
! '(verb xvrb 8bitmime onex xone
! expn size dsn etrn
! enhancedstatuscodes
! help xusr
! auth=login auth starttls))
! (setq supported-extensions
! (cons name supported-extensions)))
! (smtpmail-warn-about-unknown-extensions
! (message "Unknown extension %s" name)))))))
!
! (if (and do-starttls
! (smtpmail-find-credentials smtpmail-starttls-credentials host port)
! (member 'starttls supported-extensions)
! (numberp (process-id process)))
! (progn
! (smtpmail-send-command process (format "STARTTLS"))
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))
! (starttls-negotiate process)
! (setq do-starttls nil))
! (setq do-ehlo nil))))
!
! (smtpmail-try-auth-methods process supported-extensions host port)
!
! (if (or (member 'onex supported-extensions)
! (member 'xone supported-extensions))
! (progn
! (smtpmail-send-command process (format "ONEX"))
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))))
!
! (if (and smtpmail-debug-verb
! (or (member 'verb supported-extensions)
! (member 'xvrb supported-extensions)))
! (progn
! (smtpmail-send-command process (format "VERB"))
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))))
!
! (if (member 'xusr supported-extensions)
! (progn
! (smtpmail-send-command process (format "XUSR"))
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))))
!
;; MAIL FROM:<sender>
(let ((size-part
(if (or (member 'size supported-extensions)
--- 633,719 ----
(erase-buffer))
;; open the connection to the server
! (setq result
! (open-network-stream
! "smtpmail" process-buffer host port
! :type smtpmail-stream-type
! :return-list t
! :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
! :end-of-command "^[0-9]+ .*\r\n"
! :success "^2.*\n"
! :always-query-capabilities t
! :starttls-function
! (lambda (capabilities)
! (and (string-match "-STARTTLS" capabilities)
! "STARTTLS\r\n"))))
!
! ;; If we couldn't access the server at all, we give up.
! (unless (setq process (car result))
! (throw 'done "Unable to contact server"))
;; set the send-filter
(set-process-filter process 'smtpmail-process-filter)
+ (let* ((greeting (plist-get (cdr result) :greeting))
+ (code (smtpmail-response-code greeting)))
+ (unless code
+ (throw 'done (format "No greeting: %s" greeting)))
+ (when (>= code 400)
+ (throw 'done (format "Connection not allowed: %s" greeting))))
+
(with-current-buffer process-buffer
(set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
(make-local-variable 'smtpmail-read-point)
(setq smtpmail-read-point (point-min))
! (let* ((capabilities (plist-get (cdr result) :capabilities))
! (code (smtpmail-response-code capabilities)))
! (if (or (null code)
! (>= code 400))
! ;; The server didn't accept EHLO, so we fall back on HELO.
! (smtpmail-command-or-throw
! process (format "HELO %s" (smtpmail-fqdn)))
! ;; EHLO was successful, so we parse the extensions.
! (dolist (line (delete
! ""
! (split-string
! (plist-get (cdr result) :capabilities)
! "\r\n")))
! (let ((name
! (with-case-table ascii-case-table
! (mapcar (lambda (s) (intern (downcase s)))
! (split-string (substring line 4) "[ ]")))))
! (when (= (length name) 1)
! (setq name (car name)))
! (when name
! (cond ((memq (if (consp name) (car name) name)
! '(verb xvrb 8bitmime onex xone
! expn size dsn etrn
! enhancedstatuscodes
! help xusr
! auth=login auth starttls))
! (setq supported-extensions
! (cons name supported-extensions)))
! (smtpmail-warn-about-unknown-extensions
! (message "Unknown extension %s" name))))))))
!
! (setq auth-mechanisms
! (smtpmail-try-auth-methods
! process supported-extensions host port
! ask-for-password))
!
! (when (or (member 'onex supported-extensions)
! (member 'xone supported-extensions))
! (smtpmail-command-or-throw process (format "ONEX")))
!
! (when (and smtpmail-debug-verb
! (or (member 'verb supported-extensions)
! (member 'xvrb supported-extensions)))
! (smtpmail-command-or-throw process (format "VERB")))
!
! (when (member 'xusr supported-extensions)
! (smtpmail-command-or-throw process (format "XUSR")))
!
;; MAIL FROM:<sender>
(let ((size-part
(if (or (member 'size supported-extensions)
***************
*** 797,861 ****
" BODY=8BITMIME"
"")
"")))
! ;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
! (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
! envelope-from
! size-part
! body-part))
!
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil)))
;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
! (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
! (setq n (1+ n))
!
! (setq response-code (smtpmail-read-response process))
! (if (or (null (car response-code))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))))
!
! ;; DATA
! (smtpmail-send-command process "DATA")
!
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))
! ;; Mail contents
(smtpmail-send-data process smtpmail-text-buffer)
-
;; DATA end "."
! (smtpmail-send-command process ".")
!
! (if (or (null (car (setq response-code (smtpmail-read-response process))))
! (not (integerp (car response-code)))
! (>= (car response-code) 400))
! (throw 'done nil))
!
! ;; QUIT
! ;; (smtpmail-send-command process "QUIT")
! ;; (and (null (car (smtpmail-read-response process)))
! ;; (throw 'done nil))
! t))
! (if process
! (with-current-buffer (process-buffer process)
! (smtpmail-send-command process "QUIT")
! (smtpmail-read-response process)
!
! ;; (if (or (null (car (setq response-code (smtpmail-read-response process))))
! ;; (not (integerp (car response-code)))
! ;; (>= (car response-code) 400))
! ;; (throw 'done nil))
! (delete-process process)
! (unless smtpmail-debug-info
! (kill-buffer process-buffer)))))))
(defun smtpmail-process-filter (process output)
--- 743,795 ----
" BODY=8BITMIME"
"")
"")))
! (smtpmail-command-or-throw
! process (format "MAIL FROM:<%s>%s%s"
! envelope-from size-part body-part)))
;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
! (smtpmail-send-command
! process (format "RCPT TO:<%s>"
! (smtpmail-maybe-append-domain
! (nth n recipient))))
! (cond
! ((smtpmail-ok-p (setq result (smtpmail-read-response process)))
! ;; Success.
! nil)
! ((and auth-mechanisms
! (not ask-for-password)
! (= (car result) 550))
! ;; We got a "550 relay not permitted", and the server
! ;; accepts credentials, so we try again, but ask for a
! ;; password first.
! (smtpmail-send-command process "QUIT")
! (smtpmail-read-response process)
! (delete-process process)
! (throw 'done
! (smtpmail-via-smtp recipient smtpmail-text-buffer t)))
! (t
! ;; Return the error code.
! (throw 'done
! (smtpmail-response-text result))))
! (setq n (1+ n))))
! ;; Send the contents.
! (smtpmail-command-or-throw process "DATA")
(smtpmail-send-data process smtpmail-text-buffer)
;; DATA end "."
! (smtpmail-command-or-throw process ".")
! ;; Return success.
! nil))
! (when (and process
! (buffer-live-p process-buffer))
! (with-current-buffer (process-buffer process)
! (smtpmail-send-command process "QUIT")
! (smtpmail-read-response process)
! (delete-process process)
! (unless smtpmail-debug-info
! (kill-buffer process-buffer)))))))
(defun smtpmail-process-filter (process output)
[-- Attachment #3: Type: text/plain, Size: 103 bytes --]
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog http://lars.ingebrigtsen.no/
next prev parent reply other threads:[~2011-06-15 21:21 UTC|newest]
Thread overview: 203+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-04-23 18:54 Emacs RPC Lars Magne Ingebrigtsen
2011-04-24 3:21 ` T.V. Raman
2011-04-24 20:04 ` Richard Stallman
2011-04-24 20:24 ` Lars Magne Ingebrigtsen
2011-04-25 17:55 ` Richard Stallman
2011-05-01 18:53 ` Lars Magne Ingebrigtsen
2011-05-02 2:13 ` Lars Magne Ingebrigtsen
2011-05-02 21:25 ` Chong Yidong
2011-05-02 22:54 ` Lars Magne Ingebrigtsen
2011-04-24 20:26 ` Daniel Colascione
2011-04-25 17:56 ` Richard Stallman
2011-04-24 17:40 ` Chong Yidong
2011-04-24 18:00 ` Lars Magne Ingebrigtsen
2011-04-24 19:56 ` Chong Yidong
2011-04-25 1:21 ` Ted Zlatanov
2011-04-25 1:26 ` Lars Magne Ingebrigtsen
2011-04-25 2:05 ` Ted Zlatanov
2011-04-25 12:57 ` Stefan Monnier
2011-04-25 12:59 ` Stefan Monnier
2011-04-25 17:00 ` Emacs RPC security (was: Emacs RPC) Ted Zlatanov
2011-04-25 17:35 ` Emacs RPC security Stefan Monnier
2011-04-25 18:02 ` Ted Zlatanov
2011-04-25 18:17 ` Daniel Colascione
2011-04-25 19:43 ` Ted Zlatanov
2011-04-25 18:38 ` Stefan Monnier
2011-04-25 18:57 ` Ted Zlatanov
2011-05-01 18:55 ` Lars Magne Ingebrigtsen
2011-05-01 22:02 ` Lars Magne Ingebrigtsen
2011-05-01 22:19 ` Opportunistic STARTTLS in smtpmail.el (was: Emacs RPC security) Lars Magne Ingebrigtsen
2011-05-02 15:20 ` Opportunistic STARTTLS in smtpmail.el James Cloos
2011-05-02 18:52 ` Ted Zlatanov
2011-05-02 18:59 ` Lars Magne Ingebrigtsen
2011-05-02 19:21 ` Ted Zlatanov
2011-05-02 23:36 ` Lars Magne Ingebrigtsen
2011-05-03 0:29 ` Ted Zlatanov
2011-05-03 1:01 ` Lars Magne Ingebrigtsen
2011-05-03 1:22 ` Ted Zlatanov
2011-05-03 22:04 ` Lars Magne Ingebrigtsen
2011-05-04 1:37 ` Ted Zlatanov
2011-05-30 17:45 ` Lars Magne Ingebrigtsen
2011-05-30 18:07 ` Robert Pluim
2011-05-30 18:14 ` Lars Magne Ingebrigtsen
2011-05-30 18:54 ` Robert Pluim
2011-05-30 19:13 ` Stefan Monnier
2011-05-30 19:43 ` Lars Magne Ingebrigtsen
2011-05-30 23:10 ` Lars Magne Ingebrigtsen
2011-05-31 7:11 ` Robert Pluim
2011-05-31 10:13 ` Ted Zlatanov
2011-05-31 18:19 ` Lars Magne Ingebrigtsen
2011-05-31 19:39 ` Ted Zlatanov
2011-05-31 20:32 ` Lars Magne Ingebrigtsen
2011-06-01 0:37 ` Ted Zlatanov
2011-06-01 1:29 ` Stefan Monnier
2011-06-01 2:04 ` Ted Zlatanov
2011-06-01 12:37 ` Stefan Monnier
2011-06-01 13:34 ` Ted Zlatanov
2011-06-01 14:39 ` Stefan Monnier
2011-06-01 15:14 ` Ted Zlatanov
2011-06-02 4:09 ` Stefan Monnier
2011-06-02 8:57 ` Robert Pluim
2011-06-02 11:45 ` Daiki Ueno
2011-06-02 12:24 ` Stefan Monnier
2011-06-02 14:20 ` Ted Zlatanov
2011-06-02 15:03 ` Daiki Ueno
2011-06-02 15:31 ` Ted Zlatanov
2011-06-03 21:54 ` Lars Magne Ingebrigtsen
2011-06-05 15:11 ` netrc field encryption in auth-source (was: Opportunistic STARTTLS in smtpmail.el) Ted Zlatanov
2011-06-26 10:09 ` netrc field encryption in auth-source Lars Magne Ingebrigtsen
2011-06-27 15:43 ` GPGME (was: netrc field encryption in auth-source) Ted Zlatanov
2011-06-27 21:47 ` GPGME Daiki Ueno
2011-06-28 11:56 ` GPGME Ted Zlatanov
2011-06-28 20:36 ` GPGME Daiki Ueno
2011-06-29 8:07 ` secure plist store Daiki Ueno
2011-06-29 8:25 ` Lars Magne Ingebrigtsen
2011-06-29 9:05 ` Daiki Ueno
2011-06-29 10:46 ` Ted Zlatanov
2011-06-29 11:30 ` Daiki Ueno
2011-06-29 12:38 ` Ted Zlatanov
2011-06-29 13:39 ` Daiki Ueno
2011-06-29 10:54 ` Ted Zlatanov
2011-06-29 11:59 ` Daiki Ueno
2011-06-29 12:58 ` Ted Zlatanov
2011-06-29 14:34 ` Ted Zlatanov
2011-06-29 18:31 ` Daiki Ueno
2011-06-30 12:23 ` Ted Zlatanov
2011-06-30 23:10 ` Daiki Ueno
2011-07-01 13:36 ` Ted Zlatanov
2011-06-29 14:37 ` Ted Zlatanov
2011-06-29 14:36 ` Ted Zlatanov
2011-06-30 7:43 ` Daiki Ueno
2011-06-30 12:19 ` Ted Zlatanov
2011-06-30 13:42 ` Daiki Ueno
2011-06-30 14:54 ` Ted Zlatanov
2011-06-30 22:18 ` Daiki Ueno
2011-06-30 22:34 ` Ted Zlatanov
2011-07-01 2:28 ` Daiki Ueno
2011-07-01 13:18 ` Ted Zlatanov
2011-07-03 2:13 ` Daiki Ueno
2011-06-29 11:09 ` GPGME Ted Zlatanov
2011-06-29 13:15 ` GPGME Daiki Ueno
2011-06-29 17:21 ` GPGME Ted Zlatanov
2011-06-29 18:41 ` GPGME Daiki Ueno
2011-06-30 12:46 ` GPGME Ted Zlatanov
2011-06-02 13:09 ` Opportunistic STARTTLS in smtpmail.el Ted Zlatanov
2011-06-02 13:44 ` Daiki Ueno
2011-06-03 21:50 ` Lars Magne Ingebrigtsen
2011-05-31 1:25 ` Stefan Monnier
2011-05-31 18:21 ` Lars Magne Ingebrigtsen
2011-05-31 21:18 ` Stefan Monnier
2011-06-03 21:48 ` Lars Magne Ingebrigtsen
2011-06-05 14:55 ` Ted Zlatanov
2011-06-09 18:02 ` Lars Magne Ingebrigtsen
2011-06-09 21:06 ` Ted Zlatanov
2011-06-10 16:05 ` netrc field encryption in auth-source (was: Opportunistic STARTTLS in smtpmail.el) Ted Zlatanov
2011-06-13 21:47 ` netrc field encryption in auth-source Ted Zlatanov
2011-06-13 22:21 ` Lars Magne Ingebrigtsen
2011-06-15 16:20 ` Lars Magne Ingebrigtsen
2011-06-15 21:21 ` Lars Magne Ingebrigtsen [this message]
2011-06-16 3:49 ` Ted Zlatanov
2011-06-16 8:32 ` Robert Pluim
2011-06-16 13:35 ` Ted Zlatanov
2011-06-16 20:28 ` Reiner Steib
2011-06-16 21:05 ` Lars Magne Ingebrigtsen
2011-06-17 1:03 ` should docstrings include all defcustom options? (was: netrc field encryption in auth-source) Ted Zlatanov
2011-06-17 7:17 ` netrc field encryption in auth-source Robert Pluim
2011-06-17 9:32 ` Ted Zlatanov
2011-06-17 9:53 ` Robert Pluim
2011-06-17 10:21 ` Ted Zlatanov
2011-06-21 19:32 ` Lars Magne Ingebrigtsen
2011-06-21 19:51 ` Ted Zlatanov
2011-06-21 20:19 ` Committing new smtpmail.el later tonight (was: netrc field encryption in auth-source) Lars Magne Ingebrigtsen
2011-06-21 21:01 ` Committing new smtpmail.el later tonight Lars Magne Ingebrigtsen
2011-06-21 22:07 ` Antoine Levitt
2011-06-21 22:17 ` Lars Magne Ingebrigtsen
2011-06-21 22:25 ` Antoine Levitt
2011-06-21 22:36 ` Lars Magne Ingebrigtsen
2011-06-21 22:46 ` Lars Magne Ingebrigtsen
2011-06-21 22:57 ` Lars Magne Ingebrigtsen
2011-06-22 9:01 ` Antoine Levitt
2011-06-22 8:27 ` Robert Pluim
2011-06-22 8:30 ` Lars Magne Ingebrigtsen
2011-06-22 8:52 ` Robert Pluim
2011-06-22 9:11 ` Lars Magne Ingebrigtsen
2011-06-22 9:17 ` Lars Magne Ingebrigtsen
2011-06-22 9:34 ` Robert Pluim
2011-06-22 9:41 ` Lars Magne Ingebrigtsen
2011-06-22 14:25 ` Lars Magne Ingebrigtsen
2011-06-22 14:49 ` Lars Magne Ingebrigtsen
2011-06-22 17:45 ` Robert Pluim
2011-06-22 18:48 ` Lars Magne Ingebrigtsen
2011-06-23 8:01 ` Robert Pluim
2011-06-22 15:51 ` Ted Zlatanov
2011-06-22 19:24 ` Lars Magne Ingebrigtsen
2011-06-22 20:27 ` Ted Zlatanov
2011-06-22 20:43 ` Lars Magne Ingebrigtsen
2011-06-22 21:36 ` Ted Zlatanov
2011-06-22 2:52 ` Eli Zaretskii
2011-06-22 14:53 ` Lars Magne Ingebrigtsen
2011-06-22 15:50 ` Robert Pluim
2011-06-22 16:19 ` Eli Zaretskii
2011-06-22 17:16 ` Ted Zlatanov
2011-06-22 19:50 ` Eli Zaretskii
2011-06-22 19:56 ` Lars Magne Ingebrigtsen
2011-06-22 21:32 ` Ted Zlatanov
2011-06-22 20:27 ` Stefan Monnier
2011-06-22 20:38 ` Lars Magne Ingebrigtsen
2011-06-22 20:53 ` Lars Magne Ingebrigtsen
2011-06-22 15:55 ` Ted Zlatanov
2011-06-22 16:51 ` Eli Zaretskii
2011-06-22 15:56 ` Ted Zlatanov
2011-06-30 13:16 ` netrc field encryption in auth-source Ted Zlatanov
2011-06-06 15:06 ` Opportunistic STARTTLS in smtpmail.el Stefan Monnier
2011-06-09 17:56 ` Lars Magne Ingebrigtsen
2011-06-10 20:44 ` Stefan Monnier
2011-05-03 15:20 ` client certs and CRL lists for GnuTLS (was: Opportunistic STARTTLS in smtpmail.el) Ted Zlatanov
2011-05-03 15:25 ` client certs and CRL lists for GnuTLS Lars Magne Ingebrigtsen
2011-05-03 15:47 ` Ted Zlatanov
2011-05-03 21:54 ` Lars Magne Ingebrigtsen
2011-05-04 1:39 ` Ted Zlatanov
2011-05-08 20:59 ` Chong Yidong
2011-05-09 10:52 ` Ted Zlatanov
2011-05-09 15:00 ` Chong Yidong
2011-05-09 15:30 ` Gnus ERT tests inside Emacs (was: client certs and CRL lists for GnuTLS) Ted Zlatanov
2011-05-09 15:46 ` Gnus ERT tests inside Emacs David Engster
2011-05-09 15:58 ` Ted Zlatanov
2011-05-11 21:36 ` Ted Zlatanov
2011-05-02 9:37 ` Emacs RPC security Julien Danjou
2011-05-02 18:57 ` Ted Zlatanov
2011-05-02 19:48 ` Stefan Monnier
2011-05-02 19:56 ` Ted Zlatanov
2011-05-02 22:56 ` Lars Magne Ingebrigtsen
2011-05-03 0:25 ` Ted Zlatanov
2011-05-03 0:51 ` Lars Magne Ingebrigtsen
2011-05-03 1:12 ` Ted Zlatanov
2011-05-03 1:16 ` Lars Magne Ingebrigtsen
2011-05-03 1:27 ` Ted Zlatanov
2011-05-03 1:34 ` Lars Magne Ingebrigtsen
2011-05-03 2:35 ` Stefan Monnier
2011-05-03 6:24 ` Harald Hanche-Olsen
2011-05-03 13:47 ` Stefan Monnier
2011-05-03 0:35 ` Stefan Monnier
2011-04-26 12:13 ` Emacs RPC Sebastian Rose
2011-04-26 13:18 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3oc1yu6yj.fsf@quimbies.gnus.org \
--to=larsi@gnus.org \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.