* pop3.el (pop3-get-message-numbers): Don't check uidls when

[elisp/gnus.git-] / lisp / pop3.el

diff --git a/lisp/pop3.el b/lisp/pop3.el
index c6584e6..17eaaee 100644 (file)
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -1,14 +1,15 @@
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 

-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003

 ;;        Free Software Foundation, Inc.
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;;      Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;;      Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>

-;; Maintainer: FSF
+;;      Katsumi Yamaoka <yamaoka@jpl.org>
+;; Maintainer: Volunteers

 ;; Keywords: mail
 
 ;; Keywords: mail
 

-;; This file is part of GNU Emacs.
+;; This file is part of T-gnus.

 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by

@@ -34,10 +35,22 @@
 
 ;; This program was inspired by Kyle E. Jones's vm-pop program.
 
 
 ;; This program was inspired by Kyle E. Jones's vm-pop program.
 

+;; You have to set the variable `pop3-connection-type' to `ssl' or
+;; `tls' expressly, if you would like to use this module with Gnus
+;; (not T-gnus) for those connection types.  For examples:
+;;
+;;(setq mail-sources '((pop :server "POPSERVER" :port 995 :connection ssl
+;;                          :authentication apop)))
+;;(setq pop3-connection-type 'ssl)
+

 ;;; Code:
 
 (eval-when-compile (require 'cl))
 ;;; Code:
 
 (eval-when-compile (require 'cl))

-(eval-when-compile (require 'static))
+
+;; as-binary-process, open-network-stream-as-binary, write-region-as-binary
+(require 'pces)
+;; exec-installed-p
+(require 'path-util)

 
 (require 'mail-utils)
 
 
 (require 'mail-utils)
 

@@ -87,7 +100,6 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.")
 (defvar pop3-debug nil)
 
 (eval-and-compile
 (defvar pop3-debug nil)
 
 (eval-and-compile

-  (autoload 'open-ssl-stream "ssl")

   (autoload 'starttls-open-stream "starttls")
   (autoload 'starttls-negotiate "starttls"))
 
   (autoload 'starttls-open-stream "starttls")
   (autoload 'starttls-negotiate "starttls"))
 

@@ -121,7 +133,7 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.")
     ;; query for password
     (if (and pop3-password-required (not pop3-password))
        (setq pop3-password
     ;; query for password
     (if (and pop3-password-required (not pop3-password))
        (setq pop3-password

-             (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+             (read-passwd (format "Password for %s: " pop3-maildrop))))

     (cond ((equal 'apop pop3-authentication-scheme)
           (pop3-apop process pop3-maildrop))
          ((equal 'pass pop3-authentication-scheme)
     (cond ((equal 'apop pop3-authentication-scheme)
           (pop3-apop process pop3-maildrop))
          ((equal 'pass pop3-authentication-scheme)

@@ -173,7 +185,7 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.")
     ;; query for password
     (if (and pop3-password-required (not pop3-password))
        (setq pop3-password
     ;; query for password
     (if (and pop3-password-required (not pop3-password))
        (setq pop3-password

-             (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+             (read-passwd (format "Password for %s: " pop3-maildrop))))

     (cond ((equal 'apop pop3-authentication-scheme)
           (pop3-apop process pop3-maildrop))
          ((equal 'pass pop3-authentication-scheme)
     (cond ((equal 'apop pop3-authentication-scheme)
           (pop3-apop process pop3-maildrop))
          ((equal 'pass pop3-authentication-scheme)

@@ -188,7 +200,7 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.")
   "Open TCP connection to MAILHOST on PORT.
 Returns the process associated with the connection.
 Argument PORT specifies connecting port."
   "Open TCP connection to MAILHOST on PORT.
 Returns the process associated with the connection.
 Argument PORT specifies connecting port."

-  (let (default-enable-multibyte-characters process)
+  (let (process)

     (save-excursion
       (set-buffer (get-buffer-create (concat " trace of POP session to "
                                             mailhost)))
     (save-excursion
       (set-buffer (get-buffer-create (concat " trace of POP session to "
                                             mailhost)))

@@ -211,7 +223,7 @@ Argument PORT specifies connecting port."
       process)))
 
 (defun pop3-open-ssl-stream-1 (name buffer host service extra-arg)
       process)))
 
 (defun pop3-open-ssl-stream-1 (name buffer host service extra-arg)

-  (require 'path-util)
+  (require 'ssl)

   (let* ((ssl-program-name
          pop3-ssl-program-name)
         (ssl-program-arguments
   (let* ((ssl-program-name
          pop3-ssl-program-name)
         (ssl-program-arguments

@@ -226,7 +238,7 @@ Argument PORT specifies connecting port."
                    (goto-char (point-max))
                    (forward-line -1)
                    (not (looking-at "+OK")))
                    (goto-char (point-max))
                    (forward-line -1)
                    (not (looking-at "+OK")))

-         (accept-process-output process 1)
+         (nnheader-accept-process-output process)

          (sit-for 1))
        (delete-region (point-min) (point)))
       (and process (memq (process-status process) '(open run))
          (sit-for 1))
        (delete-region (point-min) (point)))
       (and process (memq (process-status process) '(open run))

@@ -236,16 +248,9 @@ Argument PORT specifies connecting port."
   "Open a SSL connection for a service to a host.
 Returns a subprocess-object to represent the connection.
 Args are NAME BUFFER HOST SERVICE."
   "Open a SSL connection for a service to a host.
 Returns a subprocess-object to represent the connection.
 Args are NAME BUFFER HOST SERVICE."

-  (cond ((eq system-type 'windows-nt)
-        (let (selective-display
-              (coding-system-for-write 'binary)
-              (coding-system-for-read 'raw-text-dos))
-          (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
-              (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))
-       (t
-        (as-binary-process
-         (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
-             (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))))
+  (as-binary-process
+   (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
+       (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))

 
 (defun pop3-open-tls-stream (name buffer host service)
   "Open a TLSv1 connection for a service to a host.
 
 (defun pop3-open-tls-stream (name buffer host service)
   "Open a TLSv1 connection for a service to a host.

@@ -286,7 +291,7 @@ Return the response string if optional second argument RETURN is non-nil."
       (set-buffer (process-buffer process))
       (goto-char pop3-read-point)
       (while (not (search-forward "\r\n" nil t))
       (set-buffer (process-buffer process))
       (goto-char pop3-read-point)
       (while (not (search-forward "\r\n" nil t))

-       (accept-process-output process 3)
+       (nnheader-accept-process-output process)

        (goto-char pop3-read-point))
       (setq match-end (point))
       (goto-char pop3-read-point)
        (goto-char pop3-read-point))
       (setq match-end (point))
       (goto-char pop3-read-point)

@@ -300,17 +305,6 @@ Return the response string if optional second argument RETURN is non-nil."
            t)
          )))))
 
            t)
          )))))
 

-(defvar pop3-read-passwd nil)
-(defun pop3-read-passwd (prompt)
-  (if (not pop3-read-passwd)
-      (if (fboundp 'read-passwd)
-         (setq pop3-read-passwd 'read-passwd)
-       (if (load "passwd" t)
-           (setq pop3-read-passwd 'read-passwd)
-         (autoload 'ange-ftp-read-passwd "ange-ftp")
-         (setq pop3-read-passwd 'ange-ftp-read-passwd))))
-  (funcall pop3-read-passwd prompt))
-

 (defun pop3-clean-region (start end)
   (setq end (set-marker (make-marker) end))
   (save-excursion
 (defun pop3-clean-region (start end)
   (setq end (set-marker (make-marker) end))
   (save-excursion

@@ -373,7 +367,9 @@ If NOW, use that time instead."
            ;; should be
            ;; Tue Jul 9 09:04:21 1996
            (setq date
            ;; should be
            ;; Tue Jul 9 09:04:21 1996
            (setq date

-                 (cond ((string-match "[A-Z]" (nth 0 date))
+                 (cond ((not date)
+                        "Tue Jan 1 00:00:0 1900")
+                       ((string-match "[A-Z]" (nth 0 date))

                         (format "%s %s %s %s %s"
                                 (nth 0 date) (nth 2 date) (nth 1 date)
                                 (nth 4 date) (nth 3 date)))
                         (format "%s %s %s %s %s"
                                 (nth 0 date) (nth 2 date) (nth 1 date)
                                 (nth 4 date) (nth 3 date)))

@@ -418,7 +414,8 @@ If NOW, use that time instead."
       ;; only retrieve messages matching our regexp or in the uidl list
       (when (and
             ;; remove elements not in the uidl, this assumes the uidl is short
       ;; only retrieve messages matching our regexp or in the uidl list
       (when (and
             ;; remove elements not in the uidl, this assumes the uidl is short

-            (or (not (eq pop3-uidl-support t))
+            (or (not (and pop3-leave-mail-on-server
+                          (eq pop3-uidl-support t)))

                 (memq (caar messages) uidl))
             (caar messages)
             ;; don't download messages that are too large
                 (memq (caar messages) uidl))
             (caar messages)
             ;; don't download messages that are too large

@@ -505,40 +502,55 @@ If NOW, use that time instead."
     (if (not (and response (string-match "+OK" response)))
        (pop3-quit process))))
 
     (if (not (and response (string-match "+OK" response)))
        (pop3-quit process))))
 

-(static-unless (and (fboundp 'md5) (subrp (symbol-function 'md5)))
-  (eval-and-compile
-    (require 'path-util)
-    (if (module-installed-p 'md5)
-       (progn
-         (autoload 'md5 "md5")
-         (fset 'pop3-md5 'md5))
-
-      (defvar pop3-md5-program "md5"
-       "*Program to encode its input in MD5.")
-
-      (defun pop3-md5 (string)
-       (with-temp-buffer
-         (insert string)
-         (call-process-region (point-min) (point-max)
-                              (or shell-file-name "/bin/sh")
-                              t (current-buffer) nil
-                              "-c" pop3-md5-program)
-         ;; The meaningful output is the first 32 characters.
-         ;; Don't return the newline that follows them!
-         (buffer-substring (point-min) (+ (point-min) 32))))
-      )))
+;; When this file is being compiled in the Gnus (not T-gnus) source
+;; tree, `md5' might have been defined in w3/md5.el, ./lpath.el or one
+;; of some other libraries and `md5' will accept only 3 arguments.  We
+;; will deceive the byte-compiler not to say warnings.
+(eval-and-compile
+  (if (fboundp 'eval-when)
+      ;; `eval-when' might not be provided when loading .el file.
+      (eval-when 'compile
+       (let ((def (assq 'md5 byte-compile-function-environment)))
+         (if def
+             (setcdr def '(lambda (object &optional start end
+                                          coding-system noerror)))
+           (setq byte-compile-function-environment
+                 (cons '(md5 . (lambda (object &optional start end
+                                               coding-system noerror)))
+                       byte-compile-function-environment)))))))
+
+;; Note that `pop3-md5' should never encode a given string to use for
+;; the apop authentication.
+(eval-and-compile
+  (if (fboundp 'md5)
+      (if (condition-case nil
+             (md5 "\
+Check whether the 4th argument CODING-SYSTEM is allowed"
+                  nil nil 'binary)
+           (error nil))
+         ;; Emacs 21 or XEmacs 21
+         ;; (md5 OBJECT &optional START END CODING-SYSTEM NOERROR)
+         (defun pop3-md5 (string)
+           (md5 string nil nil 'binary))
+       ;; The reason why the program reaches here:
+       ;; 1. XEmacs 20 is running and the built-in `md5' doesn't
+       ;;    allow the 4th argument.
+       ;; 2. `md5' has been defined by one of some lisp libraries.
+       ;; 3. This file is being compiled in the Gnus source tree,
+       ;;    and `md5' has been defined in lpath.el.
+       (defalias 'pop3-md5 'md5))
+    ;; The lisp function will be provided by FLIM or other libraries.
+    (autoload 'md5 "md5")
+    (defalias 'pop3-md5 'md5)))

 
 (defun pop3-apop (process user)
   "Send alternate authentication information to the server."
   (let ((pass pop3-password))
     (if (and pop3-password-required (not pass))
        (setq pass
 
 (defun pop3-apop (process user)
   "Send alternate authentication information to the server."
   (let ((pass pop3-password))
     (if (and pop3-password-required (not pass))
        (setq pass

-             (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+             (read-passwd (format "Password for %s: " pop3-maildrop))))

     (if pass
     (if pass

-       (let ((hash (static-if (and (fboundp 'md5)
-                                   (subrp (symbol-function 'md5)))
-                       (md5 (concat pop3-timestamp pass))
-                     (pop3-md5 (concat pop3-timestamp pass)))))
+       (let ((hash (pop3-md5 (concat pop3-timestamp pass))))

          (pop3-send-command process (format "APOP %s %s" user hash))
          (let ((response (pop3-read-response process t)))
            (if (not (and response (string-match "+OK" response)))
          (pop3-send-command process (format "APOP %s %s" user hash))
          (let ((response (pop3-read-response process t)))
            (if (not (and response (string-match "+OK" response)))

@@ -688,7 +700,7 @@ If msgno is invalid, return nil.  Otherwise, return a string."
     (set-buffer (process-buffer process))
     (goto-char start)
     (while (not (re-search-forward "^\\.\r\n" nil t))
     (set-buffer (process-buffer process))
     (goto-char start)
     (while (not (re-search-forward "^\\.\r\n" nil t))

-      (accept-process-output process 3)
+      (nnheader-accept-process-output process)

       (goto-char start))
     (setq pop3-read-point (point-marker))
     (goto-char (match-beginning 0))
       (goto-char start))
     (setq pop3-read-point (point-marker))
     (goto-char (match-beginning 0))