X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmail-source.el;h=f288242f040216ce3490410ae8c2c8ddbd9cb74b;hb=dab90e322488e20205f3e4c254049f40577275a9;hp=31e1029195d1cd0264851f0344f665f6a0220f7f;hpb=17a12faa601b2496e020f4106ffe3ddba9b37ae3;p=elisp%2Fgnus.git-

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index 31e1029..f288242 100644
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -69,6 +69,7 @@ This variable is a list of mail source specifiers."
   (defvar mail-source-keyword-map
     '((file
        (:prescript)
+       (:prescript-delay)
        (:postscript)
        (:path (or (getenv "MAIL")
 		  (concat "/usr/spool/mail/" (user-login-name)))))
@@ -78,6 +79,7 @@ This variable is a list of mail source specifiers."
        (:predicate identity))
       (pop
        (:prescript)
+       (:prescript-delay)
        (:postscript)
        (:server (getenv "MAILHOST"))
        (:port 110)
@@ -88,7 +90,24 @@ This variable is a list of mail source specifiers."
        (:connection)
        (:authentication password))
       (maildir
-       (:path "~/Maildir/new/")))
+       (:path "~/Maildir/new/")
+       (:function))
+      (imap
+       (:server (getenv "MAILHOST"))
+       (:port)
+       (:stream)
+       (:authentication)
+       (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
+       (:password)
+       (:mailbox "INBOX")
+       (:predicate "UNSEEN UNDELETED")
+       (:fetchflag "\Deleted")
+       (:dontexpunge))
+      (webmail
+       (:subtype hotmail)
+       (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
+       (:password)
+       (:authentication password)))
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
 
@@ -96,7 +115,9 @@ All keywords that can be used must be listed here."))
   '((file mail-source-fetch-file)
     (directory mail-source-fetch-directory)
     (pop mail-source-fetch-pop)
-    (maildir mail-source-fetch-maildir))
+    (maildir mail-source-fetch-maildir)
+    (imap mail-source-fetch-imap)
+    (webmail mail-source-fetch-webmail))
   "A mapping from source type to fetcher function.")
 
 (defvar mail-source-password-cache nil)
@@ -182,7 +203,7 @@ Return the number of files that were found."
              (funcall function source callback)
            (error
             (unless (yes-or-no-p
-		     (format "Mail source error.  Continue? "))
+		     (format "Mail source error (%s).  Continue? " err))
               (error "Cannot get new mail."))
             0))))))
 
@@ -203,19 +224,19 @@ Pass INFO on to CALLBACK."
 	(when (file-exists-p mail-source-crash-box)
 	  (delete-file mail-source-crash-box))
 	0)
-    (funcall callback mail-source-crash-box info)
-    (when (file-exists-p mail-source-crash-box)
-      ;; Delete or move the incoming mail out of the way.
-      (if mail-source-delete-incoming
-	  (delete-file mail-source-crash-box)
-	(let ((incoming
-	       (mail-source-make-complex-temp-name
-		(expand-file-name
-		 "Incoming" 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))))
-    1))
+    (prog1
+	(funcall callback mail-source-crash-box info)
+      (when (file-exists-p mail-source-crash-box)
+	;; Delete or move the incoming mail out of the way.
+	(if mail-source-delete-incoming
+	    (delete-file mail-source-crash-box)
+	  (let ((incoming
+		 (mail-source-make-complex-temp-name
+		  (expand-file-name
+		   "Incoming" 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)))))))
 
 (defun mail-source-movemail (from to)
   "Move FROM to TO using movemail."
@@ -283,6 +304,12 @@ Pass INFO on to CALLBACK."
       ;; Return whether we moved successfully or not.
       to)))
 
