X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=3e57e1ebd4bbb69056b68bad7ee5b2f0ac31c211;hb=3a75505b36e914f05480b86020edd727c6abe2fb;hp=4a4b17bf328ed3580962547b4c2a8fe6c131d6cd;hpb=104a4dfd02fa25e48924ef8ea1365279f636c6d6;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index 4a4b17b..3e57e1e 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; 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 ;; Keywords: news @@ -9,18 +9,18 @@ ;; 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: @@ -65,57 +65,70 @@ You probably don't want to do that, though.") (defvoo nntp-open-connection-function 'nntp-open-network-stream "*Function used for connecting to a remote system. -It will be called with the buffer to output in. +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. @@ -183,6 +196,10 @@ server there that you can connect to. See also 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 @@ -262,6 +279,8 @@ noticing asynchronous data.") (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 @@ -274,19 +293,23 @@ noticing asynchronous data.") (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) @@ -365,17 +388,43 @@ noticing asynchronous data.") (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 " ")) + (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)))) + ))) + )) (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 " ")) + (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)))) + ))) + )) (defun nntp-send-command-and-decode (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -384,10 +433,24 @@ noticing asynchronous data.") (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 " ")) + (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 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)))) + ))) + )) + (defun nntp-send-buffer (wait-for) "Send the current buffer to server and wait until WAIT-FOR returns." @@ -397,8 +460,10 @@ noticing asynchronous data.") (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)) + (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))) (nntp-retrieve-data nil nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function)) @@ -437,7 +502,7 @@ noticing asynchronous data.") (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)) @@ -509,7 +574,8 @@ noticing asynchronous data.") (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"))) + (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)) @@ -531,7 +597,7 @@ noticing asynchronous data.") (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) @@ -549,7 +615,7 @@ noticing asynchronous data.") (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) @@ -558,7 +624,7 @@ noticing asynchronous data.") (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)) @@ -571,7 +637,7 @@ noticing asynchronous data.") (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 @@ -671,8 +737,8 @@ noticing asynchronous data.") (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) @@ -680,7 +746,7 @@ noticing asynchronous data.") "\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) @@ -762,16 +828,43 @@ noticing asynchronous data.") (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) @@ -885,7 +978,7 @@ password contained in '~/.nntp-authinfo'." (process (condition-case () (let ((coding-system-for-read nntp-coding-system-for-read) - (coding-system-for-write nntp-coding-system-for-write)) + (coding-system-for-write nntp-coding-system-for-write)) (funcall nntp-open-connection-function pbuffer)) (error nil) (quit @@ -920,8 +1013,7 @@ password contained in '~/.nntp-authinfo'." (open-network-stream "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]") @@ -1012,6 +1104,9 @@ password contained in '~/.nntp-authinfo'." (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) @@ -1079,7 +1174,10 @@ password contained in '~/.nntp-authinfo'." (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." @@ -1174,11 +1272,11 @@ password contained in '~/.nntp-authinfo'." (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)) @@ -1275,7 +1373,63 @@ password contained in '~/.nntp-authinfo'." (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." @@ -1286,6 +1440,42 @@ password contained in '~/.nntp-authinfo'." (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) @@ -1351,44 +1541,143 @@ password contained in '~/.nntp-authinfo'." (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 (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)