X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnntp.el;h=b617a1beeb276de359fb37508764e8a4e9282047;hp=d2c7654c151e66a9faf2cf5b7755514f90a4c322;hb=1c5a2d18ae5382304e3f073c3da5e943327a8f87;hpb=7e0e5bcdb353559c7f9d89eaf183e2e7cbe7bd92 diff --git a/lisp/nntp.el b/lisp/nntp.el index d2c7654c1..b617a1bee 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987-1990, 1992-1998, 2000-2012 -;; Free Software Foundation, Inc. +;; Copyright (C) 1987-1990, 1992-1998, 2000-2015 Free Software +;; Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -25,9 +25,7 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for ;; `make-network-stream'. (unless (fboundp 'open-protocol-stream) @@ -323,26 +321,26 @@ backend doesn't catch this error.") (insert (format-time-string "%Y%m%dT%H%M%S.%3N") " " nntp-address " " string "\n"))) +(defvar nntp--report-1 nil) + (defun nntp-report (&rest args) "Report an error from the nntp backend. The first string in ARGS can be a format string. For some commands, the failed command may be retried once before actually displaying the error report." + (if nntp--report-1 + (progn + ;; Throw out to nntp-with-open-group-error so that the connection may + ;; be restored and the command retried." + (when nntp-record-commands + (nntp-record-command "*** CONNECTION LOST ***")) + (throw 'nntp-with-open-group-error t)) - (when nntp-record-commands - (nntp-record-command "*** CALLED nntp-report ***")) - - (nnheader-report 'nntp args) + (when nntp-record-commands + (nntp-record-command "*** CALLED nntp-report ***")) - (apply 'error args)) - -(defun nntp-report-1 (&rest args) - "Throws out to nntp-with-open-group-error so that the connection may -be restored and the command retried." - - (when nntp-record-commands - (nntp-record-command "*** CONNECTION LOST ***")) + (nnheader-report 'nntp args) - (throw 'nntp-with-open-group-error t)) + (apply 'error args))) (defmacro nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." @@ -612,10 +610,6 @@ be restored and the command retried." (t nil))) -(eval-when-compile - (defvar nntp-with-open-group-internal nil) - (defvar nntp-report-n nil)) - (defun nntp-with-open-group-function (-group -server -connectionless -bodyfun) "Protect against servers that don't like clients that keep idle connections opens. The problem being that these servers may either close a connection or @@ -626,9 +620,9 @@ connection timeouts (which may be several minutes) or `nntp-connection-timeout' has expired. When these occur `nntp-with-open-group', opens a new connection then re-issues the NNTP command whose response triggered the error." - (letf ((nntp-report-n (symbol-function 'nntp-report)) - ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1)) - (nntp-with-open-group-internal nil)) + (let ((nntp-report-n nntp--report-1) + (nntp--report-1 t) + (nntp-with-open-group-internal nil)) (while (catch 'nntp-with-open-group-error ;; Open the connection to the server ;; NOTE: Existing connections are NOT tested. @@ -664,7 +658,7 @@ command whose response triggered the error." (when -timer (nnheader-cancel-timer -timer))) nil)) - (setf (symbol-function 'nntp-report) nntp-report-n)) + (setq nntp--report-1 nntp-report-n)) nntp-with-open-group-internal)) (defmacro nntp-with-open-group (group server &optional connectionless &rest forms) @@ -734,7 +728,7 @@ command whose response triggered the error." (> number nntp-large-newsgroup) (zerop (% received 20)) (nnheader-message 6 "NNTP: Receiving headers... %d%%" - (/ (* received 100) number))) + (floor (* received 100.0) number))) (nntp-accept-response)))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) @@ -809,7 +803,8 @@ command whose response triggered the error." (progn (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (gnus-groups-to-gnus-format method gnus-active-hashtb t)) + (with-current-buffer nntp-server-buffer + (gnus-groups-to-gnus-format method gnus-active-hashtb t))) ;; We have read active entries, so we just delete the ;; superfluous gunk. (goto-char (point-min)) @@ -970,7 +965,7 @@ command whose response triggered the error." (> number nntp-large-newsgroup) (zerop (% received 20)) (nnheader-message 6 "NNTP: Receiving articles... %d%%" - (/ (* received 100) number))) + (floor (* received 100.0) number))) (nntp-accept-response)))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) @@ -1224,38 +1219,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the 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 - (read-passwd (format "NNTP (%s@%s) password: " - user nntp-address)))))))))) - -(defun nntp-send-nosy-authinfo () - "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" - (read-passwd (format "NNTP (%s@%s) password: " - user nntp-address))))))) - -(defun nntp-send-authinfo-from-file () - "Send the AUTHINFO to the nntp server. - -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") - (with-temp-buffer - (insert-file-contents "~/.nntp-authinfo") - (goto-char (point-min)) - (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (point-at-eol)))))) + (let ((result + (nntp-send-command + "^2.*\r?\n" "AUTHINFO PASS" + (or passwd + nntp-authinfo-password + (setq nntp-authinfo-password + (read-passwd (format "NNTP (%s@%s) password: " + user nntp-address))))))) + (if (not result) + (signal 'nntp-authinfo-rejected "Password rejected") + result)))))) ;;; Internal functions. @@ -1309,7 +1283,7 @@ password contained in '~/.nntp-authinfo'." "nntpd" pbuffer nntp-address nntp-port-number :type (cadr (assoc nntp-open-connection-function map)) :end-of-command "^\\([2345]\\|[.]\\).*\n" - :capability-command "CAPABILITIES\r\n" + :capability-command "HELP\r\n" :success "^3" :starttls-function (lambda (capabilities) @@ -1383,14 +1357,6 @@ password contained in '~/.nntp-authinfo'." nntp-process-start-point (point-max)) (setq after-change-functions '(nntp-after-change-function)))) -(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))