lisp/pop3-fma.el: Require mel-b-el if mel-b does not exist.

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

diff --git a/lisp/nntp.el b/lisp/nntp.el
index fa99b1e..3f1c00f 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -1,7 +1,7 @@
 ;;; nntp.el --- nntp access for Gnus
 ;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
 
 ;;; nntp.el --- nntp access for Gnus
 ;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
 

-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.

@@ -30,10 +30,6 @@
 
 (nnoo-declare nntp)
 
 
 (nnoo-declare nntp)
 

-(eval-and-compile
-  (unless (fboundp 'open-network-stream)
-    (require 'tcp)))
-

 (eval-when-compile (require 'cl))
 
 (defvoo nntp-address nil
 (eval-when-compile (require 'cl))
 
 (defvoo nntp-address nil

@@ -45,13 +41,11 @@
 (defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
   "*Hook used for sending commands to the server at startup.
 The default value is `nntp-send-mode-reader', which makes an innd
 (defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
   "*Hook used for sending commands to the server at startup.
 The default value is `nntp-send-mode-reader', which makes an innd

-server spawn an nnrpd server.  Another useful function to put in this
-hook might be `nntp-send-authinfo', which will prompt for a password
-to allow posting from the server.  Note that this is only necessary to
-do on servers that use strict access control.")
+server spawn an nnrpd server.")

 
 (defvoo nntp-authinfo-function 'nntp-send-authinfo
 
 (defvoo nntp-authinfo-function 'nntp-send-authinfo

-  "Function used to send AUTHINFO to the server.")
+  "Function used to send AUTHINFO to the server.
+It is called with no parameters.")

 
 (defvoo nntp-server-action-alist
   '(("nntpd 1\\.5\\.11t"
 
 (defvoo nntp-server-action-alist
   '(("nntpd 1\\.5\\.11t"

@@ -144,10 +138,6 @@ by one.")
 If the gap between two consecutive articles is bigger than this
 variable, split the XOVER request into two requests.")
 
 If the gap between two consecutive articles is bigger than this
 variable, split the XOVER request into two requests.")
 

-(defvoo nntp-connection-timeout nil
-  "*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.")
-

 (defvoo nntp-prepare-server-hook nil
   "*Hook run before a server is opened.
 If can be used to set up a server remotely, for instance.  Say you
 (defvoo nntp-prepare-server-hook nil
   "*Hook run before a server is opened.
 If can be used to set up a server remotely, for instance.  Say you

@@ -185,6 +175,10 @@ server there that you can connect to.  See also
 
 \f
 
 
 \f
 

+(defvoo nntp-connection-timeout nil
+  "*Number of seconds to wait before an nntp connection times out.
+If this variable is nil, which is the default, no timers are set.")
+

 ;;; Internal variables.
 
 (defvar nntp-record-commands nil
 ;;; Internal variables.
 
 (defvar nntp-record-commands nil

@@ -201,6 +195,7 @@ server there that you can connect to.  See also
 (defvoo nntp-last-command-time nil)
 (defvoo nntp-last-command nil)
 (defvoo nntp-authinfo-password nil)
 (defvoo nntp-last-command-time nil)
 (defvoo nntp-last-command nil)
 (defvoo nntp-authinfo-password nil)

+(defvoo nntp-authinfo-user nil)

 
 (defvar nntp-connection-list nil)
 
 
 (defvar nntp-connection-list nil)
 

@@ -215,7 +210,8 @@ server there that you can connect to.  See also
 (defvoo nntp-server-list-active-group 'try)
 
 (eval-and-compile
 (defvoo nntp-server-list-active-group 'try)
 
 (eval-and-compile

-  (autoload 'nnmail-read-passwd "nnmail"))
+  (autoload 'nnmail-read-passwd "nnmail")
+  (autoload 'open-ssl-stream "ssl"))

 
 \f
 
 
 \f
 

@@ -237,8 +233,10 @@ server there that you can connect to.  See also
   (save-excursion
     (set-buffer (get-buffer-create "*nntp-log*"))
     (goto-char (point-max))
   (save-excursion
     (set-buffer (get-buffer-create "*nntp-log*"))
     (goto-char (point-max))

-    (insert (format-time-string "%Y%m%dT%H%M%S" (current-time))
-           " " nntp-address " " string "\n")))
+    (let ((time (current-time)))
+      (insert (format-time-string "%Y%m%dT%H%M%S" time)
+             "." (format "%03d" (/ (nth 2 time) 1000))
+             " " nntp-address " " string "\n"))))

 
 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
   "Wait for WAIT-FOR to arrive from PROCESS."
 
 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
   "Wait for WAIT-FOR to arrive from PROCESS."

@@ -278,7 +276,7 @@ server there that you can connect to.  See also
              ;; Nix out "nntp reading...." message.
              (when nntp-have-messaged
                (setq nntp-have-messaged nil)
              ;; Nix out "nntp reading...." message.
              (when nntp-have-messaged
                (setq nntp-have-messaged nil)

-               (message ""))
+               (nnheader-message 5 ""))

              t))))
       (unless discard
        (erase-buffer)))))
              t))))
       (unless discard
        (erase-buffer)))))

@@ -395,18 +393,22 @@ server there that you can connect to.  See also
 (nnoo-define-basics nntp)
 
 (defsubst nntp-next-result-arrived-p ()
 (nnoo-define-basics nntp)
 
 (defsubst nntp-next-result-arrived-p ()

-  (let ((point (point)))
-    (cond
-     ((eq (following-char) ?2)
-      (if (re-search-forward "\n\\.\r?\n" nil t)
-         t
-       (goto-char point)
-       nil))
-     ((looking-at "[34]")
-      (forward-line 1)
-      t)
-     (t
-      nil))))
+  (cond
+   ;; A result that starts with a 2xx code is terminated by
+   ;; a line with only a "." on it.
+   ((eq (char-after) ?2)
+    (if (re-search-forward "\n\\.\r?\n" nil t)
+       t
+      nil))
+   ;; A result that starts with a 3xx or 4xx code is terminated
+   ;; by a newline.
+   ((looking-at "[34]")
+    (if (search-forward "\n" nil t)
+       t
+      nil))
+   ;; No result here.
+   (t
+    nil)))

 
 (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
   "Retrieve the headers of ARTICLES."
 
 (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
   "Retrieve the headers of ARTICLES."

@@ -543,7 +545,7 @@ server there that you can connect to.  See also
          (nntp-inhibit-erase t)
          (map (apply 'vector articles))
          (point 1)
          (nntp-inhibit-erase t)
          (map (apply 'vector articles))
          (point 1)

-         article alist)
+         article)

       (set-buffer buf)
       (erase-buffer)
       ;; Send ARTICLE command.
       (set-buffer buf)
       (erase-buffer)
       ;; Send ARTICLE command.

@@ -583,7 +585,7 @@ server there that you can connect to.  See also
           (nnheader-message 6 "NNTP: Receiving articles...done"))
       
       ;; Now we have all the responses.  We go through the results,
           (nnheader-message 6 "NNTP: Receiving articles...done"))
       
       ;; Now we have all the responses.  We go through the results,

-      ;; washes it and copies it over to the server buffer.
+      ;; wash it and copy it over to the server buffer.

       (set-buffer nntp-server-buffer)
       (erase-buffer)
       (setq last-point (point-min))
       (set-buffer nntp-server-buffer)
       (erase-buffer)
       (setq last-point (point-min))

@@ -676,15 +678,20 @@ server there that you can connect to.  See also
 
 (deffoo nntp-close-server (&optional server)
   (nntp-possibly-change-group nil server t)
 
 (deffoo nntp-close-server (&optional server)
   (nntp-possibly-change-group nil server t)

-  (let (process)
-    (while (setq process (car (pop nntp-connection-alist)))
+  (let ((process (nntp-find-connection nntp-server-buffer)))
+    (while process

       (when (memq (process-status process) '(open run))
        (ignore-errors
          (nntp-send-string process "QUIT")
          (unless (eq nntp-open-connection-function 'nntp-open-network-stream)
       (when (memq (process-status process) '(open run))
        (ignore-errors
          (nntp-send-string process "QUIT")
          (unless (eq nntp-open-connection-function 'nntp-open-network-stream)

+           ;; Ok, this is evil, but when using telnet and stuff
+           ;; as the connection method, it's important that the
+           ;; QUIT command actually is sent out before we kill
+           ;; the process.  

            (sleep-for 1))))
       (when (buffer-name (process-buffer process))
            (sleep-for 1))))
       (when (buffer-name (process-buffer process))

-       (kill-buffer (process-buffer process))))
+       (kill-buffer (process-buffer process)))
+      (setq process (car (pop nntp-connection-alist))))

     (nnoo-close-server 'nntp)))
 
 (deffoo nntp-request-close ()
     (nnoo-close-server 'nntp)))
 
 (deffoo nntp-request-close ()

@@ -714,16 +721,11 @@ server there that you can connect to.  See also
   (nntp-possibly-change-group nil server)
   (save-excursion
     (set-buffer nntp-server-buffer)
   (nntp-possibly-change-group nil server)
   (save-excursion
     (set-buffer nntp-server-buffer)

-    (let* ((date (timezone-parse-date date))
-          (time-string
-           (format "%s%02d%02d %s%s%s"
-                   (substring (aref date 0) 2) (string-to-int (aref date 1))
-                   (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
-                   (substring
-                    (aref date 3) 3 5) (substring (aref date 3) 6 8))))
-      (prog1
-         (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
-       (nntp-decode-text)))))
+    (prog1
+       (nntp-send-command
+        "^\\.\r?\n" "NEWGROUPS"
+        (format-time-string "%y%m%d %H%M%S" (date-to-time date)))
+      (nntp-decode-text))))

 
 (deffoo nntp-request-post (&optional server)
   (nntp-possibly-change-group nil server)
 
 (deffoo nntp-request-post (&optional server)
   (nntp-possibly-change-group nil server)

@@ -749,33 +751,40 @@ reading."
   "Send the AUTHINFO to the nntp server.
 It will look in the \"~/.authinfo\" file for matching entries.  If
 nothing suitable is found there, it will prompt for a user name
   "Send the AUTHINFO to the nntp server.
 It will look in the \"~/.authinfo\" file for matching entries.  If
 nothing suitable is found there, it will prompt for a user name

-and a password."
+and a password.
+
+If SEND-IF-FORCE, only send authinfo to the server if the
+.authinfo file has the FORCE token."

   (let* ((list (gnus-parse-netrc nntp-authinfo-file))
         (alist (gnus-netrc-machine list nntp-address))
         (force (gnus-netrc-get alist "force"))
   (let* ((list (gnus-parse-netrc nntp-authinfo-file))
         (alist (gnus-netrc-machine list nntp-address))
         (force (gnus-netrc-get alist "force"))

-        (user (gnus-netrc-get alist "login"))
+        (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))

         (passwd (gnus-netrc-get alist "password")))
     (when (or (not send-if-force)
              force)
         (passwd (gnus-netrc-get alist "password")))
     (when (or (not send-if-force)
              force)

-      (nntp-send-command
-       "^3.*\r?\n" "AUTHINFO USER"
-       (or user (read-string (format "NNTP (%s) user name: " nntp-address))))
+      (unless user
+       (setq user (read-string (format "NNTP (%s) user name: " nntp-address))
+             nntp-authinfo-user user))
+      (unless (member user '(nil ""))
+       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
+       (when t                         ;???Should check if AUTHINFO succeeded

       (nntp-send-command
        "^2.*\r?\n" "AUTHINFO PASS"
        (or passwd
           nntp-authinfo-password
           (setq nntp-authinfo-password
       (nntp-send-command
        "^2.*\r?\n" "AUTHINFO PASS"
        (or passwd
           nntp-authinfo-password
           (setq nntp-authinfo-password

-                (nnmail-read-passwd (format "NNTP (%s) password: "
-                                            nntp-address))))))))
+                    (nnmail-read-passwd (format "NNTP (%s@%s) password: "
+                                                user nntp-address))))))))))

 
 (defun nntp-send-nosy-authinfo ()
   "Send the AUTHINFO to the nntp server."
 
 (defun nntp-send-nosy-authinfo ()
   "Send the AUTHINFO to the nntp server."

-  (nntp-send-command
-   "^3.*\r?\n" "AUTHINFO USER"
-   (read-string (format "NNTP (%s) user name: " nntp-address)))
-  (nntp-send-command
-   "^2.*\r?\n" "AUTHINFO PASS"
-   (nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
+  (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
+    (unless (member user '(nil ""))
+      (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
+      (when t                          ;???Should check if AUTHINFO succeeded
+       (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
+                          (nnmail-read-passwd "NNTP (%s@%s) password: "
+                                              user nntp-address))))))

 
 (defun nntp-send-authinfo-from-file ()
   "Send the AUTHINFO to the nntp server.
 
 (defun nntp-send-authinfo-from-file ()
   "Send the AUTHINFO to the nntp server.

@@ -783,7 +792,7 @@ and a password."
 The authinfo login name is taken from the user's login name and the
 password contained in '~/.nntp-authinfo'."
   (when (file-exists-p "~/.nntp-authinfo")
 The authinfo login name is taken from the user's login name and the
 password contained in '~/.nntp-authinfo'."
   (when (file-exists-p "~/.nntp-authinfo")

-    (nnheader-temp-write nil
+    (with-temp-buffer

       (insert-file-contents "~/.nntp-authinfo")
       (goto-char (point-min))
       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
       (insert-file-contents "~/.nntp-authinfo")
       (goto-char (point-min))
       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))

@@ -812,7 +821,6 @@ password contained in '~/.nntp-authinfo'."
       (format " *server %s %s %s*"
              nntp-address nntp-port-number
              (gnus-buffer-exists-p buffer))))
       (format " *server %s %s %s*"
              nntp-address nntp-port-number
              (gnus-buffer-exists-p buffer))))

-    (buffer-disable-undo (current-buffer))

     (set (make-local-variable 'after-change-functions) nil)
     (set (make-local-variable 'nntp-process-wait-for) nil)
     (set (make-local-variable 'nntp-process-callback) nil)
     (set (make-local-variable 'after-change-functions) nil)
     (set (make-local-variable 'nntp-process-wait-for) nil)
     (set (make-local-variable 'nntp-process-callback) nil)

@@ -825,13 +833,24 @@ password contained in '~/.nntp-authinfo'."
   "Open a connection to PORT on ADDRESS delivering output to BUFFER."
   (run-hooks 'nntp-prepare-server-hook)
   (let* ((pbuffer (nntp-make-process-buffer buffer))
   "Open a connection to PORT on ADDRESS delivering output to BUFFER."
   (run-hooks 'nntp-prepare-server-hook)
   (let* ((pbuffer (nntp-make-process-buffer buffer))

+        (timer 
+         (and nntp-connection-timeout 
+              (nnheader-run-at-time
+               nntp-connection-timeout nil
+               `(lambda ()
+                  (when (buffer-name ,pbuffer)
+                    (kill-buffer ,pbuffer))))))

         (process
          (condition-case ()
         (process
          (condition-case ()

-             (let ((coding-system-for-read nntp-coding-system-for-read))
+             (let ((coding-system-for-read nntp-coding-system-for-read)
+                    (coding-system-for-write nntp-coding-system-for-write))

                (funcall nntp-open-connection-function pbuffer))
            (error nil)
            (quit nil))))
                (funcall nntp-open-connection-function pbuffer))
            (error nil)
            (quit nil))))

-    (when process
+    (when timer 
+      (nnheader-cancel-timer timer))
+    (when (and (buffer-name pbuffer)
+              process)

       (process-kill-without-query process)
       (nntp-wait-for process "^.*\n" buffer nil t)
       (if (memq (process-status process) '(open run))
       (process-kill-without-query process)
       (nntp-wait-for process "^.*\n" buffer nil t)
       (if (memq (process-status process) '(open run))

@@ -853,6 +872,16 @@ password contained in '~/.nntp-authinfo'."
 (defun nntp-open-network-stream (buffer)
   (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
 
 (defun nntp-open-network-stream (buffer)
   (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
 

+(defun nntp-open-ssl-stream (buffer)
+  (let* ((ssl-program-arguments '("-connect" (concat host ":" service)))
+        (proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number)))
+    (save-excursion
+      (set-buffer buffer)
+      (nntp-wait-for-string "^\r*20[01]")
+      (beginning-of-line)
+      (delete-region (point-min) (point))
+      proc)))
+

 (defun nntp-read-server-type ()
   "Find out what the name of the server we have connected to is."
   ;; Wait for the status string to arrive.
 (defun nntp-read-server-type ()
   "Find out what the name of the server we have connected to is."
   ;; Wait for the status string to arrive.

@@ -985,11 +1014,7 @@ password contained in '~/.nntp-authinfo'."
     (while (not (eobp))
       (end-of-line)
       (delete-char 1)
     (while (not (eobp))
       (end-of-line)
       (delete-char 1)

-      (insert nntp-end-of-line)
-      (forward-line 1))
-    (forward-char -1)
-    (unless (eq (char-after (1- (point))) ?\r)
-      (insert "\r"))))
+      (insert nntp-end-of-line))))

 
 (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
   (set-buffer nntp-server-buffer)
 
 (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
   (set-buffer nntp-server-buffer)