;;; 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-2015 Free Software
+;; Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+(eval-and-compile
+ ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
+ ;; `make-network-stream'.
+ (unless (fboundp 'open-protocol-stream)
+ (require 'proto-stream)))
+
(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
(require 'gnus)
+(require 'gnus-group) ;; gnus-group-name-charset
(nnoo-declare nntp)
(eval-when-compile (require 'cl))
+(autoload 'auth-source-search "auth-source")
+
(defgroup nntp nil
"NNTP access for Gnus."
:group 'gnus)
You probably don't want to do that, though.")
(defvoo nntp-open-connection-function 'nntp-open-network-stream
- "*Function used for connecting to a remote system.
-It will be called with the buffer to output in as argument.
-
-Currently, five such functions are provided (please refer to their
-respective doc string for more information), three of them establishing
-direct connections to the nntp server, and two of them using an indirect
-host.
-
-Direct connections:
-- `nntp-open-network-stream' (the default),
-- `nntp-open-ssl-stream',
-- `nntp-open-tls-stream',
-- `nntp-open-telnet-stream'.
-
-Indirect connections:
-- `nntp-open-via-rlogin-and-telnet',
-- `nntp-open-via-rlogin-and-netcat',
-- `nntp-open-via-telnet-and-telnet'.")
+ "Method for connecting to a remote system.
+It should be a function, which is called with the output buffer
+as its single argument, or one of the following special values:
+
+- `nntp-open-network-stream' specifies a network connection,
+ upgrading to a TLS connection via STARTTLS if possible.
+- `nntp-open-plain-stream' specifies an unencrypted network
+ connection (no STARTTLS upgrade is attempted).
+- `nntp-open-ssl-stream' or `nntp-open-tls-stream' specify a TLS
+ network connection.
+
+Apart from the above special values, valid functions are as
+follows; please refer to their respective doc string for more
+information.
+For direct connections:
+- `nntp-open-netcat-stream'
+- `nntp-open-telnet-stream'
+For indirect connections:
+- `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.
(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.
(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.
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
server there that you can connect to. See also
`nntp-open-connection-function'")
-(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.")
-
-;; Marks
-(defvoo nntp-marks-is-evil nil
- "*If non-nil, Gnus will never generate and use marks file for nntp groups.
-See `nnml-marks-is-evil' for more information.")
-
-(defvoo nntp-marks-file-name ".marks")
-(defvoo nntp-marks nil)
-(defvar nntp-marks-modtime (gnus-make-hashtable))
-
-(defcustom nntp-marks-directory
- (nnheader-concat gnus-directory "marks/")
- "*The directory where marks for nntp groups will be stored."
- :group 'gnus
- :type 'directory)
-
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
:group 'nntp
(const :format "" "password")
(string :format "Password: %v")))))))
+(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1")
+
\f
(defvoo nntp-connection-timeout nil
"*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.
+(defvoo nntp-retrieval-in-progress nil)
(defvar nntp-record-commands nil
"*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")
(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)
(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")
\f
(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)
- "." (format "%03d" (/ (nth 2 time) 1000))
- " " nntp-address " " string "\n"))))
+ (insert (format-time-string "%Y%m%dT%H%M%S.%3N")
+ " " nntp-address " " string "\n")))
+
+(defvar nntp--report-1 nil)
(defun nntp-report (&rest args)
"Report an error from the nntp backend. The first string in ARGS
can be a format string. For some commands, the failed command may be
retried once before actually displaying the error report."
-
- (when nntp-record-commands
- (nntp-record-command "*** CALLED nntp-report ***"))
-
- (nnheader-report 'nntp args)
-
- (apply 'error args))
-
-(defun nntp-report-1 (&rest args)
- "Throws out to nntp-with-open-group-error so that the connection may
-be restored and the command retried."
-
- (when nntp-record-commands
- (nntp-record-command "*** CONNECTION LOST ***"))
-
- (throw 'nntp-with-open-group-error t))
+ (if nntp--report-1
+ (progn
+ ;; Throw out to nntp-with-open-group-error so that the connection may
+ ;; be restored and the command retried."
+ (when nntp-record-commands
+ (nntp-record-command "*** CONNECTION LOST ***"))
+ (throw 'nntp-with-open-group-error t))
+
+ (when nntp-record-commands
+ (nntp-record-command "*** CALLED nntp-report ***"))
+
+ (nnheader-report 'nntp args)
+
+ (apply 'error args)))
+
+(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
(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))
+ (nnheader-insert-buffer-substring (process-buffer process))
;; Nix out "nntp reading...." message.
(when nntp-have-messaged
(setq nntp-have-messaged nil)
(defun nntp-kill-buffer (buffer)
(when (buffer-name buffer)
+ (let ((process (get-buffer-process buffer)))
+ (when process
+ (delete-process process)))
(kill-buffer buffer)
(nnheader-init-server-buffer)))
(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))
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))))
;; 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)
;; 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))))
(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))
(t
nil)))
-(eval-when-compile
- (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."
+ (let ((nntp-report-n nntp--report-1)
+ (nntp--report-1 t)
+ (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))))
+ &nbs
projects / gnus / blobdiff