;;; nntp.el --- nntp access for Gnus
+
;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000, 2001
-;; Free Software Foundation, Inc.
+;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.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:
;;; Code:
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
+
(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
(nnoo-declare nntp)
-(eval-when-compile (require 'cl))
-
(defvoo nntp-address nil
"Address of the physical nntp server.")
(defvoo nntp-port-number "nntp"
"Port number on the physical nntp server.")
+(defvoo nntp-list-options nil
+ "List of newsgroup name used for a option of the LIST command to
+restrict the listing output to only the specified newsgroups.
+Each newsgroup name can be a shell-style wildcard, for instance,
+\"fj.*\", \"japan.*\", etc. Fortunately, if the server can accept
+such a option, it will probably make gnus run faster. You may
+use it as a server variable as follows:
+
+\(setq gnus-select-method
+ '(nntp \"news.somewhere.edu\"
+ (nntp-list-options (\"fj.*\" \"japan.*\"))))")
+
+(defvoo nntp-options-subscribe nil
+ "Regexp matching the newsgroup names which will be subscribed
+unconditionally. It may be effective as well as `nntp-list-options'
+even though the server could not accept a shell-style wildcard as a
+option of the LIST command. You may use it as a server variable as
+follows:
+
+\(setq gnus-select-method
+ '(nntp \"news.somewhere.edu\"
+ (nntp-options-subscribe \"^fj\\\\.\\\\|^japan\\\\.\")))")
+
+(defvoo nntp-options-not-subscribe nil
+ "Regexp matching the newsgroup names which will not be subscribed
+unconditionally. It may be effective as well as `nntp-list-options'
+even though the server could not accept a shell-style wildcard as a
+option of the LIST command. You may use it as a server variable as
+follows:
+
+\(setq gnus-select-method
+ '(nntp \"news.somewhere.edu\"
+ (nntp-options-not-subscribe \"\\\\.binaries\\\\.\")))")
+
(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
"*Hook used for sending commands to the server at startup.
The default value is `nntp-send-mode-reader', which makes an innd
(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-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-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-command "telnet"
- "Command used to start telnet.")
+(defvoo nntp-via-telnet-switches '("-8")
+ "*Switches given to the telnet command `nntp-via-telnet-command'.")
-(defvoo nntp-telnet-switches '("-8")
- "Switches given to the telnet 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.")
-(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-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.
(defvoo nntp-warn-about-losing-connection t
"*If non-nil, beep when a server closes connection.")
-(defvoo nntp-coding-system-for-read 'binary
- "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
- "*Coding system to write to NNTP.")
-
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
:type
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-record-commands nil
(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
(nnheader-report 'nntp "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)
(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
+ (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-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."
(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 t))
+ (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 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))))
+ )))
+ (nnheader-report 'nntp "Couldn't open connection to %s."
+ nntp-address))))
(defun nntp-send-buffer (wait-for)
"Send the current buffer to server and wait until WAIT-FOR returns."
(set-buffer (nntp-find-connection-buffer nntp-server-buffer))
(erase-buffer)))
(nntp-encode-text)
- (process-send-region (nntp-find-connection nntp-server-buffer)
- (point-min) (point-max))
+ (let ((multibyte (and (boundp 'enable-multibyte-characters)
+ (symbol-value 'enable-multibyte-characters))))
+ (unwind-protect
+ ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
+ (let (default-enable-multibyte-characters mc-flag)
+ ;; `set-buffer-multibyte' will be provided by APEL for all Emacsen.
+ (set-buffer-multibyte nil)
+ (process-send-region (nntp-find-connection nntp-server-buffer)
+ (point-min) (point-max))))
+ (set-buffer-multibyte multibyte))
(nntp-retrieve-data
nil nntp-address nntp-port-number nntp-server-buffer
wait-for nnheader-callback-function))
(not nntp-nov-is-evil)
(nntp-retrieve-headers-with-xover articles fetch-old))
;; We successfully retrieved the headers via XOVER.
- 'nov
+ 'nov
;; XOVER didn't work, so we do it the hard, slow and inefficient
;; way.
(let ((number (length articles))
"Retrieve group info on GROUPS."
(nntp-possibly-change-group nil server)
(when (nntp-find-connection-buffer nntp-server-buffer)
- (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
- ;; 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)
+ (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
- ;; 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)
- (error
- (nnheader-report 'nntp "Connection to %s is closed." server)))
- (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)
- (error
- (nnheader-report 'nntp "Connection to %s is closed." server)))
- (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-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 (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)))))
+ (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))))))
(deffoo nntp-retrieve-articles (articles &optional group server)
(nntp-possibly-change-group group server)
(save-excursion
(set-buffer nntp-server-buffer)
(copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number))
- (nntp-find-group-and-number))))
+ (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)
"\r?\n\\.\r?\n" "HEAD"
(if (numberp article) (int-to-string article) article))
(prog1
- (nntp-find-group-and-number)
+ (nntp-find-group-and-number group)
(nntp-decode-text))))
(deffoo nntp-request-body (article &optional group server)
(nntp-kill-buffer (process-buffer process)))))
(deffoo nntp-request-list (&optional server)
+ "List active groups. If `nntp-list-options' is non-nil, the listing
+output from the server will be restricted to the specified newsgroups.
+If `nntp-options-subscribe' is non-nil, remove newsgroups that do not
+match the regexp. If `nntp-options-not-subscribe' is non-nil, remove
+newsgroups that match the regexp."
(nntp-possibly-change-group nil server)
- (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))
+ (with-current-buffer nntp-server-buffer
+ (prog1
+ (if (not nntp-list-options)
+ (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")
+ (let ((options (if (consp nntp-list-options)
+ nntp-list-options
+ (list nntp-list-options)))
+ (ret t))
+ (erase-buffer)
+ (while options
+ (goto-char (point-max))
+ (narrow-to-region (point) (point))
+ (setq ret (and ret
+ (nntp-send-command-nodelete
+ "\r?\n\\.\r?\n"
+ (format "LIST ACTIVE %s" (car options))))
+ options (cdr options))
+ (nntp-decode-text))
+ (widen)
+ ret))
+ (when (and (stringp nntp-options-subscribe)
+ (not (string-equal "" nntp-options-subscribe)))
+ (goto-char (point-min))
+ (keep-lines nntp-options-subscribe))
+ (when (and (stringp nntp-options-not-subscribe)
+ (not (string-equal "" nntp-options-not-subscribe)))
+ (goto-char (point-min))
+ (flush-lines nntp-options-subscribe)))))
(deffoo nntp-request-list-newsgroups (&optional server)
(nntp-possibly-change-group nil server)
(nntp-possibly-change-group nil server)
(save-excursion
(set-buffer nntp-server-buffer)
- (prog1
- (nntp-send-command
- "^\\.\r?\n" "NEWGROUPS"
- (format-time-string "%y%m%d %H%M%S" (date-to-time date)))
- (nntp-decode-text))))
+ (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")
- (nntp-send-buffer "^[23].*\n")))
+ (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)
(format " *server %s %s %s*"
nntp-address nntp-port-number
(gnus-buffer-exists-p buffer))))
- (mm-enable-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)
(nntp-kill-buffer ,pbuffer)))))
(process
(condition-case ()
- (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))
+ (funcall nntp-open-connection-function pbuffer)
(error nil)
(quit
(message "Quit opening connection")
nil))))
(defun nntp-open-network-stream (buffer)
- (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+ (open-network-stream-as-binary
+ "nntpd" buffer nntp-address nntp-port-number))
(defun nntp-open-ssl-stream (buffer)
- (let* ((ssl-program-arguments '("-connect" (concat host ":" service)))
- (proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number)))
+ (let ((proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number)))
(save-excursion
(set-buffer buffer)
(nntp-wait-for-string "^\r*20[01]")
(goto-char (point-max))
(when (re-search-backward
nntp-process-wait-for nntp-process-start-point t)
+ (let ((response (match-string 0)))
+ (with-current-buffer nntp-server-buffer
+ (setq nntp-process-response response)))
(nntp-async-stop process)
;; convert it.
(when (gnus-buffer-exists-p nntp-process-to-buffer)
(erase-buffer)
(nntp-send-command "^[245].*\n" "GROUP" group)
(setcar (cddr entry) group)
- (erase-buffer))))))
+ (erase-buffer)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)))))))
(defun nntp-decode-text (&optional cr-only)
"Decode the text in the current buffer."
(while (and (cdr articles)
(< (- (nth 1 articles) (car articles)) nntp-nov-gap))
(setq articles (cdr articles)))
-
+
(setq in-process-buffer-p (stringp nntp-server-xover))
(nntp-send-xover-command first (car articles))
(setq articles (cdr articles))
-
+
(when (and nntp-server-xover in-process-buffer-p)
;; Don't count tried request.
(setq count (1+ count))
(setq nntp-server-xover nil)))
nntp-server-xover))))
-;;; Alternative connection methods.
+(defun nntp-find-group-and-number (&optional group)
+ (save-excursion
+ (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
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ newsgroups xref)
+ (and number (zerop number) (setq number nil))
+ (if number
+ ;; Then we find the group name.
+ (setq group
+ (cond
+ ;; 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
+ (mail-fetch-field "newsgroups"))
+ (not (string-match "," newsgroups)))
+ newsgroups)
+ ;; If there is more than one group in the
+ ;; Newsgroups header, then the Xref header should
+ ;; be filled out. We hazard a guess that the group
+ ;; that has this article number in the Xref header
+ ;; is the one we are looking for. This might very
+ ;; well be wrong if this article happens to have
+ ;; the same number in several groups, but that's
+ ;; life.
+ ((and (setq xref (mail-fetch-field "xref"))
+ number
+ (string-match
+ (format "\\([^ :]+\\):%d" number) xref))
+ (match-string 1 xref))
+ (t "")))
+ (cond
+ ((and (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
+ (mail-fetch-field "newsgroups"))
+ (not (string-match "," newsgroups)))
+ (setq group newsgroups))
+ (group)
+ (t (setq group ""))))
+ (when (string-match "\r" group)
+ (setq group (substring group 0 (match-beginning 0))))
+ (cons group number)))))
(defun nntp-wait-for-string (regexp)
"Wait until string arrives in the buffer."
(set-buffer buf)
(goto-char (point-min)))))
+
+;; ==========================================================================
+;; Obsolete nntp-open-* connection methods -- drv
+;; ==========================================================================
+
+(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-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
+ "*Regular expression to match the shell prompt on the remote machine.")
+
+(defvoo nntp-rlogin-program "rsh"
+ "*Program used to log in on remote machines.
+The default is \"rsh\", but \"ssh\" is a popular alternative.")
+
+(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.")
+
+(defvoo nntp-rlogin-user-name nil
+ "*User name on remote system when using the rlogin connect method.")
+
+(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-user-name nil
+ "User name to log in via telnet with.")
+
+(defvoo nntp-telnet-passwd nil
+ "Password to use to log in via telnet with.")
+
(defun nntp-open-telnet (buffer)
(save-excursion
(set-buffer buffer)
(erase-buffer)
- (let ((proc (apply
- 'start-process
- "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
+ (let ((proc (as-binary-process
+ (apply
+ 'start-process
+ "nntpd" buffer nntp-telnet-command nntp-telnet-switches)))
(case-fold-search t))
(when (memq (process-status proc) '(open run))
(nntp-wait-for-string "^r?telnet")
(defun nntp-open-rlogin (buffer)
"Open a connection to SERVER using rsh."
(let ((proc (if nntp-rlogin-user-name
- (apply 'start-process
- "nntpd" buffer nntp-rlogin-program
- nntp-address "-l" nntp-rlogin-user-name
- nntp-rlogin-parameters)
- (apply 'start-process
- "nntpd" buffer nntp-rlogin-program nntp-address
- nntp-rlogin-parameters))))
+ (as-binary-process
+ (apply 'start-process
+ "nntpd" buffer nntp-rlogin-program
+ nntp-address "-l" nntp-rlogin-user-name
+ nntp-rlogin-parameters))
+ (as-binary-process
+ (apply 'start-process
+ "nntpd" buffer nntp-rlogin-program nntp-address
+ nntp-rlogin-parameters)))))
(save-excursion
(set-buffer buffer)
(nntp-wait-for-string "^\r*20[01]")
(delete-region (point-min) (point))
proc)))
-(defun nntp-find-group-and-number ()
+
+;; ==========================================================================
+;; Replacements for the nntp-open-* functions -- drv
+;; ==========================================================================
+
+(defun nntp-open-telnet-stream (buffer)
+ "Open a nntp connection by telnet'ing the news server.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-telnet-command',
+- `nntp-telnet-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+ (let ((command `(,nntp-telnet-command
+ ,@nntp-telnet-switches
+ ,nntp-address ,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)
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
+
+(defun nntp-open-via-rlogin-and-telnet (buffer)
+ "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.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-rlogin-command',
+- `nntp-via-user-name',
+- `nntp-via-address',
+- `nntp-telnet-command',
+- `nntp-telnet-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+ (let ((command `(,nntp-via-address
+ ,nntp-telnet-command
+ ,@nntp-telnet-switches
+ ,nntp-address ,nntp-port-number))
+ proc)
+ (and nntp-via-user-name
+ (setq command `("-l" ,nntp-via-user-name ,@command)))
+ (push nntp-via-rlogin-command command)
+ (and nntp-pre-command
+ (push nntp-pre-command command))
+ (setq proc (as-binary-process
+ (apply 'start-process "nntpd" buffer command)))
+ (save-excursion
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
+
+(defun nntp-open-via-telnet-and-telnet (buffer)
+ "Open a connection to an nntp server through an intermediate host.
+First telnet the remote host, and then telnet the real news server
+from there.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-telnet-command',
+- `nntp-via-telnet-switches',
+- `nntp-via-address',
+- `nntp-via-envuser',
+- `nntp-via-user-name',
+- `nntp-via-user-password',
+- `nntp-via-shell-prompt',
+- `nntp-telnet-command',
+- `nntp-telnet-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
(save-excursion
- (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
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- group newsgroups xref)
- (and number (zerop number) (setq number nil))
- ;; Then we find the group name.
- (setq group
- (cond
- ;; 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 (mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
- newsgroups)
- ;; If there is more than one group in the Newsgroups
- ;; header, then the Xref header should be filled out.
- ;; We hazard a guess that the group that has this
- ;; article number in the Xref header is the one we are
- ;; looking for. This might very well be wrong if this
- ;; article happens to have the same number in several
- ;; groups, but that's life.
- ((and (setq xref (mail-fetch-field "xref"))
- number
- (string-match (format "\\([^ :]+\\):%d" number) xref))
- (substring xref (match-beginning 1) (match-end 1)))
- (t "")))
- (when (string-match "\r" group)
- (setq group (substring group 0 (match-beginning 0))))
- (cons group number)))))
+ (set-buffer buffer)
+ (erase-buffer)
+ (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
+ (case-fold-search t)
+ proc)
+ (and nntp-pre-command (push nntp-pre-command command))
+ (setq proc (apply 'start-process "nntpd" buffer command))
+ (when (memq (process-status proc) '(open run))
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc "set escape \^X\n")
+ (cond
+ ((and nntp-via-envuser nntp-via-user-name)
+ (process-send-string proc (concat "open " "-l" nntp-via-user-name
+ nntp-via-address "\n")))
+ (t
+ (process-send-string proc (concat "open " nntp-via-address
+ "\n"))))
+ (when (not nntp-via-envuser)
+ (nntp-wait-for-string "^\r*.?login:")
+ (process-send-string proc
+ (concat
+ (or nntp-via-user-name
+ (setq nntp-via-user-name
+ (read-string "login: ")))
+ "\n")))
+ (nntp-wait-for-string "^\r*.?password:")
+ (process-send-string proc
+ (concat
+ (or nntp-via-user-password
+ (setq nntp-via-user-password
+ (mail-source-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)))
+ (process-send-string proc
+ (concat (mapconcat 'identity
+ real-telnet-command " ")
+ "\n")))
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (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)))
(provide 'nntp)
projects / elisp / gnus.git- / blobdiff