X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=8b778d82d9dfa8f4833184af1d577e53583e14d5;hb=c3e1fa9581a5bfd59386b25a438fbb6650441f79;hp=487c72d218ecf421fbaba9841837180c719529e8;hpb=f487225f56bb13abb2f7f286b97b968c76511733;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index 487c72d..8b778d8 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,5 +1,5 @@ ;;; 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 ;; Keywords: news @@ -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 @@ -89,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 @@ -213,8 +210,18 @@ If this variable is nil, which is the default, no timers are set.") (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")) @@ -274,9 +281,9 @@ If this variable is nil, which is the default, no timers are set.") (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) @@ -329,17 +336,7 @@ If this variable is nil, which is the default, no timers are set.") ((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)) @@ -400,7 +397,7 @@ If this variable is nil, which is the default, no timers are set.") (cond ;; A result that starts with a 2xx code is terminated by ;; a line with only a "." on it. - ((eq (following-char) ?2) + ((eq (char-after) ?2) (if (re-search-forward "\n\\.\r?\n" nil t) t nil)) @@ -479,64 +476,65 @@ If this variable is nil, which is the default, no timers are set.") (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) @@ -587,7 +585,7 @@ If this variable is nil, which is the default, no timers are set.") (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, ;; wash it and copy it over to the server buffer. (set-buffer nntp-server-buffer) @@ -618,9 +616,14 @@ If this variable is nil, which is the default, no timers are set.") (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)) + +(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" "LIST ACTIVE" group)) + (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)) (deffoo nntp-request-article (article &optional group server buffer command) (nntp-possibly-change-group group server) @@ -652,7 +655,7 @@ If this variable is nil, which is the default, no timers are set.") (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)))) @@ -691,7 +694,7 @@ If this variable is nil, which is the default, no timers are set.") ;; 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))) @@ -708,7 +711,7 @@ If this variable is nil, which is the default, no timers are set.") ;; 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)))))) @@ -728,7 +731,7 @@ If this variable is nil, which is the default, no timers are set.") (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" - (format-time-string "%y%m%d %H%M%S" (nnmail-date-to-time date))) + (format-time-string "%y%m%d %H%M%S" (date-to-time date))) (nntp-decode-text)))) (deffoo nntp-request-post (&optional server) @@ -749,7 +752,7 @@ If this variable is nil, which is the default, no timers are set.") 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. @@ -777,7 +780,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (or passwd nntp-authinfo-password (setq nntp-authinfo-password - (nnmail-read-passwd (format "NNTP (%s@%s) password: " + (mail-source-read-passwd (format "NNTP (%s@%s) password: " user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () @@ -787,7 +790,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) (when t ;???Should check if AUTHINFO succeeded (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (nnmail-read-passwd "NNTP (%s@%s) password: " + (mail-source-read-passwd "NNTP (%s@%s) password: " user nntp-address)))))) (defun nntp-send-authinfo-from-file () @@ -796,7 +799,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the 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)) @@ -825,7 +828,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) @@ -838,8 +841,8 @@ 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 + (timer + (and nntp-connection-timeout (nnheader-run-at-time nntp-connection-timeout nil `(lambda () @@ -852,7 +855,7 @@ password contained in '~/.nntp-authinfo'." (funcall nntp-open-connection-function pbuffer)) (error nil) (quit nil)))) - (when timer + (when timer (nnheader-cancel-timer timer)) (when (and (buffer-name pbuffer) process) @@ -903,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." @@ -946,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) @@ -956,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." @@ -978,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)))))) @@ -1115,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) @@ -1197,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)