;;; nntp.el --- nntp access for Gnus
;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; 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)
+
(defvoo nntp-address nil
"Address of the physical nntp server.")
Direct connections:
- `nntp-open-network-stream' (the default),
- `nntp-open-ssl-stream',
+- `nntp-open-tls-stream',
+- `nntp-open-netcat-stream'.
- `nntp-open-telnet-stream'.
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.
This is where you would put \"runsocks\" or stuff like that.")
(defvoo nntp-telnet-command "telnet"
"*Telnet command used to connect to the nntp server.
-This command is used by the various nntp-open-via-* methods.")
+This command is used by the methods `nntp-open-telnet-stream',
+`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.")
(defvoo nntp-telnet-switches '("-8")
"*Switches given to the telnet command `nntp-telnet-command'.")
(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 connection method (nntp-open-via-*).")
+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.
-This command is used by the `nntp-open-via-rlogin-and-telnet' method.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
+This command is used by the methods `nntp-open-via-rlogin-and-telnet'
+and `nntp-open-via-rlogin-and-netcat'. The default is \"rsh\", but \"ssh\"
+is a popular alternative.")
+
+(defvoo nntp-via-rlogin-command-switches nil
+ "*Switches given to the rlogin command `nntp-via-rlogin-command'.
+If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
+\(\"-C\") in order to compress all data connections, otherwise set this
+to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet
+command requires a pseudo-tty allocation on an intermediate host.")
(defvoo nntp-via-telnet-command "telnet"
"*Telnet 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-netcat-command "nc"
+ "*Netcat command used to connect to the nntp server.
+This command is used by the `nntp-open-netcat-stream' and
+`nntp-open-via-rlogin-and-netcat' methods.")
+
+(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.
-This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
+This variable is used by the various nntp-open-via-* methods.")
(defvoo nntp-via-user-password nil
"*Password to use to log in on an intermediate host with.
(defvoo nntp-via-address nil
"*Address of an intermediate host to connect to.
-This variable is used by the `nntp-open-via-rlogin-and-telnet' and
-`nntp-open-via-telnet-and-telnet' methods.")
+This variable is used by the various nntp-open-via-* methods.")
(defvoo nntp-via-envuser nil
"*Whether both telnet client and server support the ENVIRON option.
This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
(defvoo nntp-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+ "*The number of articles which indicates a large newsgroup.
+If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status.")
(defvoo nntp-maximum-request 400
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 'nntp
+ :type 'directory)
+
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
+ :group 'nntp
:type
'(choice file
(repeat :tag "Entries"
"*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
(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)
-(eval-and-compile
- (autoload 'mail-source-read-passwd "mail-source")
- (autoload 'open-ssl-stream "ssl"))
+(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
nntp-last-command string)
(when nntp-record-commands
(nntp-record-command string))
- (process-send-string process (concat string nntp-end-of-line)))
+ (process-send-string process (concat string nntp-end-of-line))
+ (or (memq (process-status process) '(open run))
+ (nntp-report "Server closed connection")))
(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"))))
+(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))
+
+(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
(nntp-snarf-error-message)
nil))
((not (memq (process-status process) '(open run)))
- (nnheader-report 'nntp "Server closed connection"))
+ (nntp-report "Server closed connection"))
(t
(goto-char (point-max))
(let ((limit (point-min))
(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)
(kill-buffer buffer)
(nnheader-init-server-buffer)))
+(defun nntp-erase-buffer (buffer)
+ "Erase contents of BUFFER."
+ (with-current-buffer buffer
+ (erase-buffer)))
+
(defsubst nntp-find-connection (buffer)
"Find the connection delivering to BUFFER."
(let ((alist nntp-connection-alist)
"Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
(let ((process (or (nntp-find-connection buffer)
(nntp-open-connection buffer))))
- (if (not process)
- (nnheader-report 'nntp "Couldn't open connection to %s" address)
- (unless (or nntp-inhibit-erase nnheader-callback-function)
- (save-excursion
- (set-buffer (process-buffer process))
- (erase-buffer)))
- (condition-case err
- (progn
- (when command
- (nntp-send-string process command))
- (cond
- ((eq callback 'ignore)
- t)
- ((and callback wait-for)
- (nntp-async-wait process wait-for buffer decode callback)
- t)
- (wait-for
- (nntp-wait-for process wait-for buffer decode))
- (t t)))
- (error
- (nnheader-report 'nntp "Couldn't open connection to %s: %s"
- address err))
- (quit
- (message "Quit retrieving data from nntp")
- (signal 'quit nil)
- nil)))))
+ (if process
+ (progn
+ (unless (or nntp-inhibit-erase nnheader-callback-function)
+ (nntp-erase-buffer (process-buffer process)))
+ (condition-case err
+ (progn
+ (when command
+ (nntp-send-string process command))
+ (cond
+ ((eq callback 'ignore)
+ t)
+ ((and callback wait-for)
+ (nntp-async-wait process wait-for buffer decode callback)
+ t)
+ (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))
+ (quit
+ (message "Quit retrieving data from nntp")
+ (signal 'quit nil)
+ nil)))
+ (nnheader-report 'nntp "Couldn't open connection to %s" address))))
(defsubst nntp-send-command (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
(when (and (not nnheader-callback-function)
(not nntp-inhibit-output))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))
+ (nntp-erase-buffer nntp-server-buffer))
(let* ((command (mapconcat 'identity strings " "))
- (buffer (process-buffer (nntp-find-connection nntp-server-buffer)))
- (pos (with-current-buffer buffer (point))))
- (prog1
- (nntp-retrieve-data command
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function)
- ;; If nothing to wait for, still remove possibly echo'ed commands
- (unless wait-for
- (nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
- )))
- ))
+ (process (nntp-find-connection nntp-server-buffer))
+ (buffer (and process (process-buffer process)))
+ (pos (and buffer (with-current-buffer buffer (point)))))
+ (if process
+ (prog1
+ (nntp-retrieve-data command
+ nntp-address nntp-port-number
+ nntp-server-buffer
+ wait-for nnheader-callback-function)
+ ;; If nothing to wait for, still remove possibly echo'ed commands.
+ ;; 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
+ nntp-never-echoes-commands
+ (memq
+ nntp-open-connection-function
+ nntp-open-connection-functions-never-echo-commands))
+ (nntp-accept-response)
+ (with-current-buffer buffer
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1)
+ (point-at-bol)))))))
+ (nnheader-report 'nntp "Couldn't open connection to %s."
+ nntp-address))))
(defun nntp-send-command-nodelete (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
(let* ((command (mapconcat 'identity strings " "))
- (buffer (process-buffer (nntp-find-connection nntp-server-buffer)))
- (pos (with-current-buffer buffer (point))))
- (prog1
- (nntp-retrieve-data command
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function)
- ;; If nothing to wait for, still remove possibly echo'ed commands
- (unless wait-for
- (nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
- )))
- ))
+ (process (nntp-find-connection nntp-server-buffer))
+ (buffer (and process (process-buffer process)))
+ (pos (and buffer (with-current-buffer buffer (point)))))
+ (if process
+ (prog1
+ (nntp-retrieve-data command
+ nntp-address nntp-port-number
+ nntp-server-buffer
+ wait-for nnheader-callback-function)
+ ;; If nothing to wait for, still remove possibly echo'ed commands
+ (unless wait-for
+ (nntp-accept-response)
+ (with-current-buffer buffer
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1)
+ (point-at-bol)))))))
+ (nnheader-report 'nntp "Couldn't open connection to %s."
+ nntp-address))))
(defun nntp-send-command-and-decode (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
(when (and (not nnheader-callback-function)
(not nntp-inhibit-output))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))
+ (nntp-erase-buffer nntp-server-buffer))
(let* ((command (mapconcat 'identity strings " "))
(process (nntp-find-connection nntp-server-buffer))
(buffer (and process (process-buffer process)))
(if process
(prog1
(nntp-retrieve-data command
- nntp-address nntp-port-number
+ nntp-address nntp-port-number
nntp-server-buffer
wait-for nnheader-callback-function t)
;; If nothing to wait for, still remove possibly echo'ed commands
(unless wait-for
(nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
- )))
+ (with-current-buffer buffer
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1) (point-at-bol))))
+ )))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
"Send the current buffer to server and wait until WAIT-FOR returns."
(when (and (not nnheader-callback-function)
(not nntp-inhibit-output))
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)))
+ (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))
;; a line with only a "." on it.
((eq (char-after) ?2)
(if (re-search-forward "\n\\.\r?\n" nil t)
- t
+ (progn
+ ;; Some broken news servers add another dot at the end.
+ ;; Protect against inflooping there.
+ (while (looking-at "^\\.\r?\n")
+ (forward-line 1))
+ t)
nil))
;; A result that starts with a 3xx or 4xx code is terminated
;; by a newline.
(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."
+ (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
+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."
+ (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))
+ `(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-possibly-change-group group server)
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)
- (if (and (not gnus-nov-is-evil)
- (not nntp-nov-is-evil)
- (nntp-retrieve-headers-with-xover articles fetch-old))
- ;; We successfully retrieved the headers via XOVER.
- 'nov
- ;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- article)
- ;; Send HEAD commands.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "HEAD" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving headers...done"))
-
- ;; Now all of replies are received. Fold continuation lines.
- (nnheader-fold-continuation-lines)
- ;; Remove all "\r"'s.
- (nnheader-strip-cr)
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'headers))))
+ (nntp-with-open-group
+ group server
+ (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer)
+ (erase-buffer)
+ (if (and (not gnus-nov-is-evil)
+ (not nntp-nov-is-evil)
+ (nntp-retrieve-headers-with-xover articles fetch-old))
+ ;; We successfully retrieved the headers via XOVER.
+ 'nov
+ ;; XOVER didn't work, so we do it the hard, slow and inefficient
+ ;; way.
+ (let ((number (length articles))
+ (articles articles)
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ article)
+ ;; Send HEAD commands.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "HEAD" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving headers...done"))
+
+ ;; Now all of replies are received. Fold continuation lines.
+ (nnheader-fold-continuation-lines)
+ ;; Remove all "\r"'s.
+ (nnheader-strip-cr)
+ (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'headers)))))
(deffoo nntp-retrieve-groups (groups &optional server)
"Retrieve group info on GROUPS."
- (nntp-possibly-change-group nil server)
- (when (nntp-find-connection-buffer nntp-server-buffer)
- (catch 'done
- (save-excursion
- ;; Erase nntp-server-buffer before nntp-inhibit-erase.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- ;; The first time this is run, this variable is `try'. So we
- ;; try.
- (when (eq nntp-server-list-active-group 'try)
- (nntp-try-list-active (car groups)))
- (erase-buffer)
- (let ((count 0)
- (received 0)
- (last-point (point-min))
- (nntp-inhibit-erase t)
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (command (if nntp-server-list-active-group
- "LIST ACTIVE" "GROUP")))
- (while groups
- ;; Timeout may have killed the buffer.
- (unless (gnus-buffer-live-p buf)
- (nnheader-report 'nntp "Connection to %s is closed." server)
- (throw 'done nil))
- ;; Send the command to the server.
- (nntp-send-command nil command (pop groups))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null groups) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (and (gnus-buffer-live-p buf)
- (progn
- ;; Search `blue moon' in this file for the
- ;; reason why set-buffer here.
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (incf received))
- (setq last-point (point))
- (< received count)))
- (nntp-accept-response))))
-
- ;; Wait for the reply from the final command.
- (unless (gnus-buffer-live-p buf)
- (nnheader-report 'nntp "Connection to %s is closed." server)
- (throw 'done nil))
- (set-buffer buf)
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (when (looking-at "^[23]")
- (while (and (gnus-buffer-live-p buf)
- (progn
- (set-buffer buf)
- (goto-char (point-max))
- (if (not nntp-server-list-active-group)
- (not (re-search-backward "\r?\n" (- (point) 3) t))
- (not (re-search-backward "^\\.\r?\n"
- (- (point) 4) t)))))
- (nntp-accept-response)))
-
- ;; Now all replies are received. We remove CRs.
- (unless (gnus-buffer-live-p buf)
- (nnheader-report 'nntp "Connection to %s is closed." server)
- (throw 'done nil))
- (set-buffer buf)
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
-
- (if (not nntp-server-list-active-group)
- (progn
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'group)
- ;; We have read active entries, so we just delete the
- ;; superfluous gunk.
- (goto-char (point-min))
- (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))
- 'active))))))
+ (nntp-with-open-group
+ nil server
+ (when (nntp-find-connection-buffer nntp-server-buffer)
+ (catch 'done
+ (save-excursion
+ ;; Erase nntp-server-buffer before nntp-inhibit-erase.
+ (nntp-erase-buffer nntp-server-buffer)
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ ;; The first time this is run, this variable is `try'. So we
+ ;; try.
+ (when (eq nntp-server-list-active-group 'try)
+ (nntp-try-list-active (car groups)))
+ (erase-buffer)
+ (let ((count 0)
+ (groups groups)
+ (received 0)
+ (last-point (point-min))
+ (nntp-inhibit-erase t)
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (command (if nntp-server-list-active-group
+ "LIST ACTIVE" "GROUP")))
+ (while groups
+ ;; Timeout may have killed the buffer.
+ (unless (gnus-buffer-live-p buf)
+ (nnheader-report 'nntp "Connection to %s is closed." server)
+ (throw 'done nil))
+ ;; Send the command to the server.
+ (nntp-send-command nil command (pop groups))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null groups) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (and (gnus-buffer-live-p buf)
+ (progn
+ ;; Search `blue moon' in this file for the
+ ;; reason why set-buffer here.
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (incf received))
+ (setq last-point (point))
+ (< received count)))
+ (nntp-accept-response))))
+
+ ;; Wait for the reply from the final command.
+ (unless (gnus-buffer-live-p buf)
+ (nnheader-report 'nntp "Connection to %s is closed." server)
+ (throw 'done nil))
+ (set-buffer buf)
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (and (gnus-buffer-live-p buf)
+ (progn
+ (set-buffer buf)
+ (goto-char (point-max))
+ (if (not nntp-server-list-active-group)
+ (not (re-search-backward "\r?\n"
+ (- (point) 3) t))
+ (not (re-search-backward "^\\.\r?\n"
+ (- (point) 4) t)))))
+ (nntp-accept-response)))
+
+ ;; Now all replies are received. We remove CRs.
+ (unless (gnus-buffer-live-p buf)
+ (nnheader-report 'nntp "Connection to %s is closed." server)
+ (throw 'done nil))
+ (set-buffer buf)
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+
+ (if (not nntp-server-list-active-group)
+ (progn
+ (nntp-copy-to-buffer nntp-server-buffer
+ (point-min) (point-max))
+ 'group)
+ ;; We have read active entries, so we just delete the
+ ;; superfluous gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'active)))))))
(deffoo nntp-retrieve-articles (articles &optional group server)
- (nntp-possibly-change-group group server)
- (save-excursion
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- (map (apply 'vector articles))
- (point 1)
- article)
- (set-buffer buf)
- (erase-buffer)
- ;; Send ARTICLE command.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "ARTICLE" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (aset map received (cons (aref map received) (point)))
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving articles... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving articles...done"))
-
- ;; Now we have all the responses. We go through the results,
- ;; wash it and copy it over to the server buffer.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq last-point (point-min))
- (mapcar
- (lambda (entry)
- (narrow-to-region
- (setq point (goto-char (point-max)))
- (progn
- (insert-buffer-substring buf last-point (cdr entry))
- (point-max)))
- (setq last-point (cdr entry))
- (nntp-decode-text)
- (widen)
- (cons (car entry) point))
- map))))
+ (nntp-with-open-group
+ group server
+ (save-excursion
+ (let ((number (length articles))
+ (articles articles)
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ (map (apply 'vector articles))
+ (point 1)
+ article)
+ (set-buffer buf)
+ (erase-buffer)
+ ;; Send ARTICLE command.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "ARTICLE" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (aset map received (cons (aref map received) (point)))
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving articles... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving articles...done"))
+
+ ;; Now we have all the responses. We go through the results,
+ ;; wash it and copy it over to the server buffer.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq last-point (point-min))
+ (mapcar
+ (lambda (entry)
+ (narrow-to-region
+ (setq point (goto-char (point-max)))
+ (progn
+ (nntp-insert-buffer-substring buf last-point (cdr entry))
+ (point-max)))
+ (setq last-point (cdr entry))
+ (nntp-decode-text)
+ (widen)
+ (cons (car entry) point))
+ map)))))
(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]+"))
(deffoo nntp-list-active-group (group &optional server)
"Return the active info on GROUP (which can be a regexp)."
- (nntp-possibly-change-group nil server)
- (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)))
(deffoo nntp-request-group-articles (group &optional server)
"Return the list of existing articles in GROUP."
- (nntp-possibly-change-group nil server)
- (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)))
(deffoo nntp-request-article (article &optional group server buffer command)
- (nntp-possibly-change-group group server)
- (when (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "ARTICLE"
- (if (numberp article) (int-to-string article) article))
- (if (and buffer
- (not (equal buffer nntp-server-buffer)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number group))
- (nntp-find-group-and-number group))))
+ (nntp-with-open-group
+ group server
+ (when (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "ARTICLE"
+ (if (numberp article) (int-to-string article) article))
+ (if (and buffer
+ (not (equal 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)))))
(deffoo nntp-request-head (article &optional group server)
- (nntp-possibly-change-group group server)
- (when (nntp-send-command
- "\r?\n\\.\r?\n" "HEAD"
- (if (numberp article) (int-to-string article) article))
- (prog1
- (nntp-find-group-and-number group)
- (nntp-decode-text))))
+ (nntp-with-open-group
+ group server
+ (when (nntp-send-command
+ "\r?\n\\.\r?\n" "HEAD"
+ (if (numberp article) (int-to-string article) article))
+ (prog1
+ (nntp-find-group-and-number group)
+ (nntp-decode-text)))))
(deffoo nntp-request-body (article &optional group server)
- (nntp-possibly-change-group group server)
- (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "BODY"
- (if (numberp article) (int-to-string article) article)))
-
-(deffoo nntp-request-group (group &optional server dont-check)
- (nntp-possibly-change-group nil server)
- (when (nntp-send-command "^[245].*\n" "GROUP" group)
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (setcar (cddr entry) group))))
+ (nntp-with-open-group
+ group server
+ (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "BODY"
+ (if (numberp article) (int-to-string article) article))))
+
+(deffoo nntp-request-group (group &optional server dont-check info)
+ (nntp-with-open-group
+ nil server
+ (when (nntp-send-command "^[245].*\n" "GROUP" group)
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (setcar (cddr entry) group)))))
(deffoo nntp-close-group (group &optional server)
t)
(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)))))
(nntp-kill-buffer (process-buffer process)))))
(deffoo nntp-request-list (&optional server)
- (nntp-possibly-change-group nil server)
- (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")))
(deffoo nntp-request-list-newsgroups (&optional server)
- (nntp-possibly-change-group nil server)
- (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")))
(deffoo nntp-request-newgroups (date &optional server)
- (nntp-possibly-change-group nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let* ((time (date-to-time date))
- (ls (- (cadr time) (nth 8 (decode-time time)))))
- (cond ((< ls 0)
- (setcar time (1- (car time)))
- (setcar (cdr time) (+ ls 65536)))
- ((>= ls 65536)
- (setcar time (1+ (car time)))
- (setcar (cdr time) (- ls 65536)))
- (t
- (setcar (cdr time) ls)))
- (prog1
- (nntp-send-command
- "^\\.\r?\n" "NEWGROUPS"
- (format-time-string "%y%m%d %H%M%S" time)
- "GMT")
- (nntp-decode-text)))))
+ (nntp-with-open-group
+ nil server
+ (with-current-buffer nntp-server-buffer
+ (let* ((time (date-to-time date))
+ (ls (- (cadr time) (nth 8 (decode-time time)))))
+ (cond ((< ls 0)
+ (setcar time (1- (car time)))
+ (setcar (cdr time) (+ ls 65536)))
+ ((>= ls 65536)
+ (setcar time (1+ (car time)))
+ (setcar (cdr time) (- ls 65536)))
+ (t
+ (setcar (cdr time) ls)))
+ (prog1
+ (nntp-send-command
+ "^\\.\r?\n" "NEWGROUPS"
+ (format-time-string "%y%m%d %H%M%S" time)
+ "GMT")
+ (nntp-decode-text))))))
(deffoo nntp-request-post (&optional server)
- (nntp-possibly-change-group nil server)
- (when (nntp-send-command "^[23].*\r?\n" "POST")
- (let ((response (with-current-buffer nntp-server-buffer
- nntp-process-response))
- server-id)
- (when (and response
- (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
- response))
- (setq server-id (match-string 1 response))
- (narrow-to-region (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (unless (mail-fetch-field "Message-ID")
- (goto-char (point-min))
- (insert "Message-ID: " server-id "\n"))
- (widen))
- (run-hooks 'nntp-prepare-post-hook)
- (nntp-send-buffer "^[23].*\n"))))
+ (nntp-with-open-group
+ nil server
+ (when (nntp-send-command "^[23].*\r?\n" "POST")
+ (let ((response (with-current-buffer nntp-server-buffer
+ nntp-process-response))
+ server-id)
+ (when (and response
+ (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+ response))
+ (setq server-id (match-string 1 response))
+ (narrow-to-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (unless (mail-fetch-field "Message-ID")
+ (goto-char (point-min))
+ (insert "Message-ID: " server-id "\n"))
+ (widen))
+ (run-hooks 'nntp-prepare-post-hook)
+ (nntp-send-buffer "^[23].*\n")))))
(deffoo nntp-request-type (group article)
'news)
(deffoo nntp-asynchronous-p ()
t)
+(deffoo nntp-request-set-mark (group actions &optional server)
+ (when (and (not nntp-marks-is-evil)
+ nntp-marks-file-name)
+ (nntp-possibly-create-directory group server)
+ (nntp-open-marks group server)
+ (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions))
+ (nntp-save-marks group server))
+ nil)
+
+(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)
+ (nntp-open-marks group server)
+ ;; Update info using `nntp-marks'.
+ (mapc (lambda (pred)
+ (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nntp-marks))
+ (gnus-info-marks info))
+ t)))
+ gnus-article-mark-lists)
+ (let ((seen (cdr (assq 'read nntp-marks))))
+ (gnus-info-set-read info
+ (if (and (integerp (car seen))
+ (null (cdr seen)))
+ (list (cons (car seen) (car seen)))
+ seen)))
+ (nnheader-message 8 "Updating marks for %s...done" group)))
+ nil)
+
+
+
;;; Hooky functions.
(defun nntp-send-mode-reader ()
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
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 "nntp"))
- (force (gnus-netrc-get alist "force"))
- (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
- (passwd (gnus-netrc-get alist "password")))
+ (require 'netrc)
+ (let* ((list (netrc-parse nntp-authinfo-file))
+ (alist (netrc-machine list nntp-address "nntp"))
+ (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
(or passwd
nntp-authinfo-password
(setq nntp-authinfo-password
- (mail-source-read-passwd
- (format "NNTP (%s@%s) password: "
- user nntp-address))))))))))
+ (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" user)
(when t ;???Should check if AUTHINFO succeeded
(nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (mail-source-read-passwd "NNTP (%s@%s) password: "
- user nntp-address))))))
+ (read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address)))))))
(defun nntp-send-authinfo-from-file ()
"Send the AUTHINFO to the nntp server.
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
"^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (progn (end-of-line) (point)))))))
+ (buffer-substring (point) (point-at-eol))))))
;;; Internal functions.
(funcall nntp-authinfo-function)
;; We have to re-send the function that was interrupted by
;; the authinfo request.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
+ (nntp-erase-buffer nntp-server-buffer)
(nntp-send-string process last)))
(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)
(let* ((pbuffer (nntp-make-process-buffer buffer))
(timer
(and nntp-connection-timeout
- (nnheader-run-at-time
+ (run-at-time
nntp-connection-timeout nil
`(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)
+ (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))))
(nntp-kill-buffer pbuffer))
(when (and (buffer-name pbuffer)
process)
- (process-kill-without-query process)
+ (gnus-set-process-query-on-exit-flag process nil)
(if (and (nntp-wait-for process "^2.*\n" buffer nil t)
(memq (process-status process) '(open run)))
(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)
(nntp-kill-buffer (process-buffer process))
nil))))
-(defun nntp-open-network-stream (buffer)
- (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
-
-(defun nntp-open-ssl-stream (buffer)
- (let ((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.
(setq nntp-server-type (buffer-string))
- (let ((alist nntp-server-action-alist)
- (case-fold-search t)
- entry)
+ (let ((case-fold-search t))
;; Run server-specific commands.
- (while alist
- (setq entry (pop alist))
+ (dolist (entry nntp-server-action-alist)
(when (string-match (car entry) nntp-server-type)
(if (and (listp (cadr entry))
(not (eq 'lambda (caadr entry))))
(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
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
- (nnheader-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
(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)
(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.
(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 &optional timeout)
+(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))
- (let ((len (/ (point-max) 1024))
+ (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)))
- (accept-process-output process (or timeout 1))))
+ (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."
(when group
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (when (not (equal group (caddr entry)))
- (save-excursion
- (set-buffer (process-buffer (car entry)))
- (erase-buffer)
- (nntp-send-command "^[245].*\n" "GROUP" group)
- (setcar (cddr entry) group)
- (erase-buffer)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))))))
+ (cond ((not entry)
+ (nntp-report "Server closed connection"))
+ ((not (equal group (caddr entry)))
+ (with-current-buffer (process-buffer (car entry))
+ (erase-buffer)
+ (nntp-send-command "^[245].*\n" "GROUP" group)
+ (setcar (cddr entry) group)
+ (erase-buffer)
+ (nntp-erase-buffer nntp-server-buffer)))))))
(defun nntp-decode-text (&optional cr-only)
"Decode the text in the current buffer."
in-process-buffer-p
(buf nntp-server-buffer)
(process-buffer (nntp-find-connection-buffer nntp-server-buffer))
- first)
+ first last status)
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
;; won't know that until we try.
(setq articles (cdr articles)))
(setq in-process-buffer-p (stringp nntp-server-xover))
- (nntp-send-xover-command first (car articles))
- (setq articles (cdr articles))
+ (nntp-send-xover-command first (setq last (car articles)))
+ (setq articles (cdr articles))
(when (and nntp-server-xover in-process-buffer-p)
;; Don't count tried request.
;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks.
(when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
+ (= 1 (% count nntp-maximum-request)))
(nntp-accept-response)
;; On some Emacs versions the preceding function has a
(while (progn
(goto-char (or last-point (point-min)))
;; Count replies.
- (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
- (incf received))
+ (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
+ nil t)
+ (incf received)
+ (setq status (match-string 1))
+ (if (string-match "^[45]" status)
+ (setq status 'error)
+ (setq status 'ok)))
(setq last-point (point))
- (< received count))
+ (or (< received count)
+ (if (eq status 'error)
+ nil
+ ;; I haven't started reading the final response
+ (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n"))))))
+ ;; I haven't read the end of the final response
(nntp-accept-response)
- (set-buffer process-buffer))
- (set-buffer buf))))
+ (set-buffer process-buffer))))
+
+ ;; Some nntp servers seem to have an extension to the XOVER
+ ;; extension. On these servers, requesting an article range
+ ;; preceeding the active range does not return an error as
+ ;; specified in the RFC. What we instead get is the NOV entry
+ ;; for the first available article. Obviously, a client can
+ ;; use that entry to avoid making unnecessary requests. The
+ ;; only problem is for a client that assumes that the response
+ ;; will always be within the requested ranage. For such a
+ ;; client, we can get N copies of the same entry (one for each
+ ;; XOVER command sent to the server).
+
+ (when (<= count 1)
+ (goto-char (point-min))
+ (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
+ (let ((low-limit (string-to-number
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (while (and articles (<= (car articles) low-limit))
+ (setq articles (cdr articles))))))
+ (set-buffer buf))
(when nntp-server-xover
(when in-process-buffer-p
- (set-buffer process-buffer)
- ;; Wait for the reply from the final command.
- (goto-char (point-max))
- (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t))
- (nntp-accept-response)
- (set-buffer process-buffer)
- (goto-char (point-max)))
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)
- (set-buffer process-buffer)))
(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))
;; 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
;; 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.
(when (eq nntp-server-xover 'try)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq nntp-server-xover nil)))
- nntp-server-xover))))
+ (nntp-erase-buffer nntp-server-buffer)
+ (setq nntp-server-xover nil))
+ nntp-server-xover))))
(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)))
(goto-char (point-min))
;; We first find the number by looking at the status line.
(let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
- (string-to-int
+ (string-to-number
(buffer-substring (match-beginning 1)
(match-end 1)))))
newsgroups xref)
;; If there is only one group in the Newsgroups
;; header, then it seems quite likely that this
;; article comes from that group, I'd say.
- ((and (setq newsgroups
+ ((and (setq newsgroups
(mail-fetch-field "newsgroups"))
(not (string-match "," newsgroups)))
newsgroups)
;; life.
((and (setq xref (mail-fetch-field "xref"))
number
- (string-match
+ (string-match
(format "\\([^ :]+\\):%d" number) xref))
(match-string 1 xref))
(t "")))
(cond
- ((and (setq xref (mail-fetch-field "xref"))
- (string-match
+ ((and (not nntp-xref-number-is-evil)
+ (setq xref (mail-fetch-field "xref"))
+ (string-match
(if group
(concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
"\\([^ :]+\\):\\([0-9]+\\)")
xref))
(setq group (match-string 1 xref)
- number (string-to-int (match-string 2 xref))))
- ((and (setq newsgroups
+ number (string-to-number (match-string 2 xref))))
+ ((and (setq newsgroups
(mail-fetch-field "newsgroups"))
(not (string-match "," newsgroups)))
(setq group newsgroups))
(defun nntp-wait-for-string (regexp)
"Wait until string arrives in the buffer."
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ proc)
(goto-char (point-min))
- (while (not (re-search-forward regexp nil t))
- (accept-process-output (nntp-find-connection nntp-server-buffer))
+ (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 0.1)
(set-buffer buf)
(goto-char (point-min)))))
(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
proc (concat
(or nntp-telnet-passwd
(setq nntp-telnet-passwd
- (mail-source-read-passwd "Password: ")))
+ (read-passwd "Password: ")))
"\n"))
(nntp-wait-for-string nntp-telnet-shell-prompt)
(process-send-string
(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))
(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',
- `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))
"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',
- `nntp-via-rlogin-command',
+- `nntp-via-rlogin-command-switches',
- `nntp-via-user-name',
- `nntp-via-address',
- `nntp-telnet-command',
- `nntp-end-of-line'."
(let ((command `(,nntp-via-address
,nntp-telnet-command
- ,@nntp-telnet-switches
- ,nntp-address ,nntp-port-number))
+ ,@nntp-telnet-switches))
proc)
- (and nntp-via-user-name
- (setq command `("-l" ,nntp-via-user-name ,@command)))
+ (when nntp-via-user-name
+ (setq command `("-l" ,nntp-via-user-name ,@command)))
+ (when nntp-via-rlogin-command-switches
+ (setq command (append nntp-via-rlogin-command-switches command)))
(push nntp-via-rlogin-command command)
(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-service-to-port nntp-port-number)
+ "\n"))
(nntp-wait-for-string "^\r*20[01]")
(beginning-of-line)
(delete-region (point-min) (point))
- proc)))
+ (process-send-string proc "\^]")
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc "mode character\n")
+ (accept-process-output proc 1)
+ (sit-for 1)
+ (goto-char (point-min))
+ (forward-line 1)
+ (delete-region (point) (point-max)))
+ proc))
+
+(defun nntp-open-via-rlogin-and-netcat (buffer)
+ "Open a connection to an nntp server through an intermediate host.
+First rlogin to the remote host, and then connect to the real news
+server from there using the netcat command.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-rlogin-command',
+- `nntp-via-rlogin-command-switches',
+- `nntp-via-user-name',
+- `nntp-via-address',
+- `nntp-netcat-command',
+- `nntp-netcat-switches',
+- `nntp-address',
+- `nntp-port-number'."
+ (let ((command `(,@(when nntp-pre-command
+ (list nntp-pre-command))
+ ,nntp-via-rlogin-command
+ ,@nntp-via-rlogin-command-switches
+ ,@(when nntp-via-user-name
+ (list "-l" nntp-via-user-name))
+ ,nntp-via-address
+ ,nntp-netcat-command
+ ,@nntp-netcat-switches
+ ,nntp-address
+ ,(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.
- `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)
(concat
(or nntp-via-user-password
(setq nntp-via-user-password
- (mail-source-read-passwd
- "Password: ")))
+ (read-passwd "Password: ")))
"\n"))
(nntp-wait-for-string nntp-via-shell-prompt)
(let ((real-telnet-command `("exec"
,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 " ")
(delete-region (point) (point-max)))
proc)))
+;; Marks handling
+
+(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 (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))))
+
+(autoload 'time-less-p "time-date")
+
+(defun nntp-marks-changed-p (group 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)
+ (nth 5 (file-attributes file))))))
+
+(defun nntp-save-marks (group server)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (nntp-group-pathname server group nntp-marks-file-name)))
+ (condition-case err
+ (progn
+ (nntp-possibly-create-directory group server)
+ (with-temp-file file
+ (erase-buffer)
+ (gnus-prin1 nntp-marks)
+ (insert "\n"))
+ (gnus-sethash file
+ (nth 5 (file-attributes file))
+ nntp-marks-modtime))
+ (error (or (gnus-yes-or-no-p
+ (format "Could not write to %s (%s). Continue? " file err))
+ (error "Cannot write to %s (%s)" file err))))))
+
+(defun nntp-open-marks (group 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
+ (gnus-sethash file (nth 5 (file-attributes file))
+ nntp-marks-modtime)
+ (nnheader-insert-file-contents file)
+ (setq nntp-marks (read (current-buffer)))
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nntp-marks (gnus-remassoc el nntp-marks))))
+ (error (or (gnus-yes-or-no-p
+ (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
+ (error "Cannot read nntp marks file %s (%s)" file err))))
+ ;; User didn't have a .marks file. Probably first time
+ ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
+ (let ((info (gnus-get-info
+ (gnus-group-prefixed-name
+ 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"
+ decoded-name)))))
+
(provide 'nntp)
;;; nntp.el ends here