>From 734b13491965ae85907568a3d392e4fdb74a675a Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Wed, 26 Jan 2022 16:00:41 +0100
Subject: [PATCH] uniquify mail-source-crash-box on each different mail-source
 fetcher.

---
 lisp/gnus/mail-source.el | 386 ++++++++++++++++++++-------------------
 1 file changed, 202 insertions(+), 184 deletions(-)

diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 5d0c0e2654..4498ea13f6 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -238,10 +238,12 @@ mail-source-flash
   "If non-nil, flash periodically when mail is available."
   :type 'boolean)
 
-(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
-  "File where mail will be stored while processing it."
+(defcustom mail-source-crash-box-prefix "~/.emacs-mail-crash-box-"
+  "Prefix of files where mail will be stored while processing it."
   :type 'file)
 
+(make-obsolete-variable 'mail-source-crash-box 'mail-source-crash-box-prefix "29.1")
+
 (defcustom mail-source-directory message-directory
   "Directory where incoming mail source files (if any) will be stored."
   :type 'directory)
@@ -518,6 +520,18 @@ mail-source-value
 
 (autoload 'nnheader-message "nnheader")
 
+(defun mail-source-fetcher (source)
+  (cadr (assq (car source) mail-source-fetcher-alist)))
+
+(defun mail-source-crash-box ()
+  (make-temp-name mail-source-crash-box-prefix))
+
+(defun mail-source-existing-crash-boxes ()
+  (let ((directory (file-name-directory mail-source-crash-box-prefix))
+        (partial (file-name-nondirectory mail-source-crash-box-prefix)))
+    (mapcar #'(lambda (name) (file-name-concat directory name))
+            (file-name-all-completions partial directory))))
+
 (defun mail-source-fetch (source callback &optional method)
   "Fetch mail from SOURCE and call CALLBACK zero or more times.
 CALLBACK will be called with the name of the file where (some of)
@@ -536,21 +550,20 @@ mail-source-fetch
 				  (format "%s: " method)
 				"")
 			      (car source)))
-	  (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
+	  (let ((fetcher (mail-source-fetcher source))
 		(found 0))
-	    (unless function
+	    (unless fetcher
 	      (error "%S is an invalid mail source specification" source))
-	    ;; If there's anything in the crash box, we do it first.
-	    (when (file-exists-p mail-source-crash-box)
-	      (message "Processing mail from %s..." mail-source-crash-box)
-	      (setq found (mail-source-callback
-			   callback mail-source-crash-box))
-	      (mail-source-delete-crash-box))
+	    ;; If there's anything in some crash boxes, we do it first.
+            (dolist (box (mail-source-existing-crash-boxes))
+	      (message "Processing mail from %s..." box)
+	      (setq found (mail-source-callback callback box box))
+	      (mail-source-delete-crash-box box))
 	    (+ found
 	       (if (or debug-on-quit debug-on-error)
-		   (funcall function source callback)
+		   (funcall fetcher source callback)
 		 (condition-case err
-		     (funcall function source callback)
+		     (funcall fetcher source callback)
 		   (error
                     (gnus-error
                      5
@@ -596,24 +609,24 @@ mail-source-delete-old-incoming
 		     t))
 	  (delete-file ffile))))))
 
-(defun mail-source-callback (callback info)
+(defun mail-source-callback (callback info crash-box)
   "Call CALLBACK on the mail file.  Pass INFO on to CALLBACK."
-  (if (or (not (file-exists-p mail-source-crash-box))
+  (if (or (not (file-exists-p crash-box))
 	  (zerop (file-attribute-size
-		  (file-attributes mail-source-crash-box))))
+		  (file-attributes crash-box))))
       (progn
-	(when (file-exists-p mail-source-crash-box)
-	  (delete-file mail-source-crash-box))
+	(when (file-exists-p crash-box)
+	  (delete-file crash-box))
 	0)
-    (funcall callback mail-source-crash-box info)))
+    (funcall callback crash-box info)))
 
 (defvar mail-source-incoming-last-checked-time nil)
 
-(defun mail-source-delete-crash-box ()
-  (when (file-exists-p mail-source-crash-box)
+(defun mail-source-delete-crash-box (crash-box)
+  (when (file-exists-p crash-box)
     ;; Delete or move the incoming mail out of the way.
     (if (eq mail-source-delete-incoming t)
-	(delete-file mail-source-crash-box)
+	(delete-file crash-box)
       (let ((incoming
 	     (make-temp-file
 	      (expand-file-name
@@ -621,7 +634,7 @@ mail-source-delete-crash-box
 	       mail-source-directory))))
 	(unless (file-exists-p (file-name-directory incoming))
 	  (make-directory (file-name-directory incoming) t))
-	(rename-file mail-source-crash-box incoming t)
+	(rename-file crash-box incoming t)
 	;; remove old incoming files?
 	(when (natnump mail-source-delete-incoming)
 	  ;; Don't check for old incoming files more than once per day to
@@ -750,17 +763,18 @@ mail-source-call-script
 (defun mail-source-fetch-file (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (file source)
-    (mail-source-run-script
-     prescript `((?t . ,mail-source-crash-box))
-     prescript-delay)
-    (let ((mail-source-string (format "file:%s" path)))
-      (if (mail-source-movemail path mail-source-crash-box)
-	  (prog1
-	      (mail-source-callback callback path)
-	    (mail-source-run-script
-             postscript `((?t . ,mail-source-crash-box)))
-	    (mail-source-delete-crash-box))
-	0))))
+    (let ((crash-box (mail-source-crash-box)))
+      (mail-source-run-script
+       prescript `((?t . ,crash-box))
+       prescript-delay)
+      (let ((mail-source-string (format "file:%s" path)))
+        (if (mail-source-movemail path crash-box)
+	    (prog1
+	        (mail-source-callback callback path crash-box)
+	      (mail-source-run-script
+               postscript `((?t . ,crash-box)))
+	      (mail-source-delete-crash-box crash-box))
+	  0)))))
 
 (defun mail-source-fetch-directory (source callback)
   "Fetcher for directory sources."
@@ -768,92 +782,94 @@ mail-source-fetch-directory
     (mail-source-run-script
      prescript `((?t . ,path)) prescript-delay)
     (let ((found 0)
-	  (mail-source-string (format "directory:%s" path)))
+	  (mail-source-string (format "directory:%s" path))
+          (crash-box (mail-source-crash-box)))
       (dolist (file (directory-files
 		     path t (concat (regexp-quote suffix) "$")))
 	(when (and (file-regular-p file)
 		   (funcall predicate file)
-		   (mail-source-movemail file mail-source-crash-box))
-	  (cl-incf found (mail-source-callback callback file))
+		   (mail-source-movemail file crash-box))
+	  (cl-incf found (mail-source-callback callback file crash-box))
           (mail-source-run-script postscript `((?t . ,path)))
-	  (mail-source-delete-crash-box)))
+	  (mail-source-delete-crash-box crash-box)))
       found)))
 
 (defun mail-source-fetch-pop (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (pop source)
-    ;; fixme: deal with stream type in format specs
-    (mail-source-run-script
-     prescript
-     `((?p . ,password) (?t . ,mail-source-crash-box)
-       (?s . ,server) (?P . ,port) (?u . ,user))
-     prescript-delay)
-    (let ((from (format "%s:%s:%s" server user port))
-	  (mail-source-string (format "pop:%s@%s" user server))
-	  (process-environment (if server
-				   (cons (concat "MAILHOST=" server)
-					 process-environment)
-				 process-environment))
-	  result)
-      (when (eq authentication 'password)
-	(setq password
-	      (or password
-		  (cdr (assoc from mail-source-password-cache))
-		  (read-passwd
-		   (format "Password for %s at %s: " user server)))))
-      (setq result
-	    (cond
-	     (program
-	      (mail-source-fetch-with-program
-	       (format-spec
-		program
-                `((?p . ,password) (?t . ,mail-source-crash-box)
-                  (?s . ,server) (?P . ,port) (?u . ,user)))))
-	     (function
-	      (funcall function mail-source-crash-box))
-	     ;; The default is to use pop3.el.
-	     (t
-	      (require 'pop3)
-	      (dlet ((pop3-password password)
-		     (pop3-maildrop user)
-		     (pop3-mailhost server)
-		     (pop3-port port)
-		     (pop3-authentication-scheme
-		      (if (eq authentication 'apop) 'apop 'pass))
-		     (pop3-stream-type stream)
-		     (pop3-leave-mail-on-server leave))
-		(if (or debug-on-quit debug-on-error)
-		    (save-excursion (pop3-movemail mail-source-crash-box))
-		  (condition-case err
-		      (save-excursion (pop3-movemail mail-source-crash-box))
-		    (error
-		     ;; 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))
-		     (signal (car err) (cdr err)))))))))
-      (if result
-	  (progn
-	    (when (eq authentication 'password)
-	      (unless (assoc from mail-source-password-cache)
-		(push (cons from password) mail-source-password-cache)))
-	    (prog1
-		(mail-source-callback callback server)
-	      ;; Update display-time's mail flag, if relevant.
-	      (if (equal source mail-source-primary-source)
-		  (setq mail-source-new-mail-available nil))
-	      (mail-source-run-script
-	       postscript
-               `((?p . ,password) (?t . ,mail-source-crash-box)
-                 (?s . ,server) (?P . ,port) (?u . ,user)))
-	      (mail-source-delete-crash-box)))
-	;; 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))
-	0))))
+    (let ((crash-box (mail-source-crash-box)))
+      ;; fixme: deal with stream type in format specs
+      (mail-source-run-script
+       prescript
+       `((?p . ,password) (?t . ,crash-box)
+         (?s . ,server) (?P . ,port) (?u . ,user))
+       prescript-delay)
+      (let ((from (format "%s:%s:%s" server user port))
+	    (mail-source-string (format "pop:%s@%s" user server))
+	    (process-environment (if server
+				     (cons (concat "MAILHOST=" server)
+					   process-environment)
+				   process-environment))
+	    result)
+        (when (eq authentication 'password)
+	  (setq password
+	        (or password
+		    (cdr (assoc from mail-source-password-cache))
+		    (read-passwd
+		     (format "Password for %s at %s: " user server)))))
+        (setq result
+	      (cond
+	       (program
+	        (mail-source-fetch-with-program
+	         (format-spec
+		  program
+                  `((?p . ,password) (?t . ,crash-box)
+                    (?s . ,server) (?P . ,port) (?u . ,user)))))
+	       (function
+	        (funcall function crash-box))
+	       ;; The default is to use pop3.el.
+	       (t
+	        (require 'pop3)
+	        (dlet ((pop3-password password)
+		       (pop3-maildrop user)
+		       (pop3-mailhost server)
+		       (pop3-port port)
+		       (pop3-authentication-scheme
+		        (if (eq authentication 'apop) 'apop 'pass))
+		       (pop3-stream-type stream)
+		       (pop3-leave-mail-on-server leave))
+		  (if (or debug-on-quit debug-on-error)
+		      (save-excursion (pop3-movemail crash-box))
+		    (condition-case err
+		        (save-excursion (pop3-movemail crash-box))
+		      (error
+		       ;; 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))
+		       (signal (car err) (cdr err)))))))))
+        (if result
+	    (progn
+	      (when (eq authentication 'password)
+	        (unless (assoc from mail-source-password-cache)
+		  (push (cons from password) mail-source-password-cache)))
+	      (prog1
+		  (mail-source-callback callback server crash-box)
+	        ;; Update display-time's mail flag, if relevant.
+	        (if (equal source mail-source-primary-source)
+		    (setq mail-source-new-mail-available nil))
+	        (mail-source-run-script
+	         postscript
+                 `((?p . ,password) (?t . ,crash-box)
+                   (?s . ,server) (?P . ,port) (?u . ,user)))
+	        (mail-source-delete-crash-box crash-box)))
+	  ;; 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))
+	  0)))))
 
 (defun mail-source-check-pop (source)
   "Check whether there is new mail."
@@ -1001,6 +1017,7 @@ mail-source-fetch-maildir
   "Fetcher for maildir sources."
   (mail-source-bind (maildir source)
     (let ((found 0)
+          (crash-box (mail-source-crash-box))
 	  mail-source-string)
       (unless (string-match "/$" path)
 	(setq path (concat path "/")))
@@ -1011,12 +1028,12 @@ mail-source-fetch-maildir
 	    (when (and (not (file-directory-p file))
 		       (not (if function
 				;; `function' should return nil if successful.
-				(funcall function file mail-source-crash-box)
+				(funcall function file crash-box)
 			      (let ((coding-system-for-write
 				     mm-text-coding-system)
 				    (coding-system-for-read
 				     mm-text-coding-system))
-				(with-temp-file mail-source-crash-box
+				(with-temp-file crash-box
 				  (insert-file-contents file)
 				  (goto-char (point-min))
 ;;;				  ;; Unix mail format
@@ -1031,8 +1048,8 @@ mail-source-fetch-maildir
 				  (insert "\001\001\001\001\n"))
 				(delete-file file)
 				nil))))
-	      (cl-incf found (mail-source-callback callback file))
-	      (mail-source-delete-crash-box)))))
+	      (cl-incf found (mail-source-callback callback file crash-box))
+	      (mail-source-delete-crash-box crash-box)))))
       found)))
 
 (autoload 'imap-open "imap")
@@ -1058,78 +1075,79 @@ mail-source-imap-file-coding-system
 (defun mail-source-fetch-imap (source callback)
   "Fetcher for imap sources."
   (mail-source-bind (imap source)
-    (mail-source-run-script
-     prescript
-     `((?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))
-          (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
-            (dolist (mailbox mailbox-list)
-              (when (imap-mailbox-select mailbox nil buf)
-	  (let ((coding-system-for-write mail-source-imap-file-coding-system)
-		str)
-            (message "Fetching from %s..." mailbox)
-	    (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 (member (cons from imap-password)
-                                        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))
-	    (cl-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 ((crash-box (mail-source-crash-box)))
       (mail-source-run-script
-       postscript
-       `((?p . ,password) (?t . ,mail-source-crash-box)
-         (?s . ,server) (?P . ,port) (?u . ,user)))
-      found)))
+       prescript
+       `((?p . ,password) (?t . ,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))
+            (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
+              (dolist (mailbox mailbox-list)
+                (when (imap-mailbox-select mailbox nil buf)
+	          (let ((coding-system-for-write mail-source-imap-file-coding-system)
+		        str)
+                    (message "Fetching from %s..." mailbox)
+	            (with-temp-file 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 (member (cons from imap-password)
+                                                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))
+	            (cl-incf found (mail-source-callback callback server crash-box))
+	            (mail-source-delete-crash-box 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
+         `((?p . ,password) (?t . ,crash-box)
+           (?s . ,server) (?P . ,port) (?u . ,user)))
+        found))))
 
 (provide 'mail-source)
 
-- 
2.34.1