Mercurial > emacs

changeset 18092:8428d56cd207

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(smtpmail-via-smtp): Recognize XVRB as a synonym for VERB and XONE as a synonym for ONEX. (smtpmail-read-response): Add "%s" to `message' calls to avoid problems with percent signs in strings. (smtpmail-read-response): Return all lines of the response text as a list of strings. Formerly only the first line was returned. This is insufficient when one wants to parse e.g. an EHLO response. Ignore responses starting with "0". This is necessary to support the VERB SMTP extension. (smtpmail-via-smtp): Try EHLO and find out which SMTP service extensions the receiving mailer supports. Issue the ONEX and XUSR commands if the corresponding extensions are supported. Issue VERB if supported and `smtpmail-debug-info' is non-nil. Add SIZE attribute to MAIL FROM: command if SIZE extension is supported. Add code that could set the BODY= attribute to MAIL FROM: if the receiving mailer supports 8BITMIME. This is currently disabled, since doing it right might involve adding MIME headers to, and in some cases reencoding, the message.
author Richard M. Stallman <rms@gnu.org>
date Sun, 01 Jun 1997 22:24:22 +0000
parents 1bd633f97c45
children 1e53ce338e0d
files lisp/mail/smtpmail.el
diffstat 1 files changed, 119 insertions(+), 33 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/smtpmail.el	Sun Jun 01 19:31:59 1997 +0000
+++ b/lisp/mail/smtpmail.el	Sun Jun 01 22:24:22 1997 +0000
@@ -4,6 +4,7 @@
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
+;; ESMTP support: Simon Leinen <simon@switch.ch>
 ;; Keywords: mail
 
 ;; This file is part of GNU Emacs.
@@ -243,7 +244,8 @@
 	(port smtpmail-smtp-service)
 	response-code
 	greeting
-	process-buffer)
+	process-buffer
+	(supported-extensions '()))
     (unwind-protect
 	(catch 'done
 	  ;; get or create the trace buffer
@@ -274,24 +276,105 @@
 		(throw 'done nil)
 	      )
 
-	    ;; HELO
-	    (smtpmail-send-command process (format "HELO %s" (smtpmail-fqdn)))
+	    ;; 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))
-		(throw 'done nil)
-	      )
+		(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)))
+	      (let ((extension-lines (cdr (cdr response-code))))
+		(while extension-lines
+		  (let ((name (intern (downcase (substring (car extension-lines) 4)))))
+		    (and name
+			 (cond ((memq name '(verb xvrb 8bitmime onex xone
+						  expn size dsn etrn
+						  help xusr))
+				(setq supported-extensions
+				      (cons name supported-extensions)))
+			       (t (message "unknown extension %s"
+					   name)))))
+		  (setq extension-lines (cdr extension-lines)))))
+
+	    (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-info
+		     (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>
-;	    (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
-	    (smtpmail-send-command process (format "MAIL FROM: <%s>" user-mail-address))
+	    (let ((size-part
+		   (if (member 'size supported-extensions)
+		       (format " SIZE=%d"
+			       (save-excursion
+				 (set-buffer smtpmail-text-buffer)
+				 ;; size estimate:
+				 (+ (- (point-max) (point-min))
+				    ;; Add one byte for each change-of-line
+				    ;; because or CR-LF representation:
+				    (count-lines (point-min) (point-max))
+				    ;; For some reason, an empty line is
+				    ;; added to the message.  Maybe this
+				    ;; is a bug, but it can't hurt to add
+				    ;; those two bytes anyway:
+				    2)))
+		     ""))
+		  (body-part
+		   (if (member '8bitmime supported-extensions)
+		       ;; FIXME:
+		       ;; Code should be added here that transforms
+		       ;; the contents of the message buffer into
+		       ;; something the receiving SMTP can handle.
+		       ;; For a receiver that supports 8BITMIME, this
+		       ;; may mean converting BINARY to BASE64, or
+		       ;; adding Content-Transfer-Encoding and the
+		       ;; other MIME headers.  The code should also
+		       ;; return an indication of what encoding the
+		       ;; message buffer is now, i.e. ASCII or
+		       ;; 8BITMIME.
+		       (if nil
+			   " 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"
+						     user-mail-address
+						     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)
-	      )
+	      (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))
@@ -299,7 +382,8 @@
 		(smtpmail-send-command process (format "RCPT TO: <%s>" (nth n recipient)))
 		(setq n (1+ n))
 
-		(if (or (null (car (setq response-code (smtpmail-read-response process))))
+		(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)
@@ -354,15 +438,11 @@
 
 (defun smtpmail-read-response (process)
   (let ((case-fold-search nil)
-	(response-string nil)
+	(response-strings nil)
 	(response-continue t)
-	(return-value '(nil ""))
+	(return-value '(nil ()))
 	match-end)
 
-;    (setq response-string nil)
-;    (setq response-continue t)
-;    (setq return-value '(nil ""))
-
     (while response-continue
       (goto-char smtpmail-read-point)
       (while (not (search-forward "\r\n" nil t))
@@ -370,32 +450,38 @@
 	(goto-char smtpmail-read-point))
 
       (setq match-end (point))
-      (if (null response-string)
-	  (setq response-string
-		(buffer-substring smtpmail-read-point (- match-end 2))))
+      (setq response-strings
+	    (cons (buffer-substring smtpmail-read-point (- match-end 2))
+		  response-strings))
 	
       (goto-char smtpmail-read-point)
       (if (looking-at "[0-9]+ ")
-	  (progn (setq response-continue nil)
-;		 (setq return-value response-string)
+	  (let ((begin (match-beginning 0))
+		(end (match-end 0)))
+	    (if smtpmail-debug-info
+		(message "%s" (car response-strings)))
 
-		 (if smtpmail-debug-info
-		     (message "%s" response-string))
+	    (setq smtpmail-read-point match-end)
 
-		 (setq smtpmail-read-point match-end)
-		 (setq return-value
-		       (cons (string-to-int 
-			      (buffer-substring (match-beginning 0) (match-end 0))) 
-			     response-string)))
+	    ;; ignore lines that start with "0"
+	    (if (looking-at "0[0-9]+ ")
+		nil
+	      (setq response-continue nil)
+	      (setq return-value
+		    (cons (string-to-int 
+			   (buffer-substring begin end)) 
+			  (nreverse response-strings)))))
 	
 	(if (looking-at "[0-9]+-")
-	    (progn (setq smtpmail-read-point match-end)
+	    (progn (if smtpmail-debug-info
+		     (message "%s" (car response-strings)))
+		   (setq smtpmail-read-point match-end)
 		   (setq response-continue t))
 	  (progn
 	    (setq smtpmail-read-point match-end)
 	    (setq response-continue nil)
 	    (setq return-value 
-		  (cons nil response-string))
+		  (cons nil (nreverse response-strings)))
 	    )
 	  )))
     (setq smtpmail-read-point match-end)