This commit was generated by cvs2svn to compensate for changes in r2758,
[elisp/gnus.git-] / lisp / nntp.el
index 763c614..d7665b5 100644 (file)
 
 (nnoo-declare nntp)
 
-(eval-and-compile
-  (unless (fboundp 'open-network-stream)
-    (require 'tcp)))
-
 (eval-when-compile (require 'cl))
 
 (defvoo nntp-address nil
 (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
-  "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"
@@ -156,12 +150,6 @@ server there that you can connect to.  See also
 (defvoo nntp-warn-about-losing-connection t
   "*If non-nil, beep when a server closes connection.")
 
-(defvoo nntp-coding-system-for-read 'binary
-  "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
-  "*Coding system to write to NNTP.")
-
 (defcustom nntp-authinfo-file "~/.authinfo"
   ".netrc-like file that holds nntp authinfo passwords."
   :type
@@ -181,6 +169,10 @@ server there that you can connect to.  See also
 
 \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
@@ -402,7 +394,7 @@ server there that you can connect to.  See also
     (if (re-search-forward "\n\\.\r?\n" nil t)
        t
       nil))
-   ;; A result that startx with a 3xx or 4xx code is terminated
+   ;; A result that starts with a 3xx or 4xx code is terminated
    ;; by a newline.
    ((looking-at "[34]")
     (if (search-forward "\n" nil t)
@@ -547,7 +539,7 @@ server there that you can connect to.  See also
          (nntp-inhibit-erase t)
          (map (apply 'vector articles))
          (point 1)
-         article alist)
+         article)
       (set-buffer buf)
       (erase-buffer)
       ;; Send ARTICLE command.
@@ -587,7 +579,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,
-      ;; 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))
@@ -650,7 +642,7 @@ server there that you can connect to.  See also
 
 (deffoo nntp-request-group (group &optional server dont-check)
   (nntp-possibly-change-group nil server)
-  (when (nntp-send-command "^21.*\n" "GROUP" group)
+  (when (nntp-send-command "^[245].*\n" "GROUP" group)
     (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
       (setcar (cddr entry) group))))
 
@@ -686,6 +678,10 @@ server there that you can connect to.  See also
        (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))
        (kill-buffer (process-buffer process)))
@@ -749,36 +745,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
-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"))
-        (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)
-      (nntp-send-command
-       "^3.*\r?\n" "AUTHINFO USER"
-       (or user
-          nntp-authinfo-user
-          (setq nntp-authinfo-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
-                (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."
-  (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.
@@ -828,13 +828,22 @@ 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))
+        (timer 
+         (and nntp-connection-timeout 
+              (nnheader-run-at-time
+               nntp-connection-timeout nil
+               `(lambda ()
+                  (when (buffer-name ,pbuffer)
+                    (kill-buffer ,pbuffer))))))
         (process
          (condition-case ()
-             (let ((coding-system-for-read nntp-coding-system-for-read))
-               (funcall nntp-open-connection-function pbuffer))
+             (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))
@@ -854,7 +863,8 @@ password contained in '~/.nntp-authinfo'."
        nil))))
 
 (defun nntp-open-network-stream (buffer)
-  (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+  (open-network-stream-as-binary
+   "nntpd" buffer nntp-address nntp-port-number))
 
 (defun nntp-open-ssl-stream (buffer)
   (let* ((ssl-program-arguments '("-connect" (concat host ":" service)))
@@ -958,7 +968,9 @@ password contained in '~/.nntp-authinfo'."
          (set-buffer (process-buffer (car entry)))
          (erase-buffer)
          (nntp-send-string (car entry) (concat "GROUP " group))
-         (nntp-wait-for-string "^2.*\n")
+         ;; allow for unexpected responses, since this can be called
+         ;; from a timer with quit inhibited
+         (nntp-wait-for-string "^[245].*\n")
          (setcar (cddr entry) group)
          (erase-buffer))))))
 
@@ -998,10 +1010,7 @@ password contained in '~/.nntp-authinfo'."
     (while (not (eobp))
       (end-of-line)
       (delete-char 1)
-      (insert nntp-end-of-line))
-    (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)
@@ -1154,9 +1163,10 @@ password contained in '~/.nntp-authinfo'."
   (save-excursion
     (set-buffer buffer)
     (erase-buffer)
-    (let ((proc (apply
-                'start-process
-                "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
+    (let ((proc (as-binary-process
+                (apply
+                 'start-process
+                 "nntpd" buffer nntp-telnet-command nntp-telnet-switches)))
          (case-fold-search t))
       (when (memq (process-status proc) '(open run))
        (process-send-string proc "set escape \^X\n")
@@ -1201,13 +1211,15 @@ password contained in '~/.nntp-authinfo'."
 (defun nntp-open-rlogin (buffer)
   "Open a connection to SERVER using rsh."
   (let ((proc (if nntp-rlogin-user-name
-                 (apply 'start-process
-                        "nntpd" buffer nntp-rlogin-program
-                        nntp-address "-l" nntp-rlogin-user-name
-                        nntp-rlogin-parameters)
-               (apply 'start-process
-                      "nntpd" buffer nntp-rlogin-program nntp-address
-                      nntp-rlogin-parameters))))
+                 (as-binary-process
+                  (apply 'start-process
+                         "nntpd" buffer nntp-rlogin-program
+                         nntp-address "-l" nntp-rlogin-user-name
+                         nntp-rlogin-parameters))
+               (as-binary-process
+                (apply 'start-process
+                       "nntpd" buffer nntp-rlogin-program nntp-address
+                       nntp-rlogin-parameters)))))
     (save-excursion
       (set-buffer buffer)
       (nntp-wait-for-string "^\r*20[01]")