;;; nntp.el --- nntp access for Gnus
-;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
+;;; Copyright (C) 1987-90,92-99 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(nnoo-declare nntp)
-(eval-and-compile
- (unless (fboundp 'open-network-stream)
- (require 'tcp)))
-
(eval-when-compile (require 'cl))
(defvoo nntp-address nil
(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
"*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
-to allow posting from the server. Note that this is only necessary to
-do on servers that use strict access control.")
+server spawn an nnrpd server.")
(defvoo nntp-authinfo-function 'nntp-send-authinfo
- "Function used to send AUTHINFO to the server.")
+ "Function used to send AUTHINFO to the server.
+It is called with no parameters.")
(defvoo nntp-server-action-alist
'(("nntpd 1\\.5\\.11t"
The default is \"rsh\", but \"ssh\" is a popular alternative.")
(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-login'.
+ "*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")
+(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
If the gap between two consecutive articles is bigger than this
variable, split the XOVER request into two requests.")
-(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.")
-
(defvoo nntp-prepare-server-hook nil
"*Hook run before a server is opened.
If can be used to set up a server remotely, for instance. Say you
"*Coding system to write to NNTP.")
(defcustom nntp-authinfo-file "~/.authinfo"
- "Docstring."
+ ".netrc-like file that holds nntp authinfo passwords."
:type
'(choice file
(repeat :tag "Entries"
\f
+(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.")
+
;;; Internal variables.
(defvar nntp-record-commands nil
(defvoo nntp-last-command-time nil)
(defvoo nntp-last-command nil)
(defvoo nntp-authinfo-password nil)
+(defvoo nntp-authinfo-user nil)
(defvar nntp-connection-list nil)
(defvoo nntp-server-xover 'try)
(defvoo nntp-server-list-active-group 'try)
+(defvar nntp-async-needs-kluge
+ (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
+ "*When non-nil, nntp will poll asynchronous connections
+once a second. By default, this is turned on only for Emacs
+20.3, which has a bug that breaks nntp's normal method of
+noticing asynchronous data.")
+
+(defvar nntp-async-timer nil)
+(defvar nntp-async-process-list nil)
+
(eval-and-compile
- (autoload 'nnmail-read-passwd "nnmail"))
+ (autoload 'mail-source-read-passwd "mail-source")
+ (autoload 'open-ssl-stream "ssl"))
\f
"Record the command STRING."
(save-excursion
(set-buffer (get-buffer-create "*nntp-log*"))
- (insert (format-time-string "%Y%m%dT%H%M%S" (current-time))
- " " nntp-address " " string "\n")))
+ (goto-char (point-max))
+ (let ((time (current-time)))
+ (insert (format-time-string "%Y%m%dT%H%M%S" time)
+ "." (format "%03d" (/ (nth 2 time) 1000))
+ " " nntp-address " " string "\n"))))
(defsubst 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))
(goto-char (point-min))
- (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
- (looking-at "480"))
+ (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
+ (looking-at "480"))
+ (memq (process-status process) '(open run)))
(when (looking-at "480")
(nntp-handle-authinfo process))
(nntp-accept-process-output process)
(progn
(nntp-snarf-error-message)
nil))
- ((memq (process-status process) '(open run))
+ ((not (memq (process-status process) '(open run)))
(nnheader-report 'nntp "Server closed connection"))
(t
(goto-char (point-max))
(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)
- (message ""))
+ (nnheader-message 5 ""))
t))))
(unless discard
(erase-buffer)))))
+(defun nntp-kill-buffer (buffer)
+ (when (buffer-name buffer)
+ (kill-buffer buffer)
+ (nnheader-init-server-buffer)))
+
(defsubst nntp-find-connection (buffer)
"Find the connection delivering to BUFFER."
(let ((alist nntp-connection-alist)
(when process
(if (memq (process-status process) '(open run))
process
- (when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process)))
+ (nntp-kill-buffer (process-buffer process))
(setq nntp-connection-alist (delq entry nntp-connection-alist))
nil))))
((eq callback 'ignore)
t)
((and callback wait-for)
- (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-callback)))
+ (nntp-async-wait process wait-for buffer decode callback)
t)
(wait-for
(nntp-wait-for process wait-for buffer decode))
(nnoo-define-basics nntp)
(defsubst nntp-next-result-arrived-p ()
- (let ((point (point)))
- (cond
- ((eq (following-char) ?2)
- (if (re-search-forward "\n\\.\r?\n" nil t)
- t
- (goto-char point)
- nil))
- ((looking-at "[34]")
- (forward-line 1)
- t)
- (t
- nil))))
+ (cond
+ ;; A result that starts with a 2xx code is terminated by
+ ;; a line with only a "." on it.
+ ((eq (char-after) ?2)
+ (if (re-search-forward "\n\\.\r?\n" nil t)
+ t
+ nil))
+ ;; A result that starts with a 3xx or 4xx code is terminated
+ ;; by a newline.
+ ((looking-at "[34]")
+ (if (search-forward "\n" nil t)
+ t
+ nil))
+ ;; No result here.
+ (t
+ nil)))
(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
"Retrieve the headers of ARTICLES."
(deffoo nntp-retrieve-groups (groups &optional server)
"Retrieve group info on GROUPS."
(nntp-possibly-change-group nil server)
- (save-excursion
- (set-buffer (nntp-find-connection-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))
- (nntp-inhibit-erase t)
- (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))
- (incf 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)
- (incf received))
- (setq last-point (point))
- (< received count))
- (nntp-accept-response))))
+ (when (nntp-find-connection-buffer nntp-server-buffer)
+ (save-excursion
+ (set-buffer (nntp-find-connection-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))
+ (nntp-inhibit-erase t)
+ (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))
+ (incf 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)
+ (incf received))
+ (setq last-point (point))
+ (< received count))
+ (nntp-accept-response))))
- ;; Wait for the reply from the final command.
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (if (not nntp-server-list-active-group)
- (not (re-search-backward "\r?\n" (- (point) 3) t))
- (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))
- (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))
+ ;; Wait for the reply from the final command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (if (not nntp-server-list-active-group)
+ (not (re-search-backward "\r?\n" (- (point) 3) t))
+ (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))
+ (nntp-accept-response)))
- (if (not nntp-server-list-active-group)
- (progn
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'group)
- ;; We have read active entries, so we just delete the
- ;; superfluous gunk.
+ ;; Now all replies are received. We remove CRs.
(goto-char (point-min))
- (while (re-search-forward "^[.2-5]" nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'active))))
+ (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))
+ 'group)
+ ;; We have read active entries, so we just delete the
+ ;; superfluous gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (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)
(nntp-inhibit-erase t)
(map (apply 'vector articles))
(point 1)
- article alist)
+ article)
(set-buffer buf)
(erase-buffer)
;; Send ARTICLE command.
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
(nnheader-message 6 "NNTP: Receiving articles...done"))
-
+
;; Now we have all the responses. We go through the results,
- ;; washes it and copies it over to the server buffer.
+ ;; wash it and copy it over to the server buffer.
(set-buffer nntp-server-buffer)
(erase-buffer)
(setq last-point (point-min))
(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."
+ "Return the active info on GROUP (which can be a regexp)."
(nntp-possibly-change-group nil server)
- (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
+ (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))
+
+(deffoo nntp-request-group-articles (group &optional server)
+ "Return the list of existing articles in GROUP."
+ (nntp-possibly-change-group nil server)
+ (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))
(deffoo nntp-request-article (article &optional group server buffer command)
(nntp-possibly-change-group group server)
(deffoo nntp-request-group (group &optional server dont-check)
(nntp-possibly-change-group nil server)
- (when (nntp-send-command "^21.*\n" "GROUP" group)
+ (when (nntp-send-command "^[245].*\n" "GROUP" group)
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(setcar (cddr entry) group))))
(deffoo nntp-close-server (&optional server)
(nntp-possibly-change-group nil server t)
- (let (process)
- (while (setq process (car (pop nntp-connection-alist)))
+ (let ((process (nntp-find-connection nntp-server-buffer)))
+ (while process
(when (memq (process-status process) '(open run))
(ignore-errors
(nntp-send-string process "QUIT")
(unless (eq nntp-open-connection-function 'nntp-open-network-stream)
+ ;; Ok, this is evil, but when using telnet and stuff
+ ;; as the connection method, it's important that the
+ ;; QUIT command actually is sent out before we kill
+ ;; the process.
(sleep-for 1))))
- (when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process))))
+ (nntp-kill-buffer (process-buffer process))
+ (setq process (car (pop nntp-connection-alist))))
(nnoo-close-server 'nntp)))
(deffoo nntp-request-close ()
;; Ok, this is evil, but when using telnet and stuff
;; as the connection method, it's important that the
;; QUIT command actually is sent out before we kill
- ;; the process.
+ ;; the process.
(sleep-for 1))))
- (when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process))))))
+ (nntp-kill-buffer (process-buffer process)))))
(deffoo nntp-request-list (&optional server)
(nntp-possibly-change-group nil server)
(nntp-possibly-change-group nil server)
(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)))))
+ (prog1
+ (nntp-send-command
+ "^\\.\r?\n" "NEWGROUPS"
+ (format-time-string "%y%m%d %H%M%S" (date-to-time date)))
+ (nntp-decode-text))))
(deffoo nntp-request-post (&optional server)
(nntp-possibly-change-group nil server)
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 "^.*\n" "MODE READER"))
-(defun nntp-send-authinfo ()
+(defun nntp-send-authinfo (&optional send-if-force)
"Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
It will look in the \"~/.authinfo\" file for matching entries. If
nothing suitable is found there, it will prompt for a user name
-and a password."
+and a password.
+
+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))
- (user (gnus-netrc-get alist "login"))
+ (force (gnus-netrc-get alist "force"))
+ (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
(passwd (gnus-netrc-get alist "password")))
- (nntp-send-command
- "^3.*\r?\n" "AUTHINFO USER"
- (or user (read-string (format "NNTP (%s) user name: " nntp-address))))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (or passwd
- nntp-authinfo-password
- (setq nntp-authinfo-password
- (nnmail-read-passwd (format "NNTP (%s) password: "
- nntp-address)))))))
+ (when (or (not send-if-force)
+ force)
+ (unless user
+ (setq user (read-string (format "NNTP (%s) user name: " nntp-address))
+ nntp-authinfo-user user))
+ (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))))))))))
(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
- "^3.*\r?\n" "AUTHINFO USER"
- (read-string (format "NNTP (%s) user name: " nntp-address)))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
+ "Send the AUTHINFO to the nntp server."
+ (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
+ (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"
+ (mail-source-read-passwd "NNTP (%s@%s) password: "
+ user 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'.
The authinfo login name is taken from the user's login name and the
password contained in '~/.nntp-authinfo'."
(when (file-exists-p "~/.nntp-authinfo")
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(generate-new-buffer
(format " *server %s %s %s*"
nntp-address nntp-port-number
- (buffer-name (get-buffer buffer)))))
- (buffer-disable-undo (current-buffer))
+ (gnus-buffer-exists-p buffer))))
+ (mm-enable-multibyte)
(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)
"Open a connection to PORT on ADDRESS delivering output to BUFFER."
(run-hooks 'nntp-prepare-server-hook)
(let* ((pbuffer (nntp-make-process-buffer buffer))
+ (timer
+ (and nntp-connection-timeout
+ (nnheader-run-at-time
+ nntp-connection-timeout nil
+ `(lambda ()
+ (nntp-kill-buffer ,pbuffer)))))
(process
(condition-case ()
- (let ((coding-system-for-read nntp-coding-system-for-read))
+ (let ((coding-system-for-read nntp-coding-system-for-read)
+ (coding-system-for-write nntp-coding-system-for-write))
(funcall nntp-open-connection-function pbuffer))
(error nil)
(quit nil))))
- (when process
+ (when timer
+ (nnheader-cancel-timer timer))
+ (when (and (buffer-name pbuffer)
+ process)
(process-kill-without-query process)
(nntp-wait-for process "^.*\n" buffer nil t)
(if (memq (process-status process) '(open run))
(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)))
+ (run-hooks 'nntp-server-opened-hook)
+ (nntp-send-authinfo t))))
+ (nntp-kill-buffer (process-buffer process))
nil))))
(defun nntp-open-network-stream (buffer)
(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)))
+ (save-excursion
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
+
(defun nntp-read-server-type ()
"Find out what the name of the server we have connected to is."
;; Wait for the status string to arrive.
(eval (cadr entry))
(funcall (cadr entry)))))))
-(defun nntp-after-change-function-callback (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")
- (nntp-handle-authinfo nntp-process-to-buffer)
- (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))
+(defun nntp-async-wait (process wait-for buffer decode callback)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (unless nntp-inside-change-function
+ (erase-buffer))
+ (setq nntp-process-wait-for wait-for
+ nntp-process-to-buffer buffer
+ nntp-process-decode decode
+ nntp-process-callback callback
+ nntp-process-start-point (point-max))
+ (setq after-change-functions '(nntp-after-change-function))
+ (if nntp-async-needs-kluge
+ (nntp-async-kluge process))))
+
+(defun nntp-async-kluge (process)
+ ;; emacs 20.3 bug: process output with encoding 'binary
+ ;; doesn't trigger after-change-functions.
+ (unless nntp-async-timer
+ (setq nntp-async-timer
+ (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
+ (add-to-list 'nntp-async-process-list process))
+
+(defun nntp-async-timer-handler ()
+ (mapcar
+ (lambda (proc)
+ (if (memq (process-status proc) '(open run))
+ (nntp-async-trigger proc)
+ (nntp-async-stop proc)))
+ nntp-async-process-list))
+
+(defun nntp-async-stop (proc)
+ (setq nntp-async-process-list (delq proc nntp-async-process-list))
+ (when (and nntp-async-timer (not nntp-async-process-list))
+ (nnheader-cancel-timer nntp-async-timer)
+ (setq nntp-async-timer nil)))
+
+(defun nntp-after-change-function (beg end len)
+ (unwind-protect
+ ;; we only care about insertions at eob
+ (when (and (eq 0 len) (eq (point-max) end))
+ (save-match-data
+ (let ((proc (get-buffer-process (current-buffer))))
+ (when proc
+ (nntp-async-trigger proc)))))
+ ;; any throw from after-change-functions will leave it
+ ;; set to nil. so we reset it here, if necessary.
+ (when quit-flag
+ (setq after-change-functions '(nntp-after-change-function)))))
+
+(defun nntp-async-trigger (process)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (when nntp-process-callback
+ ;; do we have an error message?
+ (goto-char nntp-process-start-point)
+ (if (memq (following-char) '(?4 ?5))
+ ;; wants credentials?
+ (if (looking-at "480")
+ (nntp-handle-authinfo nntp-process-to-buffer)
+ ;; report error message.
+ (nntp-snarf-error-message)
+ (nntp-do-callback nil))
+
+ ;; got what we expect?
+ (goto-char (point-max))
+ (when (re-search-backward
+ nntp-process-wait-for nntp-process-start-point t)
+ (nntp-async-stop process)
+ ;; convert it.
+ (when (gnus-buffer-exists-p nntp-process-to-buffer)
+ (let ((buf (current-buffer))
+ (start nntp-process-start-point)
+ (decode nntp-process-decode))
(save-excursion
- (set-buffer (get-buffer nntp-process-to-buffer))
+ (set-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)
- (widen)))))
- (goto-char end)
- (let ((callback nntp-process-callback)
- (nntp-inside-change-function t))
- (setq nntp-process-callback nil)
- (save-excursion
- (funcall callback (buffer-name
- (get-buffer nntp-process-to-buffer))))))))))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert-buffer-substring buf start)
+ (when decode
+ (nntp-decode-text))))))
+ ;; report it.
+ (goto-char (point-max))
+ (nntp-do-callback
+ (buffer-name (get-buffer nntp-process-to-buffer))))))))
+
+(defun nntp-do-callback (arg)
+ (let ((callback nntp-process-callback)
+ (nntp-inside-change-function t))
+ (setq nntp-process-callback nil)
+ (funcall callback arg)))
(defun nntp-snarf-error-message ()
"Save the error message in the current buffer."
(nnheader-report 'nntp message)
message))
-(defun nntp-accept-process-output (process)
+(defun nntp-accept-process-output (process &optional timeout)
"Wait for output from PROCESS and message some dots."
(save-excursion
(set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
(unless (< len 10)
(setq nntp-have-messaged t)
(nnheader-message 7 "nntp read: %dk" len)))
- (accept-process-output process 1)))
+ (accept-process-output process (or timeout 1))))
(defun nntp-accept-response ()
"Wait for output from the process that outputs to BUFFER."
(save-excursion
(set-buffer (process-buffer (car entry)))
(erase-buffer)
- (nntp-send-string (car entry) (concat "GROUP " group))
- (nntp-wait-for-string "^2.*\n")
+ (nntp-send-command "^[245].*\n" "GROUP" group)
(setcar (cddr entry) group)
(erase-buffer))))))
(goto-char (point-min))
(while (not (eobp))
(end-of-line)
- (insert "\r")
- (forward-line 1))))
+ (delete-char 1)
+ (insert nntp-end-of-line))))
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
(set-buffer nntp-server-buffer)
(delete-char -1))
(goto-char (point-min))
(delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
- ;;(copy-to-buffer nntp-server-buffer (point-min) (point-max))
t))))
nntp-server-xover)
proc (concat
(or nntp-telnet-passwd
(setq nntp-telnet-passwd
- (nnmail-read-passwd "Password: ")))
+ (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"))
(apply 'start-process
"nntpd" buffer nntp-rlogin-program nntp-address
nntp-rlogin-parameters))))
- (set-buffer buffer)
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc))
+ (save-excursion
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
(defun nntp-find-group-and-number ()
(save-excursion
projects / elisp / gnus.git- / blobdiff