X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnntp.el;h=5510a07146f41a1b456fec967e2f56d9fb42397c;hp=4e9518f8295258cd06a9a83e6cdb917c88cb172e;hb=4c2a7a1c25d5b10316f35f28c972ef3e70225f25;hpb=6e1cbeb01081832db153f1087ee5ba09d1708350 diff --git a/lisp/nntp.el b/lisp/nntp.el index 4e9518f82..5510a0714 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,42 +1,46 @@ ;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, -;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990, 1992-1998, 2000-2011 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; 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 the Free Software Foundation; either version 2, or (at your -;; option) any later version. +;; 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 +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, -;; MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (require 'nnheader) (require 'nnoo) (require 'gnus-util) (require 'gnus) +(require 'proto-stream) +(require 'gnus-group) ;; gnus-group-name-charset (nnoo-declare nntp) (eval-when-compile (require 'cl)) +(autoload 'auth-source-user-or-password "auth-source") + (defgroup nntp nil "NNTP access for Gnus." :group 'gnus) @@ -81,15 +85,33 @@ host. Direct connections: - `nntp-open-network-stream' (the default), +- `network-only' (the same as the above, but don't do automatic + STARTTLS upgrades). - `nntp-open-ssl-stream', - `nntp-open-tls-stream', +- `nntp-open-netcat-stream'. - `nntp-open-telnet-stream'. Indirect connections: -- `nntp-open-via-rlogin-and-telnet', - `nntp-open-via-rlogin-and-netcat', +- `nntp-open-via-rlogin-and-telnet', - `nntp-open-via-telnet-and-telnet'.") +(defvoo nntp-never-echoes-commands nil + "*Non-nil means the nntp server never echoes commands. +It is reported that some nntps server doesn't echo commands. So, you +may want to set this to non-nil in the method for such a server setting +`nntp-open-connection-function' to `nntp-open-ssl-stream' for example. +Note that the `nntp-open-connection-functions-never-echo-commands' +variable overrides the nil value of this variable.") + +(defvoo nntp-open-connection-functions-never-echo-commands + '(nntp-open-network-stream) + "*List of functions that never echo commands. +Add or set a function which you set to `nntp-open-connection-function' +to this list if it does not echo commands. Note that a non-nil value +of the `nntp-never-echoes-commands' variable overrides this variable.") + (defvoo nntp-pre-command nil "*Pre-command to use with the various nntp-open-via-* methods. This is where you would put \"runsocks\" or stuff like that.") @@ -104,8 +126,8 @@ This command is used by the methods `nntp-open-telnet-stream', (defvoo nntp-end-of-line "\r\n" "*String to use on the end of lines when talking to the NNTP server. -This is \"\\r\\n\" by default, but should be \"\\n\" when using and -indirect telnet connection method (nntp-open-via-*-and-telnet).") +This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect +connection method (nntp-open-via-*).") (defvoo nntp-via-rlogin-command "rsh" "*Rlogin command used to connect to an intermediate host. @@ -127,12 +149,13 @@ This command is used by the `nntp-open-via-telnet-and-telnet' method.") (defvoo nntp-via-telnet-switches '("-8") "*Switches given to the telnet command `nntp-via-telnet-command'.") -(defvoo nntp-via-netcat-command "nc" +(defvoo nntp-netcat-command "nc" "*Netcat command used to connect to the nntp server. -This command is used by the `nntp-open-via-rlogin-and-netcat' method.") +This command is used by the `nntp-open-netcat-stream' and +`nntp-open-via-rlogin-and-netcat' methods.") -(defvoo nntp-via-netcat-switches nil - "*Switches given to the netcat command `nntp-via-netcat-command'.") +(defvoo nntp-netcat-switches nil + "*Switches given to the netcat command `nntp-netcat-command'.") (defvoo nntp-via-user-name nil "*User name to log in on an intermediate host with. @@ -178,6 +201,14 @@ by one.") If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests.") +(defvoo nntp-xref-number-is-evil nil + "*If non-nil, Gnus never trusts article numbers in the Xref header. +Some news servers, e.g., ones running Diablo, run multiple engines +having the same articles but article numbers are not kept synchronized +between them. If you connect to such a server, set this to a non-nil +value, and Gnus never uses article numbers (that appear in the Xref +header and vary by which engine is chosen) to refer to articles.") + (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 @@ -205,7 +236,7 @@ See `nnml-marks-is-evil' for more information.") (defcustom nntp-marks-directory (nnheader-concat gnus-directory "marks/") "*The directory where marks for nntp groups will be stored." - :group 'gnus + :group 'nntp :type 'directory) (defcustom nntp-authinfo-file "~/.authinfo" @@ -237,6 +268,11 @@ NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") "*Hook run just before posting an article. It is supposed to be used to insert Cancel-Lock headers.") +(defvoo nntp-server-list-active-group 'try + "If nil, then always use GROUP instead of LIST ACTIVE. +This is usually slower, but on misconfigured servers that don't +update their active files often, this can help.") + ;;; Internal variables. (defvar nntp-record-commands nil @@ -254,6 +290,7 @@ to insert Cancel-Lock headers.") (defvoo nntp-last-command nil) (defvoo nntp-authinfo-password nil) (defvoo nntp-authinfo-user nil) +(defvoo nntp-authinfo-force nil) (defvar nntp-connection-list nil) @@ -265,24 +302,16 @@ to insert Cancel-Lock headers.") (defvoo nntp-inhibit-output nil) (defvoo nntp-server-xover 'try) -(defvoo nntp-server-list-active-group 'try) - -(defvar nntp-async-needs-kluge - (string-match "^GNU Emacs 20\\.3\\." (emacs-version)) - "*When non-nil, nntp will poll asynchronous connections -once a second. By default, this is turned on only for Emacs -20.3, which has a bug that breaks nntp's normal method of -noticing asynchronous data.") (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) -(defvar nntp-ssl-program - "openssl s_client -quiet -ssl3 -connect %s:%p" -"A string containing commands for SSL connections. -Within a string, %s is replaced with the server address and %p with -port number on server. The program should accept IMAP commands on -stdin and return responses to stdout.") +(defvar nntp-authinfo-rejected nil +"A custom error condition used to report 'Authentication Rejected' errors. +Condition handlers that match just this condition ensure that the nntp +backend doesn't catch this error.") +(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected)) +(put 'nntp-authinfo-rejected 'error-message "Authorization Rejected") @@ -303,8 +332,7 @@ stdin and return responses to stdout.") (defun nntp-record-command (string) "Record the command STRING." - (save-excursion - (set-buffer (get-buffer-create "*nntp-log*")) + (with-current-buffer (get-buffer-create "*nntp-log*") (goto-char (point-max)) (let ((time (current-time))) (insert (format-time-string "%Y%m%dT%H%M%S" time) @@ -332,18 +360,49 @@ be restored and the command retried." (throw 'nntp-with-open-group-error t)) +(defmacro nntp-insert-buffer-substring (buffer &optional start end) + "Copy string from unibyte buffer to multibyte current buffer." + (if (featurep 'xemacs) + `(insert-buffer-substring ,buffer ,start ,end) + `(if enable-multibyte-characters + (insert (with-current-buffer ,buffer + (mm-string-to-multibyte + ,(if (or start end) + `(buffer-substring (or ,start (point-min)) + (or ,end (point-max))) + '(buffer-string))))) + (insert-buffer-substring ,buffer ,start ,end)))) + +(defmacro nntp-copy-to-buffer (buffer start end) + "Copy string from unibyte current buffer to multibyte buffer." + (if (featurep 'xemacs) + `(copy-to-buffer ,buffer ,start ,end) + `(let ((string (buffer-substring ,start ,end))) + (with-current-buffer ,buffer + (erase-buffer) + (insert (if enable-multibyte-characters + (mm-string-to-multibyte string) + string)) + (goto-char (point-min)) + nil)))) + (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)) + + (with-current-buffer (process-buffer process) (goto-char (point-min)) + (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) - (looking-at "480")) + (looking-at "48[02]")) (memq (process-status process) '(open run))) - (when (looking-at "480") - (nntp-handle-authinfo process)) - (when (looking-at "^.*\n") - (delete-region (point) (progn (forward-line 1) (point)))) + (cond ((looking-at "480") + (nntp-handle-authinfo process)) + ((looking-at "482") + (nnheader-report 'nntp "%s" + (get 'nntp-authinfo-rejected 'error-message)) + (signal 'nntp-authinfo-rejected nil)) + ((looking-at "^.*\n") + (delete-region (point) (progn (forward-line 1) (point))))) (nntp-accept-process-output process) (goto-char (point-min))) (prog1 @@ -369,10 +428,9 @@ be restored and the command retried." (setq nntp-process-response response))) (nntp-decode-text (not decode)) (unless discard - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) + (nntp-insert-buffer-substring (process-buffer process)) ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) @@ -439,6 +497,8 @@ be restored and the command retried." (wait-for (nntp-wait-for process wait-for buffer decode)) (t t))) + (nntp-authinfo-rejected + (signal 'nntp-authinfo-rejected (cdr err))) (error (nnheader-report 'nntp "Couldn't open connection to %s: %s" address err)) @@ -464,19 +524,21 @@ be restored and the command retried." nntp-server-buffer wait-for nnheader-callback-function) ;; If nothing to wait for, still remove possibly echo'ed commands. - ;; We don't have echos if nntp-open-connection-function - ;; is `nntp-open-network-stream', so we skip this in that case. + ;; We don't have echoes if `nntp-never-echoes-commands' is non-nil + ;; or the value of `nntp-open-connection-function' is in + ;; `nntp-open-connection-functions-never-echo-commands', so we + ;; skip this in that cases. (unless (or wait-for - (equal nntp-open-connection-function - 'nntp-open-network-stream)) + nntp-never-echoes-commands + (memq + nntp-open-connection-function + nntp-open-connection-functions-never-echo-commands)) (nntp-accept-response) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (point-at-bol)))) - ))) + (point-at-bol))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -495,8 +557,7 @@ be restored and the command retried." ;; If nothing to wait for, still remove possibly echo'ed commands (unless wait-for (nntp-accept-response) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) @@ -522,8 +583,7 @@ be restored and the command retried." ;; If nothing to wait for, still remove possibly echo'ed commands (unless wait-for (nntp-accept-response) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) (point-at-bol)))) @@ -539,10 +599,12 @@ be restored and the command retried." (nntp-erase-buffer (nntp-find-connection-buffer nntp-server-buffer))) (nntp-encode-text) - (mm-with-unibyte-current-buffer - ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. - (process-send-region (nntp-find-connection nntp-server-buffer) - (point-min) (point-max))) + ;; Make sure we did not forget to encode some of the content. + (assert (save-excursion (goto-char (point-min)) + (not (re-search-forward "[^\000-\377]" nil t)))) + (mm-disable-multibyte) + (process-send-region (nntp-find-connection nntp-server-buffer) + (point-min) (point-max)) (nntp-retrieve-data nil nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function)) @@ -580,67 +642,79 @@ be restored and the command retried." (defvar nntp-with-open-group-internal nil) (defvar nntp-report-n nil)) +(defun nntp-with-open-group-function (-group -server -connectionless -bodyfun) + "Protect against servers that don't like clients that keep idle connections opens. +The problem being that these servers may either close a connection or +simply ignore any further requests on a connection. Closed +connections are not detected until `accept-process-output' has updated +the `process-status'. Dropped connections are not detected until the +connection timeouts (which may be several minutes) or +`nntp-connection-timeout' has expired. When these occur +`nntp-with-open-group', opens a new connection then re-issues the NNTP +command whose response triggered the error." + (letf ((nntp-report-n (symbol-function 'nntp-report)) + ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1)) + (nntp-with-open-group-internal nil)) + (while (catch 'nntp-with-open-group-error + ;; Open the connection to the server + ;; NOTE: Existing connections are NOT tested. + (nntp-possibly-change-group -group -server -connectionless) + + (let ((-timer + (and nntp-connection-timeout + (run-at-time + nntp-connection-timeout nil + (lambda () + (let* ((-process (nntp-find-connection + nntp-server-buffer)) + (-buffer (and -process + (process-buffer -process)))) + ;; When I an able to identify the + ;; connection to the server AND I've + ;; received NO reponse for + ;; nntp-connection-timeout seconds. + (when (and -buffer (eq 0 (buffer-size -buffer))) + ;; Close the connection. Take no + ;; other action as the accept input + ;; code will handle the closed + ;; connection. + (nntp-kill-buffer -buffer)))))))) + (unwind-protect + (setq nntp-with-open-group-internal + (condition-case nil + (funcall -bodyfun) + (quit + (unless debug-on-quit + (nntp-close-server)) + (signal 'quit nil)))) + (when -timer + (nnheader-cancel-timer -timer))) + nil)) + (setf (symbol-function 'nntp-report) nntp-report-n)) + nntp-with-open-group-internal)) + (defmacro nntp-with-open-group (group server &optional connectionless &rest forms) "Protect against servers that don't like clients that keep idle connections opens. The problem being that these servers may either close a connection or simply ignore any further requests on a connection. Closed -connections are not detected until accept-process-output has updated -the process-status. Dropped connections are not detected until the +connections are not detected until `accept-process-output' has updated +the `process-status'. Dropped connections are not detected until the connection timeouts (which may be several minutes) or -nntp-connection-timeout has expired. When these occur -nntp-with-open-group, opens a new connection then re-issues the NNTP +`nntp-connection-timeout' has expired. When these occur +`nntp-with-open-group', opens a new connection then re-issues the NNTP command whose response triggered the error." + (declare (indent 2) (debug (form form [&optional symbolp] def-body))) (when (and (listp connectionless) (not (eq connectionless nil))) (setq forms (cons connectionless forms) connectionless nil)) - `(letf ((nntp-report-n (symbol-function 'nntp-report)) - ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1)) - (nntp-with-open-group-internal nil)) - (while (catch 'nntp-with-open-group-error - ;; Open the connection to the server - ;; NOTE: Existing connections are NOT tested. - (nntp-possibly-change-group ,group ,server ,connectionless) - - (let ((timer - (and nntp-connection-timeout - (run-at-time - nntp-connection-timeout nil - '(lambda () - (let ((process (nntp-find-connection - nntp-server-buffer)) - (buffer (and process - (process-buffer process)))) - ;; When I an able to identify the - ;; connection to the server AND I've - ;; received NO reponse for - ;; nntp-connection-timeout seconds. - (when (and buffer (eq 0 (buffer-size buffer))) - ;; Close the connection. Take no - ;; other action as the accept input - ;; code will handle the closed - ;; connection. - (nntp-kill-buffer buffer)))))))) - (unwind-protect - (setq nntp-with-open-group-internal - (condition-case nil - (progn ,@forms) - (quit - (unless debug-on-quit - (nntp-close-server)) - (signal 'quit nil)))) - (when timer - (nnheader-cancel-timer timer))) - nil)) - (setf (symbol-function 'nntp-report) nntp-report-n)) - nntp-with-open-group-internal)) + `(nntp-with-open-group-function ,group ,server ,connectionless (lambda () ,@forms))) (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) "Retrieve the headers of ARTICLES." (nntp-with-open-group group server - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) + (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer) (erase-buffer) (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) @@ -696,7 +770,7 @@ command whose response triggered the error." (nnheader-fold-continuation-lines) ;; Remove all "\r"'s. (nnheader-strip-cr) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'headers))))) (deffoo nntp-retrieve-groups (groups &optional server) @@ -778,7 +852,8 @@ command whose response triggered the error." (if (not nntp-server-list-active-group) (progn - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (nntp-copy-to-buffer nntp-server-buffer + (point-min) (point-max)) 'group) ;; We have read active entries, so we just delete the ;; superfluous gunk. @@ -786,7 +861,7 @@ command whose response triggered the error." (while (re-search-forward "^[.2-5]" nil t) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'active))))))) (deffoo nntp-retrieve-articles (articles &optional group server) @@ -851,7 +926,7 @@ command whose response triggered the error." (narrow-to-region (setq point (goto-char (point-max))) (progn - (insert-buffer-substring buf last-point (cdr entry)) + (nntp-insert-buffer-substring buf last-point (cdr entry)) (point-max))) (setq last-point (cdr entry)) (nntp-decode-text) @@ -861,8 +936,7 @@ command whose response triggered the error." (defun nntp-try-list-active (group) (nntp-list-active-group group) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (goto-char (point-min)) (cond ((or (eobp) (looking-at "5[0-9]+")) @@ -890,8 +964,7 @@ command whose response triggered the error." (if (numberp article) (int-to-string article) article)) (if (and buffer (not (equal buffer nntp-server-buffer))) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (copy-to-buffer buffer (point-min) (point-max)) (nntp-find-group-and-number group)) (nntp-find-group-and-number group))))) @@ -913,7 +986,7 @@ command whose response triggered the error." "\r?\n\\.\r?\n" "BODY" (if (numberp article) (int-to-string article) article)))) -(deffoo nntp-request-group (group &optional server dont-check) +(deffoo nntp-request-group (group &optional server dont-check info) (nntp-with-open-group nil server (when (nntp-send-command "^[245].*\n" "GROUP" group) @@ -940,7 +1013,8 @@ command whose response triggered the error." (unless (assq 'nntp-address defs) (setq defs (append defs (list (list 'nntp-address server))))) (nnoo-change-server 'nntp server defs) - (unless connectionless + (if connectionless + t (or (nntp-find-connection nntp-server-buffer) (nntp-open-connection nntp-server-buffer))))) @@ -988,8 +1062,7 @@ command whose response triggered the error." (deffoo nntp-request-newgroups (date &optional server) (nntp-with-open-group nil server - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (let* ((time (date-to-time date)) (ls (- (cadr time) (nth 8 (decode-time time))))) (cond ((< ls 0) @@ -1036,27 +1109,17 @@ command whose response triggered the error." t) (deffoo nntp-request-set-mark (group actions &optional server) - (unless nntp-marks-is-evil + (when (and (not nntp-marks-is-evil) + nntp-marks-file-name) (nntp-possibly-create-directory group server) (nntp-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nntp-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nntp-marks)) range) - nntp-marks))))) + (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions)) (nntp-save-marks group server)) nil) -(deffoo nntp-request-update-info (group info &optional server) - (unless nntp-marks-is-evil +(deffoo nntp-request-marks (group info &optional server) + (when (and (not nntp-marks-is-evil) + nntp-marks-file-name) (nntp-possibly-create-directory group server) (when (nntp-marks-changed-p group server) (nnheader-message 8 "Updating marks for %s..." group) @@ -1092,6 +1155,11 @@ It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\n" "MODE READER")) +(declare-function netrc-parse "netrc" (&optional file)) +(declare-function netrc-machine "netrc" + (list machine &optional port defaultport)) +(declare-function netrc-get "netrc" (alist type)) + (defun nntp-send-authinfo (&optional send-if-force) "Send the AUTHINFO to the nntp server. It will look in the \"~/.authinfo\" file for matching entries. If @@ -1100,11 +1168,23 @@ and a password. If SEND-IF-FORCE, only send authinfo to the server if the .authinfo file has the FORCE token." + (require 'netrc) (let* ((list (netrc-parse nntp-authinfo-file)) (alist (netrc-machine list nntp-address "nntp")) - (force (netrc-get alist "force")) - (user (or (netrc-get alist "login") nntp-authinfo-user)) - (passwd (netrc-get alist "password"))) + (force (or (netrc-get alist "force") nntp-authinfo-force)) + (auth-info + (auth-source-user-or-password '("login" "password") nntp-address "nntp")) + (auth-user (nth 0 auth-info)) + (auth-passwd (nth 1 auth-info)) + (user (or + ;; this is preferred to netrc-* + auth-user + (netrc-get alist "login") + nntp-authinfo-user)) + (passwd (or + ;; this is preferred to netrc-* + auth-passwd + (netrc-get alist "password")))) (when (or (not send-if-force) force) (unless user @@ -1158,13 +1238,12 @@ password contained in '~/.nntp-authinfo'." (defun nntp-make-process-buffer (buffer) "Create a new, fresh buffer usable for nntp process connections." - (save-excursion - (set-buffer - (generate-new-buffer - (format " *server %s %s %s*" - nntp-address nntp-port-number - (gnus-buffer-exists-p buffer)))) - (mm-enable-multibyte) + (with-current-buffer + (generate-new-buffer + (format " *server %s %s %s*" + nntp-address nntp-port-number + (gnus-buffer-exists-p buffer))) + (mm-disable-multibyte) (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) @@ -1184,13 +1263,31 @@ password contained in '~/.nntp-authinfo'." `(lambda () (nntp-kill-buffer ,pbuffer))))) (process - (condition-case () + (condition-case err (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) + (coding-system-for-write nntp-coding-system-for-write) + (map '((nntp-open-network-stream network) + (network-only network-only) + (nntp-open-ssl-stream tls) + (nntp-open-tls-stream tls)))) + (if (assoc nntp-open-connection-function map) + (car (open-protocol-stream + "nntpd" pbuffer nntp-address nntp-port-number + :type (cadr + (assoc nntp-open-connection-function map)) + :end-of-command "^\\([2345]\\|[.]\\).*\n" + :capability-command "CAPABILITIES\r\n" + :success "^3" + :starttls-function + (lambda (capabilities) + (if (not (string-match "STARTTLS" capabilities)) + nil + "STARTTLS\r\n")))) + (funcall nntp-open-connection-function pbuffer))) + (error + (nnheader-report 'nntp "%s" err)) (quit - (message "Quit opening connection") + (message "Quit opening connection to %s" nntp-address) (nntp-kill-buffer pbuffer) (signal 'quit nil) nil)))) @@ -1206,8 +1303,7 @@ password contained in '~/.nntp-authinfo'." (prog1 (caar (push (list process buffer nil) nntp-connection-alist)) (push process nntp-connection-list) - (save-excursion - (set-buffer pbuffer) + (with-current-buffer pbuffer (nntp-read-server-type) (erase-buffer) (set-buffer nntp-server-buffer) @@ -1217,43 +1313,6 @@ password contained in '~/.nntp-authinfo'." (nntp-kill-buffer (process-buffer process)) nil)))) -(defun nntp-open-network-stream (buffer) - (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) - -(eval-and-compile - (autoload 'format-spec "format-spec") - (autoload 'format-spec-make "format-spec") - (autoload 'open-tls-stream "tls")) - -(defun nntp-open-ssl-stream (buffer) - (let* ((process-connection-type nil) - (proc (start-process "nntpd" buffer - shell-file-name - shell-command-switch - (format-spec nntp-ssl-program - (format-spec-make - ?s nntp-address - ?p nntp-port-number))))) - (gnus-set-process-query-on-exit-flag proc nil) - (save-excursion - (set-buffer buffer) - (let ((nntp-connection-alist (list proc buffer nil))) - (nntp-wait-for-string "^\r*20[01]")) - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - -(defun nntp-open-tls-stream (buffer) - (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number))) - (gnus-set-process-query-on-exit-flag proc nil) - (save-excursion - (set-buffer buffer) - (let ((nntp-connection-alist (list proc buffer nil))) - (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. @@ -1268,8 +1327,7 @@ password contained in '~/.nntp-authinfo'." (funcall (cadr entry))))))) (defun nntp-async-wait (process wait-for buffer decode callback) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (unless nntp-inside-change-function (erase-buffer)) (setq nntp-process-wait-for wait-for @@ -1277,17 +1335,7 @@ password contained in '~/.nntp-authinfo'." nntp-process-decode decode nntp-process-callback callback nntp-process-start-point (point-max)) - (setq after-change-functions '(nntp-after-change-function)) - (if nntp-async-needs-kluge - (nntp-async-kluge process)))) - -(defun nntp-async-kluge (process) - ;; emacs 20.3 bug: process output with encoding 'binary - ;; doesn't trigger after-change-functions. - (unless nntp-async-timer - (setq nntp-async-timer - (run-at-time 1 1 'nntp-async-timer-handler))) - (add-to-list 'nntp-async-process-list process)) + (setq after-change-functions '(nntp-after-change-function)))) (defun nntp-async-timer-handler () (mapcar @@ -1317,8 +1365,7 @@ password contained in '~/.nntp-authinfo'." (setq after-change-functions '(nntp-after-change-function))))) (defun nntp-async-trigger (process) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (when nntp-process-callback ;; do we have an error message? (goto-char nntp-process-start-point) @@ -1343,12 +1390,11 @@ password contained in '~/.nntp-authinfo'." (let ((buf (current-buffer)) (start nntp-process-start-point) (decode nntp-process-decode)) - (save-excursion - (set-buffer nntp-process-to-buffer) + (with-current-buffer nntp-process-to-buffer (goto-char (point-max)) (save-restriction (narrow-to-region (point) (point)) - (insert-buffer-substring buf start) + (nntp-insert-buffer-substring buf start) (when decode (nntp-decode-text)))))) ;; report it. @@ -1367,27 +1413,27 @@ password contained in '~/.nntp-authinfo'." (let ((message (buffer-string))) (while (string-match "[\r\n]+" message) (setq message (replace-match " " t t message))) - (nnheader-report 'nntp message) + (nnheader-report 'nntp "%s" message) message)) (defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." - (save-excursion - (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) - nntp-server-buffer)) + (with-current-buffer (or (nntp-find-connection-buffer nntp-server-buffer) + nntp-server-buffer) (let ((len (/ (buffer-size) 1024)) message-log-max) (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) - (nnheader-accept-process-output process) - ;; accept-process-output may update status of process to indicate - ;; that the server has closed the connection. This MUST be - ;; handled here as the buffer restored by the save-excursion may - ;; be the process's former output buffer (i.e. now killed) - (or (and process - (memq (process-status process) '(open run))) - (nntp-report "Server closed connection")))) + (prog1 + (nnheader-accept-process-output process) + ;; accept-process-output may update status of process to indicate + ;; that the server has closed the connection. This MUST be + ;; handled here as the buffer restored by the save-excursion may + ;; be the process's former output buffer (i.e. now killed) + (or (and process + (memq (process-status process) '(open run))) + (nntp-report "Server closed connection"))))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." @@ -1408,8 +1454,7 @@ password contained in '~/.nntp-authinfo'." (cond ((not entry) (nntp-report "Server closed connection")) ((not (equal group (caddr entry))) - (save-excursion - (set-buffer (process-buffer (car entry))) + (with-current-buffer (process-buffer (car entry)) (erase-buffer) (nntp-send-command "^[245].*\n" "GROUP" group) (setcar (cddr entry) group) @@ -1577,7 +1622,7 @@ password contained in '~/.nntp-authinfo'." (when in-process-buffer-p (set-buffer buf) (goto-char (point-max)) - (insert-buffer-substring process-buffer) + (nntp-insert-buffer-substring process-buffer) (set-buffer process-buffer) (erase-buffer) (set-buffer buf)) @@ -1609,8 +1654,7 @@ password contained in '~/.nntp-authinfo'." ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (goto-char (point-min)) (and (looking-at "[23]") ; No error message. ;; We also have to look at the lines. Some buggy @@ -1618,7 +1662,8 @@ password contained in '~/.nntp-authinfo'." ;; article number. How... helpful. (progn (forward-line 1) - (looking-at "[0-9]+\t...")) ; More text after number. + ;; More text after number, or a dot. + (looking-at "[0-9]+\t...\\|\\.\r?\n")) (setq nntp-server-xover (car commands)))) (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. @@ -1630,6 +1675,7 @@ password contained in '~/.nntp-authinfo'." (defun nntp-find-group-and-number (&optional group) (save-excursion (save-restriction + ;; FIXME: This is REALLY FISHY: set-buffer after save-restriction?!? (set-buffer nntp-server-buffer) (narrow-to-region (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point-max))) @@ -1667,7 +1713,8 @@ password contained in '~/.nntp-authinfo'." (match-string 1 xref)) (t ""))) (cond - ((and (setq xref (mail-fetch-field "xref")) + ((and (not nntp-xref-number-is-evil) + (setq xref (mail-fetch-field "xref")) (string-match (if group (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)") @@ -1693,7 +1740,7 @@ password contained in '~/.nntp-authinfo'." (while (and (setq proc (get-buffer-process buf)) (memq (process-status proc) '(open run)) (not (re-search-forward regexp nil t))) - (accept-process-output proc) + (accept-process-output proc 0.1) (set-buffer buf) (goto-char (point-min))))) @@ -1733,9 +1780,21 @@ via telnet.") (defvoo nntp-telnet-passwd nil "Password to use to log in via telnet with.") +(defun nntp-service-to-port (svc) + (cond + ((integerp svc) (number-to-string svc)) + ((string-match "\\`[0-9]+\\'" svc) svc) + (t + (with-temp-buffer + (ignore-errors (insert-file-contents "/etc/services")) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote svc) + "[ \t]+\\([0-9]+\\)/tcp")) + (match-string 1) + svc))))) + (defun nntp-open-telnet (buffer) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (erase-buffer) (let ((proc (apply 'start-process @@ -1791,8 +1850,7 @@ via telnet.") (apply 'start-process "nntpd" buffer nntp-rlogin-program nntp-address nntp-rlogin-parameters)))) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (nntp-wait-for-string "^\r*20[01]") (beginning-of-line) (delete-region (point-min) (point)) @@ -1805,6 +1863,8 @@ via telnet.") (defun nntp-open-telnet-stream (buffer) "Open a nntp connection by telnet'ing the news server. +`nntp-open-netcat-stream' is recommended in place of this function +because it is more reliable. Please refer to the following variables to customize the connection: - `nntp-pre-command', @@ -1815,13 +1875,13 @@ Please refer to the following variables to customize the connection: - `nntp-end-of-line'." (let ((command `(,nntp-telnet-command ,@nntp-telnet-switches - ,nntp-address ,nntp-port-number)) + ,nntp-address + ,(nntp-service-to-port nntp-port-number))) proc) (and nntp-pre-command (push nntp-pre-command command)) (setq proc (apply 'start-process "nntpd" buffer command)) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (nntp-wait-for-string "^\r*20[01]") (beginning-of-line) (delete-region (point-min) (point)) @@ -1831,6 +1891,8 @@ Please refer to the following variables to customize the connection: "Open a connection to an nntp server through an intermediate host. First rlogin to the remote host, and then telnet the real news server from there. +`nntp-open-via-rlogin-and-netcat' is recommended in place of this function +because it is more reliable. Please refer to the following variables to customize the connection: - `nntp-pre-command', @@ -1855,11 +1917,11 @@ Please refer to the following variables to customize the connection: (and nntp-pre-command (push nntp-pre-command command)) (setq proc (apply 'start-process "nntpd" buffer command)) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (nntp-wait-for-string "^r?telnet") - (process-send-string proc (concat "open " nntp-address - " " nntp-port-number "\n")) + (process-send-string proc (concat "open " nntp-address " " + (nntp-service-to-port nntp-port-number) + "\n")) (nntp-wait-for-string "^\r*20[01]") (beginning-of-line) (delete-region (point-min) (point)) @@ -1884,24 +1946,46 @@ Please refer to the following variables to customize the connection: - `nntp-via-rlogin-command-switches', - `nntp-via-user-name', - `nntp-via-address', -- `nntp-via-netcat-command', -- `nntp-via-netcat-switches', +- `nntp-netcat-command', +- `nntp-netcat-switches', - `nntp-address', -- `nntp-port-number', -- `nntp-end-of-line'." +- `nntp-port-number'." (let ((command `(,@(when nntp-pre-command (list nntp-pre-command)) ,nntp-via-rlogin-command - ,@(when nntp-via-rlogin-command-switches - nntp-via-rlogin-command-switches) + ,@nntp-via-rlogin-command-switches ,@(when nntp-via-user-name (list "-l" nntp-via-user-name)) ,nntp-via-address - ,nntp-via-netcat-command - ,@nntp-via-netcat-switches + ,nntp-netcat-command + ,@nntp-netcat-switches ,nntp-address - ,nntp-port-number))) - (apply 'start-process "nntpd" buffer command))) + ,(nntp-service-to-port nntp-port-number)))) + ;; A non-nil connection type results in mightily odd behavior where + ;; (process-send-string proc "\^M") ends up sending a "\n" to the + ;; ssh process. --Stef + ;; Also a nil connection allow ssh-askpass to work under X11. + (let ((process-connection-type nil)) + (apply 'start-process "nntpd" buffer command)))) + +(defun nntp-open-netcat-stream (buffer) + "Open a connection to an nntp server through netcat. +I.e. use the `nc' command rather than Emacs's builtin networking code. + +Please refer to the following variables to customize the connection: +- `nntp-pre-command', +- `nntp-netcat-command', +- `nntp-netcat-switches', +- `nntp-address', +- `nntp-port-number'." + (let ((command `(,nntp-netcat-command + ,@nntp-netcat-switches + ,nntp-address + ,(nntp-service-to-port nntp-port-number)))) + (and nntp-pre-command (push nntp-pre-command command)) + (let ((process-connection-type nil)) ;See `nntp-open-via-rlogin-and-netcat'. + (apply 'start-process "nntpd" buffer command)))) + (defun nntp-open-via-telnet-and-telnet (buffer) "Open a connection to an nntp server through an intermediate host. @@ -1922,8 +2006,7 @@ Please refer to the following variables to customize the connection: - `nntp-address', - `nntp-port-number', - `nntp-end-of-line'." - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (erase-buffer) (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches)) (case-fold-search t) @@ -1960,7 +2043,7 @@ Please refer to the following variables to customize the connection: ,nntp-telnet-command ,@nntp-telnet-switches ,nntp-address - ,nntp-port-number))) + ,(nntp-service-to-port nntp-port-number)))) (process-send-string proc (concat (mapconcat 'identity real-telnet-command " ") @@ -1983,21 +2066,34 @@ Please refer to the following variables to customize the connection: (defun nntp-marks-directory (server) (expand-file-name server nntp-marks-directory)) +(defvar nntp-server-to-method-cache nil + "Alist of servers and select methods.") + +(defun nntp-group-pathname (server group &optional file) + "Return an absolute file name of FILE for GROUP on SERVER." + (let ((method (cdr (assoc server nntp-server-to-method-cache)))) + (unless method + (push (cons server (setq method (or (gnus-server-to-method server) + (gnus-find-method-for-group group)))) + nntp-server-to-method-cache)) + (nnmail-group-pathname + (mm-decode-coding-string group + (inline (gnus-group-name-charset method group))) + (nntp-marks-directory server) + file))) + (defun nntp-possibly-create-directory (group server) - (let ((dir (nnmail-group-pathname - group (nntp-marks-directory server)))) + (let ((dir (nntp-group-pathname server group)) + (file-name-coding-system nnmail-pathname-coding-system)) (unless (file-exists-p dir) (make-directory (directory-file-name dir) t) (nnheader-message 5 "Creating nntp marks directory %s" dir)))) -(eval-and-compile - (autoload 'time-less-p "time-date")) +(autoload 'time-less-p "time-date") (defun nntp-marks-changed-p (group server) - (let ((file (expand-file-name - nntp-marks-file-name - (nnmail-group-pathname - group (nntp-marks-directory server))))) + (let ((file (nntp-group-pathname server group nntp-marks-file-name)) + (file-name-coding-system nnmail-pathname-coding-system)) (if (null (gnus-gethash file nntp-marks-modtime)) t ;; never looked at marks file, assume it has changed (time-less-p (gnus-gethash file nntp-marks-modtime) @@ -2005,10 +2101,7 @@ Please refer to the following variables to customize the connection: (defun nntp-save-marks (group server) (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (expand-file-name - nntp-marks-file-name - (nnmail-group-pathname - group (nntp-marks-directory server))))) + (file (nntp-group-pathname server group nntp-marks-file-name))) (condition-case err (progn (nntp-possibly-create-directory group server) @@ -2024,10 +2117,8 @@ Please refer to the following variables to customize the connection: (error "Cannot write to %s (%s)" file err)))))) (defun nntp-open-marks (group server) - (let ((file (expand-file-name - nntp-marks-file-name - (nnmail-group-pathname - group (nntp-marks-directory server))))) + (let ((file (nntp-group-pathname server group nntp-marks-file-name)) + (file-name-coding-system nnmail-pathname-coding-system)) (if (file-exists-p file) (condition-case err (with-temp-buffer @@ -2045,16 +2136,20 @@ Please refer to the following variables to customize the connection: (let ((info (gnus-get-info (gnus-group-prefixed-name group - (gnus-server-to-method (format "nntp:%s" server)))))) - (nnheader-message 7 "Bootstrapping marks for %s..." group) + (gnus-server-to-method (format "nntp:%s" server))))) + (decoded-name (mm-decode-coding-string + group + (gnus-group-name-charset + (gnus-server-to-method server) group)))) + (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name) (setq nntp-marks (gnus-info-marks info)) (push (cons 'read (gnus-info-read info)) nntp-marks) (dolist (el gnus-article-unpropagated-mark-lists) (setq nntp-marks (gnus-remassoc el nntp-marks))) (nntp-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" group))))) + (nnheader-message 7 "Bootstrapping marks for %s...done" + decoded-name))))) (provide 'nntp) -;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 ;;; nntp.el ends here