X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=d7665b5ed8c3a6ffdd51b4c726776e49efe5155a;hb=e26fff84f7d5dd7f59fa084659a7f4fff92cb07a;hp=839454725109f3f6bddf74895ad2023ba0223e3f;hpb=59dc6ab8e643c27475ab9b5b339c9e1dade9fed4;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index 8394547..d7665b5 100644 --- 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. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -30,10 +30,6 @@ (nnoo-declare nntp) -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - (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 -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" @@ -84,7 +78,7 @@ the same.") The default is \"rsh\", but \"ssh\" is a popular alternative.") (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-login'. + "*Parameters to `nntp-open-rlogin'. That function may be used as `nntp-open-connection-function'. In that case, this list will be used as the parameter list given to rsh.") @@ -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.") -(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 @@ -160,14 +150,8 @@ 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" - "Docstring." + ".netrc-like file that holds nntp authinfo passwords." :type '(choice file (repeat :tag "Entries" @@ -185,6 +169,10 @@ server there that you can connect to. See also +(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 @@ -201,6 +189,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-authinfo-user nil) (defvar nntp-connection-list nil) @@ -215,7 +204,8 @@ server there that you can connect to. See also (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")) @@ -236,16 +226,20 @@ server there that you can connect to. See also "Record the command STRING." (save-excursion (set-buffer (get-buffer-create "*nntp-log*")) - (insert (format-time-string "%Y%m%dT%H%M%S" (current-time)) - " " nntp-address " " string "\n"))) + (goto-char (point-max)) + (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." (save-excursion (set-buffer (process-buffer process)) (goto-char (point-min)) - (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) - (looking-at "480")) + (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) + (looking-at "480")) + (memq (process-status process) '(open run))) (when (looking-at "480") (nntp-handle-authinfo process)) (nntp-accept-process-output process) @@ -256,7 +250,7 @@ server there that you can connect to. See also (progn (nntp-snarf-error-message) nil)) - ((memq (process-status process) '(open run)) + ((not (memq (process-status process) '(open run))) (nnheader-report 'nntp "Server closed connection")) (t (goto-char (point-max)) @@ -276,7 +270,7 @@ server there that you can connect to. See also ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) - (message "")) + (nnheader-message 5 "")) t)))) (unless discard (erase-buffer))))) @@ -393,18 +387,22 @@ server there that you can connect to. See also (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 (following-char) ?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." @@ -541,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. @@ -581,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)) @@ -644,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)))) @@ -674,15 +672,20 @@ server there that you can connect to. See also (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) + ;; 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)))) + (kill-buffer (process-buffer process))) + (setq process (car (pop nntp-connection-alist)))) (nnoo-close-server 'nntp))) (deffoo nntp-request-close () @@ -712,16 +715,11 @@ server there that you can connect to. See also (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" (nnmail-date-to-time date))) + (nntp-decode-text)))) (deffoo nntp-request-post (&optional server) (nntp-possibly-change-group nil server) @@ -743,41 +741,47 @@ It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\r?\n" "MODE READER")) -(defun nntp-send-authinfo () +(defun nntp-send-authinfo (&optional send-if-force) "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. 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)) - (user (gnus-netrc-get alist "login")) + (force (gnus-netrc-get alist "force")) + (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) (passwd (gnus-netrc-get alist "password"))) - (nntp-send-command - "^3.*\r?\n" "AUTHINFO USER" - (or user (read-string (format "NNTP (%s) user name: " nntp-address)))) - (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))))))) + (when (or (not send-if-force) + force) + (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@%s) password: " + user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will prompt for a password." - (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))) + "Send the AUTHINFO to the nntp server." + (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. -This function is supposed to be called from `nntp-server-opened-hook'. The authinfo login name is taken from the user's login name and the password contained in '~/.nntp-authinfo'." @@ -810,7 +814,7 @@ password contained in '~/.nntp-authinfo'." (generate-new-buffer (format " *server %s %s %s*" nntp-address nntp-port-number - (buffer-name (get-buffer buffer))))) + (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) @@ -824,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)) @@ -843,13 +856,25 @@ password contained in '~/.nntp-authinfo'." (erase-buffer) (set-buffer nntp-server-buffer) (let ((nnheader-callback-function nil)) - (run-hooks 'nntp-server-opened-hook)))) + (run-hooks 'nntp-server-opened-hook) + (nntp-send-authinfo t)))) (when (buffer-name (process-buffer process)) (kill-buffer (process-buffer process))) 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))) + (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." @@ -883,11 +908,11 @@ password contained in '~/.nntp-authinfo'." (when (and (> (point) nntp-process-start-point) (re-search-backward nntp-process-wait-for nntp-process-start-point t)) - (when (buffer-name (get-buffer nntp-process-to-buffer)) + (when (gnus-buffer-exists-p nntp-process-to-buffer) (let ((cur (current-buffer)) (start nntp-process-start-point)) (save-excursion - (set-buffer (get-buffer nntp-process-to-buffer)) + (set-buffer nntp-process-to-buffer) (goto-char (point-max)) (let ((b (point))) (insert-buffer-substring cur start) @@ -943,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)))))) @@ -982,8 +1009,8 @@ password contained in '~/.nntp-authinfo'." (goto-char (point-min)) (while (not (eobp)) (end-of-line) - (insert "\r") - (forward-line 1)))) + (delete-char 1) + (insert nntp-end-of-line)))) (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (set-buffer nntp-server-buffer) @@ -1136,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") @@ -1183,18 +1211,21 @@ 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)))) - (set-buffer buffer) - (nntp-wait-for-string "^\r*20[01]") - (beginning-of-line) - (delete-region (point-min) (point)) - proc)) + (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]") + (beginning-of-line) + (delete-region (point-min) (point)) + proc))) (defun nntp-find-group-and-number () (save-excursion