;;; 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 <larsi@gnus.org>
;; Keywords: news
;;; 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)
to innd, you could say something like:
\(setq nntp-server-action-alist
- '((\"innd\" (ding))))
+ \\='((\"innd\" (ding))))
You probably don't want to do that, though.")
(defvar nntp-async-process-list nil)
(defvar nntp-authinfo-rejected nil
-"A custom error condition used to report 'Authentication Rejected' errors.
+"A custom error condition used to report `Authentication Rejected' errors.
Condition handlers that match just this condition ensure that the nntp
backend doesn't catch this error.")
(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
(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."
(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
`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.
(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)
(> 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)
(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))
(> 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)
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.
"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)
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))
projects / gnus / blobdiff