-;;; 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
(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)
(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))
(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))))
(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)))
It will prompt for a password."
(nntp-send-command
"^.*\r?\n" "AUTHINFO USER"
- (read-string "NNTP (%s) user name: " nntp-address))
+ (read-string (format "NNTP (%s) user name: " nntp-address)))
(nntp-send-command
"^.*\r?\n" "AUTHINFO PASS"
(nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
"^.*\r?\n" "AUTHINFO PASS"
- (read-string "NNTP (%s) password: " nntp-address)))
+ (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)))))
+ (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)))
(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))))
"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)))
+ (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
;; 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))
projects / gnus / blobdiff