X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/dd64e5e535355438adb255d4162d9d06c6132e10..2d8a544976354b3787e4f28f2d97b3ab96f4a052:/lisp/mail/smtpmail.el

diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 39886ad343..84a6135014 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -1,6 +1,7 @@
 ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
 
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004
+;;   Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -44,6 +45,8 @@
 ;;      '(("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).
 
 ;; To queue mail, set smtpmail-queue-mail to t and use
 ;; smtpmail-send-queued-mail to send.
@@ -480,7 +483,14 @@ This is relative to `smtpmail-queue-dir'.")
 			  (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))))
+		(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)
@@ -488,9 +498,9 @@ This is relative to `smtpmail-queue-dir'.")
 	 (mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
 	 (cred (if (stringp smtpmail-auth-credentials)
 		   (let* ((netrc (netrc-parse smtpmail-auth-credentials))
-			  (hostentry (netrc-machine
-				      netrc host (format "%s" (or port "smtp"))
-				      "smtp")))
+                          (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")
@@ -504,7 +514,7 @@ This is relative to `smtpmail-queue-dir'.")
 				(smtpmail-cred-server cred)
 				(smtpmail-cred-port cred))))))
 	 ret)
-    (when cred
+    (when (and cred mech)
       (cond
        ((eq mech 'cram-md5)
 	(smtpmail-send-command process (format "AUTH %s" mech))
@@ -680,13 +690,8 @@ This is relative to `smtpmail-queue-dir'.")
 				 ;; 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)))
+				    ;; because of CR-LF representation:
+				    (count-lines (point-min) (point-max)))))
 		     ""))
 		  (body-part
 		   (if (member '8bitmime supported-extensions)
@@ -783,49 +788,49 @@ This is relative to `smtpmail-queue-dir'.")
 	(response-continue t)
 	(return-value '(nil ()))
 	match-end)
-
-    (while response-continue
-      (goto-char smtpmail-read-point)
-      (while (not (search-forward "\r\n" nil t))
-	(accept-process-output process)
-	(goto-char smtpmail-read-point))
-
-      (setq match-end (point))
-      (setq response-strings
-	    (cons (buffer-substring smtpmail-read-point (- match-end 2))
-		  response-strings))
-
-      (goto-char smtpmail-read-point)
-      (if (looking-at "[0-9]+ ")
-	  (let ((begin (match-beginning 0))
-		(end (match-end 0)))
-	    (if smtpmail-debug-info
-		(message "%s" (car response-strings)))
-
-	    (setq smtpmail-read-point match-end)
-
-	    ;; ignore lines that start with "0"
-	    (if (looking-at "0[0-9]+ ")
-		nil
+    (catch 'done
+      (while response-continue
+	(goto-char smtpmail-read-point)
+	(while (not (search-forward "\r\n" nil t))
+	  (unless (memq (process-status process) '(open run))
+	    (throw 'done nil))
+	  (accept-process-output process)
+	  (goto-char smtpmail-read-point))
+
+	(setq match-end (point))
+	(setq response-strings
+	      (cons (buffer-substring smtpmail-read-point (- match-end 2))
+		    response-strings))
+
+	(goto-char smtpmail-read-point)
+	(if (looking-at "[0-9]+ ")
+	    (let ((begin (match-beginning 0))
+		  (end (match-end 0)))
+	      (if smtpmail-debug-info
+		  (message "%s" (car response-strings)))
+
+	      (setq smtpmail-read-point match-end)
+
+	      ;; 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 (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 (string-to-int
-			   (buffer-substring begin end))
-			  (nreverse response-strings)))))
-
-	(if (looking-at "[0-9]+-")
-	    (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 (nreverse response-strings)))
-	    )
-	  )))
-    (setq smtpmail-read-point match-end)
+		    (cons nil (nreverse response-strings)))))))
+      (setq smtpmail-read-point match-end))
     return-value))