+(defun mail-source-movemail-and-remove (from to)
+  "Move FROM to TO using movemail, then remove FROM if empty."
+  (or (not (mail-source-movemail from to))
+      (not (zerop (nth 7 (file-attributes from))))
+      (delete-file from)))
+
 (defvar mail-source-read-passwd nil)
 (defun mail-source-read-passwd (prompt &rest args)
   "Read a password using PROMPT.
@@ -303,6 +330,23 @@ If ARGS, PROMPT is used as an argument to `format'."
   (zerop (call-process shell-file-name nil nil nil
 		       shell-command-switch program)))
 
+(defun mail-source-run-script (script spec &optional delay)
+  (when script
+    (if (and (symbolp script) (fboundp script))
+	(funcall script)
+      (mail-source-call-script
+       (format-spec script spec))))
+  (when delay
+    (sleep-for delay)))
+
+(defun mail-source-call-script (script)
+  (let ((background nil))
+    (when (string-match "& *$" script)
+      (setq script (substring script 0 (match-beginning 0))
+	    background 0))
+    (call-process shell-file-name nil background nil
+		  shell-command-switch script)))
+
 ;;;
 ;;; Different fetchers
 ;;;
@@ -310,26 +354,15 @@ If ARGS, PROMPT is used as an argument to `format'."
 (defun mail-source-fetch-file (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (file source)
-    (when prescript
-      (if (and (symbolp prescript) (fboundp prescript))
-	  (funcall prescript)
-	(call-process shell-file-name nil nil nil
-		      shell-command-switch 
-		      (format-spec
-		       prescript
-		       (format-spec-make ?t mail-source-crash-box)))))
+    (mail-source-run-script
+     prescript (format-spec-make ?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)
-	    (when prescript
-	      (if (and (symbolp prescript) (fboundp prescript))
-		  (funcall prescript)
-		(call-process shell-file-name nil nil nil
-			      shell-command-switch 
-			      (format-spec
-			       postscript
-			       (format-spec-make ?t mail-source-crash-box))))))
+	    (mail-source-run-script
+	     postscript (format-spec-make ?t mail-source-crash-box)))
 	0))))
 
 (defun mail-source-fetch-directory (source callback)
@@ -348,16 +381,11 @@ If ARGS, PROMPT is used as an argument to `format'."
 (defun mail-source-fetch-pop (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (pop source)
-    (when prescript
-      (if (and (symbolp prescript)
-	       (fboundp prescript))
-	  (funcall prescript)
-	(call-process shell-file-name nil 0 nil
-		      shell-command-switch 
-		      (format-spec
-		       prescript
-		       (format-spec-make ?p password ?t mail-source-crash-box
-					 ?s server ?P port ?u user)))))
+    (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))
 	  (mail-source-string (format "pop:%s@%s" user server))
 	  result)
@@ -366,9 +394,7 @@ If ARGS, PROMPT is used as an argument to `format'."
 	      (or password
 		  (cdr (assoc from mail-source-password-cache))
 		  (mail-source-read-passwd
-		   (format "Password for %s at %s: " user server))))
-	(unless (assoc from mail-source-password-cache)
-	  (push (cons from password) mail-source-password-cache)))
+		   (format "Password for %s at %s: " user server)))))
       (when server
 	(setenv "MAILHOST" server))
       (setq result
@@ -392,19 +418,16 @@ If ARGS, PROMPT is used as an argument to `format'."
 		    (pop3-connection-type connection))
 		(save-excursion (pop3-movemail mail-source-crash-box))))))
       (if result
-	  (prog1
-	      (mail-source-callback callback server)
-	    (when prescript
-	      (if (and (symbolp postscript)
-		       (fboundp postscript))
-		  (funcall prescript)
-		(call-process shell-file-name nil 0 nil
-			      shell-command-switch 
-			      (format-spec
-			       postscript
-			       (format-spec-make
-				?p password ?t mail-source-crash-box
-				?s server ?P port ?u user))))))
+	  (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)
+	      (mail-source-run-script
+	       postscript
+	       (format-spec-make ?p password ?t mail-source-crash-box
+				 ?s server ?P port ?u user))))
 	;; We nix out the password in case the error
 	;; was because of a wrong password being given.
 	(setq mail-source-password-cache
@@ -419,10 +442,76 @@ If ARGS, PROMPT is used as an argument to `format'."
 	  (mail-source-string (format "maildir:%s" path)))
       (dolist (file (directory-files path t))
 	(when (and (file-regular-p file)
-		   (not (rename-file file mail-source-crash-box)))
+		   (not (if function
+			    (funcall function file mail-source-crash-box)
+			  (rename-file file mail-source-crash-box))))
 	  (incf found (mail-source-callback callback file))))
       found)))
 
+(eval-and-compile
+  (autoload 'imap-open "imap")
+  (autoload 'imap-authenticate "imap")
+  (autoload 'imap-mailbox-select "imap")
+  (autoload 'imap-mailbox-unselect "imap")
+  (autoload 'imap-mailbox-close "imap")
+  (autoload 'imap-search "imap")
+  (autoload 'imap-fetch "imap")
+  (autoload 'imap-close "imap")
+  (autoload 'imap-error-text "imap")
+  (autoload 'imap-message-flags-add "imap")
+  (autoload 'imap-list-to-message-set "imap")
+  (autoload 'nnheader-ms-strip-cr "nnheader"))
+
+(defun mail-source-fetch-imap (source callback)
+  "Fetcher for imap sources."
+  (mail-source-bind (imap source)
+    (let ((found 0)
+	  (buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
+	  (mail-source-string (format "imap:%s:%s" server mailbox))
+	  remove)
+      (if (and (imap-open server port stream authentication buf)
+	       (imap-authenticate user password buf)
+	       (imap-mailbox-select mailbox nil buf))
+	  (let (str (coding-system-for-write 'binary))
+	    (with-temp-file mail-source-crash-box
+	      ;; if predicate is nil, use all uids
+	      (dolist (uid (imap-search (or predicate "1:*") buf))
+		(when (setq str (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 (re-search-forward "^From " nil t)
+		    (replace-match ">From "))
+		  (goto-char (point-max))))
+	      (nnheader-ms-strip-cr))
+	    (incf found (mail-source-callback callback server))
+	    (when (and remove fetchflag)
+	      (imap-message-flags-add
+	       (imap-list-to-message-set remove) fetchflag nil buf))
+	    (if dontexpunge
+		(imap-mailbox-unselect buf)
+	      (imap-mailbox-close buf))
+	    (imap-close buf))
+	(imap-close buf)
+	(error (imap-error-text buf)))
+      (kill-buffer buf)
+      found)))
+
+(eval-and-compile
+  (autoload 'webmail-fetch "webmail"))
+
+(defun mail-source-fetch-webmail (source callback)
+  "Fetch for webmail source."
+  (mail-source-bind (webmail source)
+    (when (eq authentication 'password)
+      (setq password
+	    (or password
+		(mail-source-read-passwd
+		 (format "Password for %s at %s: " user subtype)))))
+    (webmail-fetch mail-source-crash-box subtype user password)
+    (mail-source-callback callback (symbol-name subtype))))
+
 (provide 'mail-source)
 
 ;;; mail-source.el ends here