-;;; nntp.el --- nntp access for Gnus
;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
do on servers that use strict access control.")
(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
+(defvoo nntp-authinfo-function 'nntp-send-authinfo
+ "Function used to send AUTHINFO to the server.")
+
(defvoo nntp-server-action-alist
'(("nntpd 1\\.5\\.11t"
(remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
(defvoo nntp-open-connection-function 'nntp-open-network-stream
"*Function used for connecting to a remote system.
-It will be called with the address of the remote system.
+It will be called with the buffer to output in.
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 is `nntp-open-rlogin', which
+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).")
+NNTP server available there (see nntp-rlogin-parameters) and `nntp-open-telnet' which
+telnets to a remote system, logs in and does the same")
-(defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
+(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
"*Parameters to `nntp-open-login'.
That function may be used as `nntp-open-server-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:=localhost}" "nntp")
+(defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
"*Parameters to `nntp-open-telnet'.
That function may be used as `nntp-open-server-function'. In that
case, this list will be executed as a command after logging in
have an account at the machine \"other.machine\". This machine has
access to an NNTP server that you can't access locally. You could
then use this hook to rsh to the remote machine and start a proxy NNTP
-server there that you can connect to.")
+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.")
;;; Internal variables.
+(defvar nntp-process-wait-for nil)
+(defvar nntp-process-to-buffer nil)
+(defvar nntp-process-callback nil)
+(defvar nntp-process-decode nil)
+(defvar nntp-process-start-point nil)
+(defvar nntp-inside-change-function nil)
+
(defvoo nntp-server-type nil)
(defvoo nntp-connection-alist nil)
(defvoo nntp-status-string "")
(let ((number (length articles))
(count 0)
(received 0)
- (last-point (point-min)))
+ (last-point (point-min))
+ (nntp-inhibit-erase t))
;; Send HEAD command.
(while articles
(nntp-send-command
(copy-to-buffer nntp-server-buffer (point-min) (point-max))
'headers))))
-(deffoo nntp-request-article (article &optional group server buffer)
+(deffoo nntp-retrieve-groups (groups &optional server)
+ "Retrieve group info on GROUPS."
+ (nntp-possibly-change-group nil server)
+ (save-excursion
+ (set-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))
+ (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
+ (while groups
+ ;; Send the command to the server.
+ (nntp-send-command nil command (car groups))
+ (setq groups (cdr groups))
+ (setq count (1+ 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 (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (nntp-accept-response))))
+
+ ;; Wait for the reply from the final command.
+ (when nntp-server-list-active-group
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (- (point-max) 3))
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response))))
+
+ ;; Now all replies are received. We remove CRs.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+
+ (if (not nntp-server-list-active-group)
+ 'group
+ ;; We have read active entries, so we just delete the
+ ;; superfluos gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ 'active))))
+
+ (defun nntp-try-list-active (group)
+ (nntp-list-active-group group)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (cond ((looking-at "5[0-9]+")
+ (setq nntp-server-list-active-group nil))
+ (t
+ (setq nntp-server-list-active-group t)))))
+
+(deffoo nntp-list-active-group (group &optional server)
+ "Return the active info on GROUP (which can be a regexp."
+ (nntp-possibly-change-group group server)
+ (nntp-send-command "^.*\r?\n" "LIST ACTIVE" 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"
+ "\r?\n\\.\r?\n" "ARTICLE"
(if (numberp article) (int-to-string article) article))
(when buffer
(save-excursion
(set-buffer nntp-server-buffer)
- (copy-to-buffer buffer (point-min) (point-max)))
- t)))
+ (copy-to-buffer buffer (point-min) (point-max))
+ (nntp-find-group-and-number)))
+ (nntp-find-group-and-number)))
+
+(deffoo nntp-request-head (article &optional group server)
+ (nntp-possibly-change-group group server)
+ (when (nntp-send-command-and-decode
+ "\r\n\\.\r\n" "HEAD"
+ (if (numberp article) (int-to-string article) article))
+ (nntp-find-group-and-number)))
(deffoo nntp-request-body (article &optional group server)
(nntp-possibly-change-group group server)
(nntp-send-command-and-decode
- "\r\n\\.\r\n" "BODY"
+ "\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 "^2.*\r\n" "GROUP" group)
+ (when (nntp-send-command "^2.*\n" "GROUP" group)
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(setcar (cddr entry) group))))
(while (setq process (car (pop nntp-connection-alist)))
(when (memq (process-status process) '(open run))
(set-process-sentinel process nil)
- (set-process-filter process nil)
(nntp-send-string process "QUIT"))
(when (buffer-name (process-buffer process))
(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-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-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))
(deffoo nntp-request-newgroups (date &optional server)
(nntp-possibly-change-group nil server)
- (let* ((date (timezone-parse-date date))
- (time-string
- (format "%s%02d%02d %s%s%s"
- (substring (aref date 0) 2) (string-to-int (aref date 1))
- (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
- (substring
- (aref date 3) 3 5) (substring (aref date 3) 6 8))))
- (prog1
- (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
- (nntp-decode-text))))
-
-(deffoo nntp-asynchronous-p ()
- t)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let* ((date (timezone-parse-date date))
+ (time-string
+ (format "%s%02d%02d %s%s%s"
+ (substring (aref date 0) 2) (string-to-int (aref date 1))
+ (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
+ (substring
+ (aref date 3) 3 5) (substring (aref date 3) 6 8))))
+ (prog1
+ (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
+ (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")))
+
+(deffoo nntp-request-type (group article)
+ 'news)
+(deffoo nntp-asynchronous-p ()
+ t)
+
;;; Hooky functions.
(defun nntp-send-mode-reader ()
This function is supposed to be called from `nntp-server-opened-hook'.
It will make innd servers spawn an nnrpd process to allow actual article
reading."
- (nntp-send-command "^.*\r\n" "MODE READER"))
+ (nntp-send-command "^.*\r?\n" "MODE READER"))
(defun nntp-send-nosy-authinfo ()
"Send the AUTHINFO to the nntp server.
This function is supposed to be called from `nntp-server-opened-hook'.
It will prompt for a password."
- (nntp-send-command "^.*\r\n" "AUTHINFO USER"
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER"
(read-string "NNTP user name: "))
- (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
- (read-string "NNTP password: ")))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
+ (nnmail-read-passwd "NNTP password: ")))
(defun nntp-send-authinfo ()
"Send the AUTHINFO to the nntp server.
This function is supposed to be called from `nntp-server-opened-hook'.
It will prompt for a password."
- (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
(read-string "NNTP password: ")))
(defun nntp-send-authinfo-from-file ()
(erase-buffer)
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
- (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
- "^.*\r\n" "AUTHINFO PASS"
+ "^.*\r?\n" "AUTHINFO PASS"
(buffer-substring (point) (progn (end-of-line) (point))))
(kill-buffer (current-buffer)))))
nntp-address nntp-port-number nntp-server-buffer
wait-for nnheader-callback-function))
+(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))
+
(defun nntp-send-command-and-decode (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
(unless nnheader-callback-function
"Send the current buffer to server and wait until WAIT-FOR returns."
(unless nnheader-callback-function
(save-excursion
- (set-buffer nntp-server-buffer)
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
(erase-buffer)))
(nntp-encode-text)
(process-send-region (nntp-find-connection nntp-server-buffer)
"Return the entry for the connection to BUFFER."
(assq (nntp-find-connection buffer) nntp-connection-alist))
+(defun nntp-find-connection-buffer (buffer)
+ "Return the process connection buffer tied to BUFFER."
+ (let ((process (nntp-find-connection buffer)))
+ (when process
+ (process-buffer process))))
+
+(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
+ (buffer-name (get-buffer buffer)))))
+ (buffer-disable-undo (current-buffer))
+ (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)
+ (set (make-local-variable 'nntp-process-to-buffer) nil)
+ (set (make-local-variable 'nntp-process-start-point) nil)
+ (set (make-local-variable 'nntp-process-decode) nil)
+ (current-buffer)))
+
(defun nntp-open-connection (buffer)
"Open a connection to PORT on ADDRESS delivering output to BUFFER."
(run-hooks 'nntp-prepare-server-hook)
- (let* ((pbuffer (save-excursion
- (set-buffer
- (generate-new-buffer
- (format " *server %s %s %s*"
- nntp-address nntp-port-number
- (buffer-name (get-buffer buffer)))))
- (buffer-disable-undo (current-buffer))
- (current-buffer)))
+ (let* ((pbuffer (nntp-make-process-buffer buffer))
(process
(condition-case ()
- (funcall nntp-open-connection-function pbuffer)
+ (funcall
+ nntp-open-connection-function pbuffer)
(error nil))))
(when process
(process-kill-without-query process)
- (nntp-wait-for process "^.*\r\n" buffer)
+ (nntp-wait-for process "^.*\n" buffer)
(if (memq (process-status process) '(open run))
(prog1
(caar (push (list process buffer nil)
(eval (cadr entry))
(funcall (cadr entry)))))))
-(defvar nntp-tmp-first)
-(defvar nntp-tmp-wait-for)
-(defvar nntp-tmp-callback)
-(defvar nntp-tmp-buffer)
-
-(defun nntp-make-process-filter (wait-for callback buffer decode)
- `(lambda (proc string)
- (let ((nntp-tmp-wait-for ,wait-for)
- (nntp-tmp-callback ,callback)
- (nntp-tmp-buffer ,buffer))
- (nntp-process-filter proc string))))
-
-(defun nntp-process-filter (proc string)
- "Process filter used for waiting a calling back."
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (let (point)
- (set-buffer (process-buffer proc))
- ;; Insert the text, moving the process-marker.
- (setq point (goto-char (process-mark proc)))
- (insert string)
- (set-marker (process-mark proc) (point))
- (if (and (= point (point-min))
- (string-match "^45" string))
- (progn
- (nntp-snarf-error-message)
- (set-process-filter proc nil)
- (funcall nntp-tmp-callback nil))
- (setq nntp-tmp-first nil)
- (if (re-search-backward nntp-tmp-wait-for nil t)
- (progn
- (if (buffer-name (get-buffer nntp-tmp-buffer))
- (save-excursion
- (set-buffer (get-buffer nntp-tmp-buffer))
- (goto-char (point-max))
- (insert-buffer-substring (process-buffer proc))))
- (set-process-filter proc nil)
- (erase-buffer)
- (funcall nntp-tmp-callback t)))))
- (set-buffer old-buffer))))
+(defun nntp-after-change-function (beg end len)
+ (when nntp-process-callback
+ (save-match-data
+ (if (and (= beg (point-min))
+ (memq (char-after beg) '(?4 ?5)))
+ ;; Report back error messages.
+ (save-excursion
+ (goto-char beg)
+ (if (looking-at "480")
+ (funcall nntp-authinfo-function)
+ (nntp-snarf-error-message)
+ (funcall nntp-process-callback nil)))
+ (goto-char end)
+ (when (and (> (point) nntp-process-start-point)
+ (re-search-backward nntp-process-wait-for
+ nntp-process-start-point t))
+ (when (buffer-name (get-buffer nntp-process-to-buffer))
+ (let ((cur (current-buffer))
+ (start nntp-process-start-point))
+ (save-excursion
+ (set-buffer (get-buffer nntp-process-to-buffer))
+ (goto-char (point-max))
+ (let ((b (point)))
+ (insert-buffer-substring cur start)
+ (narrow-to-region b (point-max))
+ (nntp-decode-text)
+ (goto-char (point-min))
+ (gnus-delete-line)
+ (widen)))))
+ (goto-char end)
+ (let ((callback nntp-process-callback)
+ (nntp-inside-change-function t))
+ (setq nntp-process-callback nil)
+ (save-excursion
+ (funcall callback t))))))))
(defun nntp-retrieve-data (command address port buffer
&optional wait-for callback decode)
(nntp-open-connection buffer))))
(if (not process)
(nnheader-report 'nntp "Couldn't open connection to %a" address)
- (unless nntp-inhibit-erase
+ (unless (or nntp-inhibit-erase nnheader-callback-function)
(save-excursion
(set-buffer (process-buffer process))
(erase-buffer)))
((eq callback 'ignore)
t)
((and callback wait-for)
- (set-process-filter
- process (nntp-make-process-filter wait-for callback buffer decode))
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (unless nntp-inside-change-function
+ (erase-buffer))
+ (setq nntp-process-decode decode
+ nntp-process-to-buffer buffer
+ nntp-process-wait-for wait-for
+ nntp-process-callback callback
+ nntp-process-start-point (point-max)
+ after-change-functions (list 'nntp-after-change-function)))
t)
(wait-for
- (set-process-filter process nil)
(nntp-wait-for process wait-for buffer decode))
(t t)))))
(save-excursion
(set-buffer (process-buffer process))
(goto-char (point-min))
- (while (not (looking-at "[2345]"))
+ (while (or (not (memq (following-char) '(?2 ?3 ?4 ?5)))
+ (looking-at "480"))
+ (when (looking-at "480")
+ (erase-buffer)
+ (funcall nntp-authinfo-function))
(nntp-accept-process-output process)
(goto-char (point-min)))
(prog1
- (if (looking-at "[345]")
+ (if (looking-at "[45]")
(progn
(nntp-snarf-error-message)
nil)
(nntp-decode-text (not decode))
(save-excursion
(set-buffer buffer)
+ (goto-char (point-max))
(insert-buffer-substring (process-buffer process))
t))
(erase-buffer))))
(defun nntp-accept-process-output (process)
"Wait for output from PROCESS and message some dots."
(save-excursion
- (set-buffer nntp-server-buffer)
- (message "nntp reading%s" (make-string (/ (point-max) 100) ?.))
+ (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
+ nntp-server-buffer))
+ (message "nntp reading%s" (make-string (/ (point-max) 10000) ?.))
(accept-process-output process 1)))
(defun nntp-accept-response ()
(insert "." nntp-end-of-line)))
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
+ (set-buffer nntp-server-buffer)
(erase-buffer)
(cond
;; If `nntp-server-xover' is a string, then we just send this
;; command.
(if wait-for-reply
- (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range)
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)
;; We do not wait for the reply.
- (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range))
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range))
(let ((commands nntp-xover-commands))
;; `nntp-xover-commands' is a list of possible XOVER commands.
;; We try them all until we get at positive response.
(while (and commands (eq nntp-server-xover 'try))
- (nntp-send-command "\r\n\\.\r\n" (car commands) range)
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(set-buffer buf)
(goto-char (point-min)))))
-(defun nntp-open-telnet (server)
+(defun nntp-open-telnet (buffer)
(save-excursion
- (set-buffer nntp-server-buffer)
+ (set-buffer buffer)
(erase-buffer)
(let ((proc (start-process
- "nntpd" nntp-server-buffer "telnet" "-8"))
+ "nntpd" buffer "telnet" "-8"))
(case-fold-search t))
(when (memq (process-status proc) '(open run))
(process-send-string proc "set escape \^X\n")
- (process-send-string proc (concat "open " server "\n"))
+ (process-send-string proc (concat "open " nntp-address "\n"))
(nntp-wait-for-string "^\r*.?login:")
(process-send-string
proc (concat
(delete-region (point) (point-max)))
proc)))
-(defun nntp-open-rlogin (server)
+(defun nntp-open-rlogin (buffer)
"Open a connection to SERVER using rsh."
(let ((proc (if nntp-rlogin-user-name
(start-process
- "nntpd" nntp-server-buffer "rsh"
- server "-l" nntp-rlogin-user-name
+ "nntpd" buffer "rsh"
+ nntp-address "-l" nntp-rlogin-user-name
(mapconcat 'identity
nntp-rlogin-parameters " "))
(start-process
- "nntpd" nntp-server-buffer "rsh" server
+ "nntpd" buffer "rsh" nntp-address
(mapconcat 'identity
nntp-rlogin-parameters " ")))))
- proc))
-
-(defun nntp-find-connection-buffer (buffer)
- "Return the process connection buffer tied to BUFFER."
- (let ((process (nntp-find-connection buffer)))
- (when process
- (process-buffer process))))
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*200")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)
+ )
+
+(defun nntp-find-group-and-number ()
+ (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)))))
(provide 'nntp)
projects / gnus / blobdiff