-;;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
+;;; nntp.el --- nntp access for Gnus
+;;; Copyright (C) 1987,88,89,90,92,93,94,95,96,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
"Port number on the physical nntp server.")
(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
- "*Hook used for sending commands to the server at startup.
+ "*Hook used for sending commands to the server at startup.
The default value is `nntp-send-mode-reader', which makes an innd
server spawn an nnrpd server. Another useful function to put in this
hook might be `nntp-send-authinfo', which will prompt for a password
(defvoo nntp-authinfo-function 'nntp-send-authinfo
"Function used to send AUTHINFO to the server.")
-(defvoo nntp-server-action-alist
- '(("nntpd 1\\.5\\.11t"
+(defvoo nntp-server-action-alist
+ '(("nntpd 1\\.5\\.11t"
(remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
- ("NNRP server Netscape"
+ ("NNRP server Netscape"
(setq nntp-server-list-active-group nil)))
"Alist of regexps to match on server types and actions to be taken.
For instance, if you want Gnus to beep every time you connect
(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
+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
(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
+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.")
;;; Internal variables.
+(defvar nntp-have-messaged nil)
+
(defvar nntp-process-wait-for nil)
(defvar nntp-process-to-buffer nil)
(defvar nntp-process-callback nil)
(defvoo nntp-status-string "")
(defconst nntp-version "nntp 5.0")
(defvoo nntp-inhibit-erase nil)
+(defvoo nntp-inhibit-output nil)
(defvoo nntp-server-xover 'try)
(defvoo nntp-server-list-active-group 'try)
;; We successfully retrieved the headers via XOVER.
'nov
;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
+ ;; way.
(let ((number (length articles))
(count 0)
(received 0)
(nntp-inhibit-erase t))
;; Send HEAD command.
(while articles
- (nntp-send-command
+ (nntp-send-command
nil
"HEAD" (if (numberp (car articles))
(int-to-string (car articles))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
(zerop (% received 20))
- (message "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
+ (nnheader-message 6 "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
(nntp-accept-response))))
;; Wait for text of last command.
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
(when (looking-at "^[23]")
(while (progn
- (goto-char (- (point-max) 3))
+ (goto-char (point-max))
+ (forward-line -1)
(not (looking-at "^\\.\r?\n")))
(nntp-accept-response)))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
- (message "NNTP: Receiving headers...done"))
+ (nnheader-message 6 "NNTP: Receiving headers...done"))
;; Now all of replies are received. Fold continuation lines.
(nnheader-fold-continuation-lines)
;; Remove all "\r"'s.
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
+ (nnheader-strip-cr)
(copy-to-buffer nntp-server-buffer (point-min) (point-max))
'headers))))
(save-excursion
(set-buffer (nntp-find-connection-buffer nntp-server-buffer))
;; The first time this is run, this variable is `try'. So we
- ;; try.
+ ;; try.
(when (eq nntp-server-list-active-group 'try)
(nntp-try-list-active (car groups)))
(erase-buffer)
(copy-to-buffer nntp-server-buffer (point-min) (point-max))
'active))))
+(deffoo nntp-retrieve-articles (articles &optional group server)
+ (nntp-possibly-change-group group server)
+ (save-excursion
+ (let ((number (length articles))
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ (map (apply 'vector articles))
+ (point 1)
+ article alist)
+ (set-buffer buf)
+ (erase-buffer)
+ ;; Send HEAD command.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "ARTICLE" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (progn
+ (set-buffer buf)
+ (goto-char last-point))
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (aset map received (cons (aref map received) (point)))
+ (incf received))
+ (setq last-point (point))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving articles... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving headers...done"))
+
+ ;; Now we have all the responses. We go through the results,
+ ;; washes it and copies it over to the server buffer.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (mapcar
+ (lambda (entry)
+ (narrow-to-region
+ (setq point (goto-char (point-max)))
+ (progn
+ (insert-buffer-substring buf last-point (cdr entry))
+ (point-max)))
+ (nntp-decode-text)
+ (widen)
+ (cons (car entry) point))
+ map))))
+
+(defun nntp-next-result-arrived-p ()
+ (let ((point (point)))
+ (cond
+ ((looking-at "2")
+ (if (re-search-forward "\n.\r?\n" nil t)
+ t
+ (goto-char point)
+ nil))
+ ((looking-at "[34]")
+ (forward-line 1)
+ t)
+ (t
+ nil))))
+
(defun nntp-try-list-active (group)
(nntp-list-active-group group)
(save-excursion
(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"
+ "\r?\n\\.\r?\n" "HEAD"
(if (numberp article) (int-to-string article) article))
(nntp-find-group-and-number)))
(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
+ (substring
(aref date 3) 3 5) (substring (aref date 3) 6 8))))
(prog1
(nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
(deffoo nntp-request-type (group article)
'news)
-
+
(deffoo nntp-asynchronous-p ()
t)
"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
+ (nntp-send-command
"^.*\r?\n" "AUTHINFO USER"
- (read-string "NNTP (%s) user name: " nntp-address))
- (nntp-send-command
- "^.*\r?\n" "AUTHINFO PASS"
+ (read-string (format "NNTP (%s) user name: " nntp-address)))
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
(nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
(defun nntp-send-authinfo ()
It will prompt for a password."
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
- "^.*\r?\n" "AUTHINFO PASS"
- (read-string "NNTP (%s) password: " nntp-address)))
+ "^.*\r?\n" "AUTHINFO PASS"
+ (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address))))
(defun nntp-send-authinfo-from-file ()
"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."
+This function is supposed to be called from `nntp-server-opened-hook'."
(when (file-exists-p "~/.nntp-authinfo")
- (save-excursion
- (set-buffer (get-buffer-create " *authinfo*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
+ (nnheader-temp-write nil
(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 PASS"
- (buffer-substring (point) (progn (end-of-line) (point))))
- (kill-buffer (current-buffer)))))
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
+ (buffer-substring (point) (progn (end-of-line) (point)))))))
;;; Internal functions.
(defun nntp-send-command (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
- (unless nnheader-callback-function
+ (when (and (not nnheader-callback-function)
+ (not nntp-inhibit-output))
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)))
(defun nntp-send-command-and-decode (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
- (unless nnheader-callback-function
+ (when (and (not nnheader-callback-function)
+ (not nntp-inhibit-output))
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)))
(defun nntp-send-buffer (wait-for)
"Send the current buffer to server and wait until WAIT-FOR returns."
- (unless nnheader-callback-function
+ (when (and (not nnheader-callback-function)
+ (not nntp-inhibit-output))
(save-excursion
(set-buffer (nntp-find-connection-buffer nntp-server-buffer))
(erase-buffer)))
(defun nntp-make-process-buffer (buffer)
"Create a new, fresh buffer usable for nntp process connections."
(save-excursion
- (set-buffer
+ (set-buffer
(generate-new-buffer
(format " *server %s %s %s*"
nntp-address nntp-port-number
(run-hooks 'nntp-prepare-server-hook)
(let* ((pbuffer (nntp-make-process-buffer buffer))
(process
- (ignore-errors
- (funcall nntp-open-connection-function pbuffer))))
+ (condition-case ()
+ (funcall nntp-open-connection-function pbuffer)
+ (error nil)
+ (quit nil))))
(when process
(process-kill-without-query process)
- (nntp-wait-for process "^.*\n" buffer)
+ (nntp-wait-for process "^.*\n" buffer nil t)
(if (memq (process-status process) '(open run))
(prog1
- (caar (push (list process buffer nil)
- nntp-connection-alist))
+ (caar (push (list process buffer nil) nntp-connection-alist))
(push process nntp-connection-list)
(save-excursion
- (set-buffer nntp-server-buffer)
+ (set-buffer pbuffer)
(nntp-read-server-type)
- (run-hooks 'nntp-server-opened-hook)
- (set-buffer buffer)
- (erase-buffer)))
+ (erase-buffer)
+ (set-buffer nntp-server-buffer)
+ (let ((nnheader-callback-function nil))
+ (run-hooks 'nntp-server-opened-hook))))
(when (buffer-name (process-buffer process))
(kill-buffer (process-buffer process)))
nil))))
(erase-buffer)))
(when command
(nntp-send-string process command))
- (cond
+ (cond
((eq callback 'ignore)
t)
((and callback wait-for)
(save-excursion
(set-buffer (process-buffer process))
- (unless nntp-inside-change-function
+ (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
+ after-change-functions
(list 'nntp-after-change-function-callback)))
t)
- (wait-for
+ (wait-for
(nntp-wait-for process wait-for buffer decode))
(t t)))))
"Send STRING to PROCESS."
(process-send-string process (concat string nntp-end-of-line)))
-(defun nntp-wait-for (process wait-for buffer &optional decode)
+(defun nntp-wait-for (process wait-for buffer &optional decode discard)
"Wait for WAIT-FOR to arrive from PROCESS."
(save-excursion
(set-buffer (process-buffer process))
(nntp-snarf-error-message)
nil)
(goto-char (point-max))
- (while (not (re-search-backward wait-for nil t))
- (nntp-accept-process-output process)
- (goto-char (point-max)))
+ (let ((limit (point-min)))
+ (while (not (re-search-backward wait-for limit t))
+ ;; We assume that whatever we wait for is less than 1000
+ ;; characters long.
+ (setq limit (max (- (point-max) 1000) (point-min)))
+ (nntp-accept-process-output process)
+ (goto-char (point-max))))
(nntp-decode-text (not decode))
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (insert-buffer-substring (process-buffer process))
- ;; Nix out "nntp reading...." message.
- (message "")
- t))
- (erase-buffer))))
+ (unless discard
+ (save-excursion
+ (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)
+ (message ""))
+ t)))
+ (unless discard
+ (erase-buffer)))))
(defun nntp-snarf-error-message ()
"Save the error message in the current buffer."
- (setq nntp-status-string (buffer-string)))
+ (let ((message (buffer-string)))
+ (while (string-match "[\r\n]+" message)
+ (setq message (replace-match " " t t message)))
+ (nnheader-report 'nntp message)
+ message))
(defun nntp-accept-process-output (process)
"Wait for output from PROCESS and message some dots."
(save-excursion
(set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
nntp-server-buffer))
- (let ((len (/ (point-max) 10000)))
- (unless (zerop len)
- (message "nntp reading%s" (make-string len ?.))))
+ (let ((len (/ (point-max) 1024))
+ message-log-max)
+ (unless (< len 10)
+ (setq nntp-have-messaged t)
+ (nnheader-message 7 "nntp read: %dk" len)))
(accept-process-output process 1)))
(defun nntp-accept-response ()
(nntp-accept-process-output (nntp-find-connection nntp-server-buffer)))
(defun nntp-possibly-change-group (group server &optional connectionless)
- (when server
- (or (nntp-server-opened server)
- (nntp-open-server server nil connectionless)))
+ (let ((nnheader-callback-function nil))
+ (when server
+ (or (nntp-server-opened server)
+ (nntp-open-server server nil connectionless)))
- (unless connectionless
- (or (nntp-find-connection nntp-server-buffer)
- (nntp-open-connection nntp-server-buffer)))
+ (unless connectionless
+ (or (nntp-find-connection nntp-server-buffer)
+ (nntp-open-connection nntp-server-buffer))))
(when group
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(when (not (equal group (caddr entry)))
- (nntp-request-group group)
(save-excursion
- (set-buffer nntp-server-buffer)
+ (set-buffer (process-buffer (car entry)))
+ (erase-buffer)
+ (nntp-send-string (car entry) (concat "GROUP " group))
+ (nntp-wait-for-string "^2.*\n")
+ (setcar (cddr entry) group)
(erase-buffer))))))
(defun nntp-decode-text (&optional cr-only)
"Decode the text in the current buffer."
(goto-char (point-min))
- ;; Remove \R's.
(while (search-forward "\r" nil t)
(delete-char -1))
(unless cr-only
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
(set-buffer nntp-server-buffer)
(erase-buffer)
- (cond
+ (cond
;; This server does not talk NOV.
((not nntp-server-xover)
;; We don't care about gaps.
((or (not nntp-nov-gap)
fetch-old)
- (nntp-send-xover-command
+ (nntp-send-xover-command
(if fetch-old
(if (numberp fetch-old)
(max 1 (- (car articles) fetch-old))
(while (and nntp-server-xover articles)
(setq first (car articles))
;; Search forward until we find a gap, or until we run out of
- ;; articles.
+ ;; articles.
(while (and (cdr articles)
(< (- (nth 1 articles) (car articles)) nntp-nov-gap))
(setq articles (cdr articles)))
;; On some Emacs versions the preceding function has
;; a tendency to change the buffer. Perhaps. It's
;; quite difficult to reproduce, because it only
- ;; seems to happen once in a blue moon.
+ ;; seems to happen once in a blue moon.
(set-buffer buf)
(while (progn
(goto-char last-point)
(forward-line -1)
(not (looking-at "^\\.\r?\n")))
(nntp-accept-response)))
-
+
;; We remove any "." lines and status lines.
(goto-char (point-min))
(while (search-forward "\r" nil t)
;; If `nntp-server-xover' is a string, then we just send this
;; command.
(if wait-for-reply
- (nntp-send-command-nodelete "\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-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.
+ ;; We try them all until we get at positive response.
(while (and commands (eq nntp-server-xover 'try))
(nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
(save-excursion
(nntp-wait-for-string "^\r*200")
(beginning-of-line)
(delete-region (point-min) (point))
- proc)
- )
+ proc))
(defun nntp-find-group-and-number ()
(save-excursion
(and number (zerop number) (setq number nil))
;; Then we find the group name.
(setq group
- (cond
+ (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.
;; 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.
+ ;; groups, but that's life.
((and (setq xref (mail-fetch-field "xref"))
number
(string-match (format "\\([^ :]+\\):%d" number) xref))
projects / gnus / blobdiff