;;; nntp.el --- nntp access for Gnus
+
;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000
-;; Free Software Foundation, Inc.
+;; 1997, 1998, 2000, 2001, 2002, 2003 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.
+;; 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 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
(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.
+It will be called with the buffer to output in as argument.
-Two pre-made functions are `nntp-open-network-stream', which is the
-default, and simply connects to some port or other on the remote
-system (see nntp-port-number). The other are `nntp-open-rlogin',
-which does an rlogin on the remote system, and then does a telnet to
-the NNTP server available there (see nntp-rlogin-parameters) and
-`nntp-open-telnet' which telnets to a remote system, logs in and does
-the same.")
+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.
-(defvoo nntp-rlogin-program "rsh"
- "*Program used to log in on remote machines.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
+Direct connections:
+- `nntp-open-network-stream' (the default),
+- `nntp-open-ssl-stream',
+- `nntp-open-tls-stream',
+- `nntp-open-telnet-stream'.
-(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-rlogin'.
-That function may be used as `nntp-open-connection-function'. In that
-case, this list will be used as the parameter list given to rsh.")
+Indirect connections:
+- `nntp-open-via-rlogin-and-telnet',
+- `nntp-open-via-telnet-and-telnet'.")
-(defvoo nntp-rlogin-user-name nil
- "*User name on remote system when using the rlogin connect method.")
+(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-parameters
- '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-telnet'.
-That function may be used as `nntp-open-connection-function'. In that
-case, this list will be executed as a command after logging in
-via telnet.")
+(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.")
-(defvoo nntp-telnet-user-name nil
- "User name to log in via telnet with.")
+(defvoo nntp-telnet-switches '("-8")
+ "*Switches given to the telnet command `nntp-telnet-command'.")
-(defvoo nntp-telnet-passwd nil
- "Password to use to log in via telnet with.")
+(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-*).")
-(defvoo nntp-open-telnet-envuser nil
- "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
+(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.")
-(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
- "*Regular expression to match the shell prompt on the remote machine.")
+(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-telnet-command "telnet"
- "Command used to start telnet.")
+(defvoo nntp-via-telnet-command "telnet"
+ "*Telnet command used to connect to an intermediate host.
+This command is used by the `nntp-open-via-telnet-and-telnet' method.")
-(defvoo nntp-telnet-switches '("-8")
- "Switches given to the telnet command.")
+(defvoo nntp-via-telnet-switches '("-8")
+ "*Switches given to the telnet command `nntp-via-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 rlogin or telnet to communicate with the server.")
+(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.")
+
+(defvoo nntp-via-user-password nil
+ "*Password to use to log in on an intermediate host with.
+This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
+
+(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.")
+
+(defvoo nntp-via-envuser nil
+ "*Whether both telnet client and server support the ENVIRON option.
+If non-nil, there will be no prompt for a login name.")
+
+(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
+ "*Regular expression to match the shell prompt on an intermediate host.
+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
(defvoo nntp-connection-timeout nil
"*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.")
+If this variable is nil, which is the default, no timers are set.
+NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
+
+(defvoo nntp-prepare-post-hook nil
+ "*Hook run just before posting an article. It is supposed to be used
+to insert Cancel-Lock headers.")
;;; Internal variables.
(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-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.")
\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."
"." (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))
+
(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
"Wait for WAIT-FOR to arrive from PROCESS."
(save-excursion
(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))))
(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)))
+ (let ((limit (point-min))
+ response)
(while (not (re-search-backward wait-for limit t))
(nntp-accept-process-output process)
;; We assume that whatever we wait for is less than 1000
;; characters long.
(setq limit (max (- (point-max) 1000) (point-min)))
- (goto-char (point-max))))
+ (goto-char (point-max)))
+ (setq response (match-string 0))
+ (with-current-buffer nntp-server-buffer
+ (setq nntp-process-response response)))
(nntp-decode-text (not decode))
(unless discard
(save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (insert-buffer-substring (process-buffer process))
+ (set-buffer buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring (process-buffer process))
;; Nix out "nntp reading...." message.
(when nntp-have-messaged
(setq nntp-have-messaged nil)
- (nnheader-message 5 ""))
- t))))
+ (nnheader-message 5 ""))))
+ t))
(unless discard
(erase-buffer)))))
(let ((alist nntp-connection-alist)
(buffer (if (stringp buffer) (get-buffer buffer) buffer))
process entry)
- (while (setq entry (pop alist))
+ (while (and alist (setq entry (pop alist)))
(when (eq buffer (cadr entry))
(setq process (car entry)
alist nil)))
"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 nil)))))
+ (if process
+ (progn
+ (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)))
+ (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."
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)))
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function))
+ (let* ((command (mapconcat 'identity strings " "))
+ (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 echos if nntp-open-connection-function
+ ;; is `nntp-open-network-stream', so we skip this in that case.
+ (unless (or wait-for
+ (equal nntp-open-connection-function
+ 'nntp-open-network-stream))
+ (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))))
+ )))
+ (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."
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function))
+ (let* ((command (mapconcat 'identity strings " "))
+ (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)
+ (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)))))))
+ (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."
projects / gnus / blobdiff