X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=32f3a394e24baefb2143326092029e082b07146d;hb=625b891fc07e1e5fc5f2658176b6c0e3cb244ee0;hp=67c69579bb1ff98f00bceeacdf0380734f6f2d24;hpb=2ad0e1a962763fc4b9c4ed14dca5f730b60bf9dd;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index 67c6957..32f3a39 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; 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 +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -30,10 +30,6 @@ (nnoo-declare nntp) -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - (eval-when-compile (require 'cl)) (defvoo nntp-address nil @@ -45,13 +41,11 @@ (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" @@ -91,7 +85,8 @@ 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 @@ -181,6 +176,10 @@ server there that you can connect to. See also +(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 @@ -197,6 +196,7 @@ server there that you can connect to. See also (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) @@ -210,8 +210,19 @@ server there that you can connect to. See also (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")) @@ -233,8 +244,10 @@ server there that you can connect to. See also (save-excursion (set-buffer (get-buffer-create "*nntp-log*")) (goto-char (point-max)) - (insert (format-time-string "%Y%m%dT%H%M%S" (current-time)) - " " nntp-address " " string "\n"))) + (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." @@ -268,17 +281,22 @@ server there that you can connect to. See also (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) @@ -291,8 +309,7 @@ server there that you can connect to. See also (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)))) @@ -323,17 +340,7 @@ server there that you can connect to. See also ((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)) @@ -391,18 +398,22 @@ server there that you can connect to. See also (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." @@ -469,64 +480,65 @@ server there that you can connect to. See also (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) @@ -539,7 +551,7 @@ server there that you can connect to. See also (nntp-inhibit-erase t) (map (apply 'vector articles)) (point 1) - article alist) + article) (set-buffer buf) (erase-buffer) ;; Send ARTICLE command. @@ -577,9 +589,9 @@ server there that you can connect to. See also (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)) @@ -608,9 +620,14 @@ server there that you can connect to. See also (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) @@ -642,7 +659,7 @@ server there that you can connect to. See also (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)))) @@ -678,9 +695,12 @@ server there that you can connect to. See also (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))) @@ -694,10 +714,9 @@ server there that you can connect to. See also ;; 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) @@ -711,16 +730,11 @@ server there that you can connect to. See also (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) @@ -740,39 +754,46 @@ server there that you can connect to. See also 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 (&optional send-if-force) "Send the AUTHINFO to the nntp server. 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)) (force (gnus-netrc-get alist "force")) - (user (gnus-netrc-get alist "login")) + (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) (passwd (gnus-netrc-get alist "password"))) (when (or (not send-if-force) force) - (nntp-send-command - "^3.*\r?\n" "AUTHINFO USER" - (or user (read-string (format "NNTP (%s) user name: " nntp-address)))) + (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 - (nnmail-read-passwd (format "NNTP (%s) password: " - nntp-address)))))))) + (mail-source-read-passwd (format "NNTP (%s@%s) password: " + user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server." - (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))) + (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. @@ -780,7 +801,7 @@ and a password." 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)) @@ -809,7 +830,7 @@ password contained in '~/.nntp-authinfo'." (format " *server %s %s %s*" nntp-address nntp-port-number (gnus-buffer-exists-p buffer)))) - (buffer-disable-undo (current-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) @@ -822,13 +843,23 @@ password contained in '~/.nntp-authinfo'." "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)) @@ -843,13 +874,22 @@ password contained in '~/.nntp-authinfo'." (let ((nnheader-callback-function nil)) (run-hooks 'nntp-server-opened-hook) (nntp-send-authinfo t)))) - (when (buffer-name (process-buffer process)) - (kill-buffer (process-buffer process))) + (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. @@ -866,40 +906,97 @@ password contained in '~/.nntp-authinfo'." (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)) +(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 ((cur (current-buffer)) - (start nntp-process-start-point)) + (let ((buf (current-buffer)) + (start nntp-process-start-point) + (decode nntp-process-decode)) (save-excursion (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." @@ -909,7 +1006,7 @@ password contained in '~/.nntp-authinfo'." (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) @@ -919,7 +1016,7 @@ password contained in '~/.nntp-authinfo'." (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." @@ -941,8 +1038,7 @@ password contained in '~/.nntp-authinfo'." (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)))))) @@ -982,11 +1078,7 @@ password contained in '~/.nntp-authinfo'." (while (not (eobp)) (end-of-line) (delete-char 1) - (insert nntp-end-of-line) - (forward-line 1)) - (forward-char -1) - (unless (eq (char-after (1- (point))) ?\r) - (insert "\r")))) + (insert nntp-end-of-line)))) (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (set-buffer nntp-server-buffer) @@ -1082,7 +1174,6 @@ password contained in '~/.nntp-authinfo'." (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) @@ -1164,7 +1255,7 @@ password contained in '~/.nntp-authinfo'." 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)