mail-source.el patch to use netrc-parse

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 1336 bytes --]

The attached patch modifies mail-source.el to use a netrc (~/.authinfo)
file for IMAP fetching.  It will be triggered when
mail-source-authinfo-file is not nil.  It will override the :user and
:password parameters set in mail-sources unconditionally.  This allows
users to store their passwords for an IMAP mail source in the authinfo
file, encrypted if necessary.  I use this for my IMAP fetching and it
worked fine; please test (also if you don't use the feature, make sure
your IMAP fetching works OK).  I won't commit until I get confirmations
it works, since mail fetching is a sensitive area for improvements.

I plan to add this to POP and webmail fetching as well, possibly through
mail-source-bind instead of in each individual fetching function.
Please let me know what you think.

Also, I think instead of the current variables

(setq
 nnimap-authinfo-file "~/.authinfo.enc"
 nntp-authinfo-file "~/.authinfo.enc"
 mail-source-authinfo-file "~/.authinfo.enc"
 smtpmail-auth-credentials "~/.authinfo.enc")

Gnus should have a single specification:

(setq
 authinfo-files '(('nnimap "~/.imap-authinfo.enc")
                  (t "~/.authinfo.enc")))

Then we can derive each of those variables at runtime, if they are not
set:

(setq nnimap-authinfo-file
 (or nnimap-authinfo-file (gnus-get-authinfo-file 'nnimap)))

WDYT?

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mail-source.authinfo.patch --]
[-- Type: text/x-diff, Size: 6432 bytes --]

Index: mail-source.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/mail-source.el,v
retrieving revision 7.26
diff -r7.26 mail-source.el
38a39,40
>   (autoload 'netrc-parse "netrc")
>   (autoload 'netrc-machine-user-or-password "netrc")
339a342,348
> (defcustom mail-source-authinfo-file nil
>   "Authinfo file.  
> When set, it will override :user and :password for a mail source
> if that source's server is set in the authinfo file.  See netrc.el"
>   :group 'mail-source
>   :type 'file)
> 
1017,1077c1026,1045
<     (mail-source-run-script
<      prescript (format-spec-make ?p password ?t mail-source-crash-box
< 				 ?s server ?P port ?u user)
<      prescript-delay)
<     (let ((from (format "%s:%s:%s" server user port))
< 	  (found 0)
< 	  (buf (generate-new-buffer " *imap source*"))
< 	  (mail-source-string (format "imap:%s:%s" server mailbox))
< 	  (imap-shell-program (or (list program) imap-shell-program))
< 	  remove)
<       (if (and (imap-open server port stream authentication buf)
< 	       (imap-authenticate
< 		user (or (cdr (assoc from mail-source-password-cache))
< 			 password) buf)
< 	       (imap-mailbox-select mailbox nil buf))
< 	  (let ((coding-system-for-write mail-source-imap-file-coding-system)
< 		str)
< 	    (with-temp-file mail-source-crash-box
< 	      ;; Avoid converting 8-bit chars from inserted strings to
< 	      ;; multibyte.
< 	      (mm-disable-multibyte)
< 	      ;; remember password
< 	      (with-current-buffer buf
< 		(when (and imap-password
< 			   (not (assoc from mail-source-password-cache)))
< 		  (push (cons from imap-password) mail-source-password-cache)))
< 	      ;; if predicate is nil, use all uids
< 	      (dolist (uid (imap-search (or predicate "1:*") buf))
< 		(when (setq str
< 			    (if (imap-capability 'IMAP4rev1 buf)
< 				(caddar (imap-fetch uid "BODY.PEEK[]"
< 						    'BODYDETAIL nil buf))
< 			      (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
< 		  (push uid remove)
< 		  (insert "From imap " (current-time-string) "\n")
< 		  (save-excursion
< 		    (insert str "\n\n"))
< 		  (while (let ((case-fold-search nil))
< 			   (re-search-forward "^From " nil t))
< 		    (replace-match ">From "))
< 		  (goto-char (point-max))))
< 	      (nnheader-ms-strip-cr))
< 	    (incf found (mail-source-callback callback server))
< 	    (mail-source-delete-crash-box)
< 	    (when (and remove fetchflag)
< 	      (setq remove (nreverse remove))
< 	      (imap-message-flags-add
< 	       (imap-range-to-message-set (gnus-compress-sequence remove))
< 	       fetchflag nil buf))
< 	    (if dontexpunge
< 		(imap-mailbox-unselect buf)
< 	      (imap-mailbox-close nil buf))
< 	    (imap-close buf))
< 	(imap-close buf)
< 	;; We nix out the password in case the error
< 	;; was because of a wrong password being given.
< 	(setq mail-source-password-cache
< 	      (delq (assoc from mail-source-password-cache)
< 		    mail-source-password-cache))
< 	(error "IMAP error: %s" (imap-error-text buf)))
<       (kill-buffer buf)
---
>     (let* ((list ((when mail-source-authinfo-file
> 		    (gnus-message 7 "Parsing authinfo file `%s'."
> 				  mail-source-authinfo-file)
> 		    (netrc-parse mail-source-authinfo-file))))
> 	   (user (if mail-source-authinfo-file
> 		     (netrc-machine-user-or-password
> 		      "login"
> 		      list
> 		      (list server)
> 		      (list port)
> 		      (list "imap" "imaps"))
> 		   user))
> 	   (password (if mail-source-authinfo-file
> 			 (netrc-machine-user-or-password
> 			  "password"
> 			  list
> 			  (list server)
> 			  (list port)
> 			  (list "imap" "imaps"))
> 		       password)))
1079,1082c1047,1111
<        postscript
<        (format-spec-make ?p password ?t mail-source-crash-box
< 			 ?s server ?P port ?u user))
<       found)))
---
>        prescript (format-spec-make ?p password ?t mail-source-crash-box
> 				   ?s server ?P port ?u user)
>        prescript-delay)
>       (let ((from (format "%s:%s:%s" server user port))
> 	    (found 0)
> 	    (buf (generate-new-buffer " *imap source*"))
> 	    (mail-source-string (format "imap:%s:%s" server mailbox))
> 	    (imap-shell-program (or (list program) imap-shell-program))
> 	    remove)
> 	(if (and (imap-open server port stream authentication buf)
> 		 (imap-authenticate
> 		  user (or (cdr (assoc from mail-source-password-cache))
> 			   password) buf)
> 		 (imap-mailbox-select mailbox nil buf))
> 	    (let ((coding-system-for-write mail-source-imap-file-coding-system)
> 		  str)
> 	      (with-temp-file mail-source-crash-box
> 		;; Avoid converting 8-bit chars from inserted strings to
> 		;; multibyte.
> 		(mm-disable-multibyte)
> 		;; remember password
> 		(with-current-buffer buf
> 		  (when (and imap-password
> 			     (not (assoc from mail-source-password-cache)))
> 		    (push (cons from imap-password) mail-source-password-cache)))
> 		;; if predicate is nil, use all uids
> 		(dolist (uid (imap-search (or predicate "1:*") buf))
> 		  (when (setq str
> 			      (if (imap-capability 'IMAP4rev1 buf)
> 				  (caddar (imap-fetch uid "BODY.PEEK[]"
> 						      'BODYDETAIL nil buf))
> 				(imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
> 		    (push uid remove)
> 		    (insert "From imap " (current-time-string) "\n")
> 		    (save-excursion
> 		      (insert str "\n\n"))
> 		    (while (let ((case-fold-search nil))
> 			     (re-search-forward "^From " nil t))
> 		      (replace-match ">From "))
> 		    (goto-char (point-max))))
> 		(nnheader-ms-strip-cr))
> 	      (incf found (mail-source-callback callback server))
> 	      (mail-source-delete-crash-box)
> 	      (when (and remove fetchflag)
> 		(setq remove (nreverse remove))
> 		(imap-message-flags-add
> 		 (imap-range-to-message-set (gnus-compress-sequence remove))
> 		 fetchflag nil buf))
> 	      (if dontexpunge
> 		  (imap-mailbox-unselect buf)
> 		(imap-mailbox-close nil buf))
> 	      (imap-close buf))
> 	  (imap-close buf)
> 	  ;; We nix out the password in case the error
> 	  ;; was because of a wrong password being given.
> 	  (setq mail-source-password-cache
> 		(delq (assoc from mail-source-password-cache)
> 		      mail-source-password-cache))
> 	  (error "IMAP error: %s" (imap-error-text buf)))
> 	(kill-buffer buf)
> 	(mail-source-run-script
> 	 postscript
> 	 (format-spec-make ?p password ?t mail-source-crash-box
> 			   ?s server ?P port ?u user))
> 	found))))