;;; nntp.el --- nntp access for Gnus
-;;; Copyright (C) 1987-90,92-99 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
+;; 1997, 1998, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
It is called with no parameters.")
(defvoo nntp-server-action-alist
- '(("nntpd 1\\.5\\.11t"
- (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
- ("NNRP server Netscape"
- (setq nntp-server-list-active-group nil)))
+ '(("nntpd 1\\.5\\.11t"
+ (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
+ ("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
to innd, you could say something like:
(defvoo nntp-connection-timeout nil
"*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.")
+If this variable is nil, which is the default, no timers are set.
+NOTE: This variable is never seen to work in FSF Emacs 20 and XEmacs 21.")
;;; Internal variables.
(save-excursion
(set-buffer (process-buffer process))
(erase-buffer)))
- (when command
- (nntp-send-string process command))
- (cond
- ((eq callback 'ignore)
- t)
- ((and callback wait-for)
- (nntp-async-wait process wait-for buffer decode callback)
- t)
- (wait-for
- (nntp-wait-for process wait-for buffer decode))
- (t t)))))
+ (condition-case err
+ (progn
+ (when command
+ (nntp-send-string process command))
+ (cond
+ ((eq callback 'ignore)
+ t)
+ ((and callback wait-for)
+ (nntp-async-wait process wait-for buffer decode callback)
+ t)
+ (wait-for
+ (nntp-wait-for process wait-for buffer decode))
+ (t t)))
+ (error
+ (nnheader-report 'nntp "Couldn't open connection to %s: %s"
+ address err))
+ (quit
+ (message "Quit retrieving data from nntp")
+ (signal 'quit nil)
+ nil)))))
(defsubst nntp-send-command (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
(nntp-inhibit-erase t)
article)
;; Send HEAD commands.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "HEAD" (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
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (setq last-point (point))
- (incf received))
- (< 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 headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "HEAD" (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
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (setq last-point (point))
+ (incf received))
+ (< 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 headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
(nnheader-message 6 "NNTP: Receiving headers...done"))
(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.
(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.
(zerop (% count nntp-maximum-request)))
(nntp-accept-response)
(while (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)
(nntp-accept-response))))
;; Wait for the reply from the final command.
+ (set-buffer buf)
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
(when (looking-at "^[23]")
(while (progn
+ (set-buffer buf)
(goto-char (point-max))
(if (not nntp-server-list-active-group)
(not (re-search-backward "\r?\n" (- (point) 3) t))
(nntp-accept-response)))
;; Now all replies are received. We remove CRs.
+ (set-buffer buf)
(goto-char (point-min))
(while (search-forward "\r" nil t)
(replace-match "" t t))
If SEND-IF-FORCE, only send authinfo to the server if the
.authinfo file has the FORCE token."
(let* ((list (gnus-parse-netrc nntp-authinfo-file))
- (alist (gnus-netrc-machine list nntp-address))
+ (alist (gnus-netrc-machine list nntp-address "nntp"))
(force (gnus-netrc-get alist "force"))
(user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
(passwd (gnus-netrc-get alist "password")))
(unless (member user '(nil ""))
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
(when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (or passwd
- nntp-authinfo-password
- (setq nntp-authinfo-password
- (mail-source-read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address))))))))))
+ (nntp-send-command
+ "^2.*\r?\n" "AUTHINFO PASS"
+ (or passwd
+ nntp-authinfo-password
+ (setq nntp-authinfo-password
+ (mail-source-read-passwd
+ (format "NNTP (%s@%s) password: "
+ user nntp-address))))))))))
(defun nntp-send-nosy-authinfo ()
"Send the AUTHINFO to the nntp server."
(when t ;???Should check if AUTHINFO succeeded
(nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
(mail-source-read-passwd "NNTP (%s@%s) password: "
- user nntp-address))))))
+ user nntp-address))))))
(defun nntp-send-authinfo-from-file ()
"Send the AUTHINFO to the nntp server.
(coding-system-for-write nntp-coding-system-for-write))
(funcall nntp-open-connection-function pbuffer))
(error nil)
- (quit nil))))
+ (quit
+ (message "Quit opening connection")
+ (nntp-kill-buffer pbuffer)
+ (signal 'quit nil)
+ nil))))
(when timer
(nnheader-cancel-timer timer))
(when (and (buffer-name pbuffer)
(if (memq (following-char) '(?4 ?5))
;; wants credentials?
(if (looking-at "480")
- (nntp-handle-authinfo nntp-process-to-buffer)
+ (nntp-handle-authinfo process)
;; report error message.
(nntp-snarf-error-message)
(nntp-do-callback nil))
(car (last articles)) 'wait)
(goto-char (point-min))
- (when (looking-at "[1-5][0-9][0-9] ")
+ (when (looking-at "[1-5][0-9][0-9] .*\n")
(delete-region (point) (progn (forward-line 1) (point))))
(while (search-forward "\r" nil t)
(replace-match "" t t))
((numberp nntp-nov-gap)
(let ((count 0)
(received 0)
- (last-point (point-min))
+ last-point
+ in-process-buffer-p
(buf nntp-server-buffer)
- ;;(process-buffer (nntp-find-connection (current-buffer))))
+ (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
first)
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
(< (- (nth 1 articles) (car articles)) nntp-nov-gap))
(setq articles (cdr articles)))
- (when (nntp-send-xover-command first (car articles))
- (setq articles (cdr articles)
- count (1+ count))
-
+ (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))
+
;; 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)))
- (accept-process-output)
- ;; 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.
- (set-buffer buf)
+
+ (nntp-accept-response)
+ ;; 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.
+ (set-buffer process-buffer)
(while (progn
- (goto-char last-point)
+ (goto-char (or last-point (point-min)))
;; Count replies.
- (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
- (setq received (1+ received)))
+ (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
+ (incf received))
(setq last-point (point))
(< received count))
- (accept-process-output)
- (set-buffer buf)))))
+ (nntp-accept-response)
+ (set-buffer process-buffer))
+ (set-buffer buf))))
(when nntp-server-xover
- ;; Wait for the reply from the final command.
- (goto-char (point-max))
- (re-search-backward "^[0-9][0-9][0-9] " nil t)
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)))
+ (when in-process-buffer-p
+ (set-buffer process-buffer)
+ ;; Wait for the reply from the final command.
+ (goto-char (point-max))
+ (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t))
+ (nntp-accept-response)
+ (set-buffer process-buffer)
+ (goto-char (point-max)))
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)
+ (set-buffer process-buffer)))
+ (set-buffer buf)
+ (goto-char (point-max))
+ (insert-buffer-substring process-buffer)
+ (set-buffer process-buffer)
+ (erase-buffer)
+ (set-buffer buf))
;; We remove any "." lines and status lines.
(goto-char (point-min))
(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))
+ (nntp-send-command-nodelete nil 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.
"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")
(process-send-string proc "set escape \^X\n")
(cond
((and nntp-open-telnet-envuser nntp-telnet-user-name)
(setq nntp-telnet-passwd
(mail-source-read-passwd "Password: ")))
"\n"))
- (erase-buffer)
(nntp-wait-for-string nntp-telnet-shell-prompt)
(process-send-string
proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n"))
(beginning-of-line)
(delete-region (point-min) (point))
(process-send-string proc "\^]")
- (nntp-wait-for-string "^telnet")
+ (nntp-wait-for-string "^r?telnet")
(process-send-string proc "mode character\n")
(accept-process-output proc 1)
(sit-for 1)
projects / gnus / blobdiff