X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnntp.el;h=be5d1e6ff4cb5cdab7115204eeac8fded53ead16;hp=ced15a92838d5590df5da7dd0367a0a78ed7e67f;hb=992509a3574f9add376cc480db9bb5656285bd5b;hpb=38f708ac094dfe6db348f1eda1b056e25df1253e diff --git a/lisp/nntp.el b/lisp/nntp.el index ced15a928..be5d1e6ff 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,8 +1,7 @@ ;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, -;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990, 1992-1998, 2000-2012 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,9 +25,13 @@ ;;; Code: -;; For Emacs < 22.2. +;; For Emacs <22.2 and XEmacs. (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (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) + (require 'proto-stream))) (require 'nnheader) (require 'nnoo) @@ -40,7 +43,7 @@ (eval-when-compile (require 'cl)) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (defgroup nntp nil "NNTP access for Gnus." @@ -76,25 +79,27 @@ to innd, you could say something like: You probably don't want to do that, though.") (defvoo nntp-open-connection-function 'nntp-open-network-stream - "*Function used for connecting to a remote system. -It will be called with the buffer to output in as argument. - -Currently, five such functions are provided (please refer to their -respective doc string for more information), three of them establishing -direct connections to the nntp server, and two of them using an indirect -host. - -Direct connections: -- `nntp-open-network-stream' (the default), -- `nntp-open-ssl-stream', -- `nntp-open-tls-stream', -- `nntp-open-netcat-stream'. -- `nntp-open-telnet-stream'. - -Indirect connections: -- `nntp-open-via-rlogin-and-netcat', -- `nntp-open-via-rlogin-and-telnet', -- `nntp-open-via-telnet-and-telnet'.") + "Method for connecting to a remote system. +It should be a function, which is called with the output buffer +as its single argument, or one of the following special values: + +- `nntp-open-network-stream' specifies a network connection, + upgrading to a TLS connection via STARTTLS if possible. +- `nntp-open-plain-stream' specifies an unencrypted network + connection (no STARTTLS upgrade is attempted). +- `nntp-open-ssl-stream' or `nntp-open-tls-stream' specify a TLS + network connection. + +Apart from the above special values, valid functions are as +follows; please refer to their respective doc string for more +information. +For direct connections: +- `nntp-open-netcat-stream' +- `nntp-open-telnet-stream' +For indirect connections: +- `nntp-open-via-rlogin-and-netcat' +- `nntp-open-via-rlogin-and-telnet' +- `nntp-open-via-telnet-and-telnet'") (defvoo nntp-never-echoes-commands nil "*Non-nil means the nntp server never echoes commands. @@ -217,27 +222,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to. See also `nntp-open-connection-function'") -(defvoo nntp-coding-system-for-read 'binary - "*Coding system to read from NNTP.") - -(defvoo nntp-coding-system-for-write 'binary - "*Coding system to write to NNTP.") - -;; Marks -(defvoo nntp-marks-is-evil nil - "*If non-nil, Gnus will never generate and use marks file for nntp groups. -See `nnml-marks-is-evil' for more information.") - -(defvoo nntp-marks-file-name ".marks") -(defvoo nntp-marks nil) -(defvar nntp-marks-modtime (gnus-make-hashtable)) - -(defcustom nntp-marks-directory - (nnheader-concat gnus-directory "marks/") - "*The directory where marks for nntp groups will be stored." - :group 'nntp - :type 'directory) - (defcustom nntp-authinfo-file "~/.authinfo" ".netrc-like file that holds nntp authinfo passwords." :group 'nntp @@ -256,6 +240,8 @@ See `nnml-marks-is-evil' for more information.") (const :format "" "password") (string :format "Password: %v"))))))) +(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1") + (defvoo nntp-connection-timeout nil @@ -274,6 +260,7 @@ update their active files often, this can help.") ;;; Internal variables. +(defvoo nntp-retrieval-in-progress nil) (defvar nntp-record-commands nil "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.") @@ -305,13 +292,6 @@ update their active files often, this can help.") (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) -(defvar nntp-ssl-program - "openssl s_client -quiet -ssl3 -connect %s:%p" -"A string containing commands for SSL connections. -Within a string, %s is replaced with the server address and %p with -port number on server. The program should accept IMAP commands on -stdin and return responses to stdout.") - (defvar nntp-authinfo-rejected nil "A custom error condition used to report 'Authentication Rejected' errors. Condition handlers that match just this condition ensure that the nntp @@ -340,44 +320,29 @@ backend doesn't catch this error.") "Record the command STRING." (with-current-buffer (get-buffer-create "*nntp-log*") (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")))) + (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)) + (nnheader-report 'nntp 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 ***")) - - (throw 'nntp-with-open-group-error t)) - -(defmacro nntp-insert-buffer-substring (buffer &optional start end) - "Copy string from unibyte buffer to multibyte current buffer." - (if (featurep 'xemacs) - `(insert-buffer-substring ,buffer ,start ,end) - `(if enable-multibyte-characters - (insert (with-current-buffer ,buffer - (mm-string-to-multibyte - ,(if (or start end) - `(buffer-substring (or ,start (point-min)) - (or ,end (point-max))) - '(buffer-string))))) - (insert-buffer-substring ,buffer ,start ,end)))) + (apply 'error args))) (defmacro nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." @@ -404,7 +369,8 @@ be restored and the command retried." (cond ((looking-at "480") (nntp-handle-authinfo process)) ((looking-at "482") - (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message)) + (nnheader-report 'nntp "%s" + (get 'nntp-authinfo-rejected 'error-message)) (signal 'nntp-authinfo-rejected nil)) ((looking-at "^.*\n") (delete-region (point) (progn (forward-line 1) (point))))) @@ -435,7 +401,7 @@ be restored and the command retried." (unless discard (with-current-buffer buffer (goto-char (point-max)) - (nntp-insert-buffer-substring (process-buffer process)) + (nnheader-insert-buffer-substring (process-buffer process)) ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) @@ -446,6 +412,9 @@ be restored and the command retried." (defun nntp-kill-buffer (buffer) (when (buffer-name buffer) + (let ((process (get-buffer-process buffer))) + (when process + (delete-process process))) (kill-buffer buffer) (nnheader-init-server-buffer))) @@ -643,10 +612,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 @@ -657,9 +622,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. @@ -676,7 +641,7 @@ command whose response triggered the error." (process-buffer -process)))) ;; When I an able to identify the ;; connection to the server AND I've - ;; received NO reponse for + ;; received NO response for ;; nntp-connection-timeout seconds. (when (and -buffer (eq 0 (buffer-size -buffer))) ;; Close the connection. Take no @@ -695,7 +660,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) @@ -778,11 +743,98 @@ command whose response triggered the error." (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'headers))))) +(deffoo nntp-retrieve-group-data-early (server infos) + "Retrieve group info on INFOS." + (nntp-with-open-group nil server + (let ((buffer (nntp-find-connection-buffer nntp-server-buffer))) + (unless infos + (with-current-buffer buffer + (setq nntp-retrieval-in-progress nil))) + (when (and buffer + infos + (with-current-buffer buffer + (not nntp-retrieval-in-progress))) + ;; 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 + (gnus-group-real-name (gnus-info-group (car infos))))) + (with-current-buffer buffer + (erase-buffer) + ;; Mark this buffer as "in use" in case we try to issue two + ;; retrievals from the same server. This shouldn't happen, + ;; so this is mostly a sanity check. + (setq nntp-retrieval-in-progress t) + (let ((nntp-inhibit-erase t) + (command (if nntp-server-list-active-group + "LIST ACTIVE" "GROUP"))) + (dolist (info infos) + (nntp-send-command + nil command (gnus-group-real-name (gnus-info-group info))))) + (length infos)))))) + +(deffoo nntp-finish-retrieve-group-infos (server infos count) + (nntp-with-open-group nil server + (let ((buf (nntp-find-connection-buffer nntp-server-buffer)) + (method (gnus-find-method-for-group + (gnus-info-group (car infos)) + (car infos))) + (received 0) + (last-point 1)) + (with-current-buffer buf + (setq nntp-retrieval-in-progress nil)) + (when (and buf + count) + (with-current-buffer buf + (while (and (gnus-buffer-live-p buf) + (progn + (goto-char last-point) + ;; Count replies. + (while (re-search-forward + (if nntp-server-list-active-group + "^[.]" + "^[0-9]") + nil t) + (incf received)) + (setq last-point (point)) + (< received count))) + (nntp-accept-response)) + ;; We now have all the entries. Remove CRs. + (nnheader-strip-cr) + (if (not nntp-server-list-active-group) + (progn + (nntp-copy-to-buffer nntp-server-buffer + (point-min) (point-max)) + (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)) + (while (re-search-forward "^[.2-5]" nil t) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point)))) + (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (with-current-buffer nntp-server-buffer + (gnus-active-to-gnus-format + ;; Kludge to use the extended method name if you have + ;; an extended one. + (if (consp (gnus-info-method (car infos))) + (gnus-info-method (car infos)) + method) + gnus-active-hashtb nil t)))))))) + (deffoo nntp-retrieve-groups (groups &optional server) "Retrieve group info on GROUPS." (nntp-with-open-group nil server - (when (nntp-find-connection-buffer nntp-server-buffer) + (when (and (nntp-find-connection-buffer nntp-server-buffer) + (with-current-buffer + (nntp-find-connection-buffer nntp-server-buffer) + (if (not nntp-retrieval-in-progress) + t + (message "Warning: Refusing to do retrieval from %s because a retrieval is already happening" + server) + nil))) (catch 'done (save-excursion ;; Erase nntp-server-buffer before nntp-inhibit-erase. @@ -931,7 +983,7 @@ command whose response triggered the error." (narrow-to-region (setq point (goto-char (point-max))) (progn - (nntp-insert-buffer-substring buf last-point (cdr entry)) + (nnheader-insert-buffer-substring buf last-point (cdr entry)) (point-max))) (setq last-point (cdr entry)) (nntp-decode-text) @@ -963,16 +1015,15 @@ command whose response triggered the error." (deffoo nntp-request-article (article &optional group server buffer command) (nntp-with-open-group - group server + group server (when (nntp-send-command-and-decode "\r?\n\\.\r?\n" "ARTICLE" (if (numberp article) (int-to-string article) article)) - (if (and buffer - (not (equal buffer nntp-server-buffer))) - (with-current-buffer nntp-server-buffer - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number group)) - (nntp-find-group-and-number group))))) + (when (and buffer + (not (equal buffer nntp-server-buffer))) + (with-current-buffer nntp-server-buffer + (copy-to-buffer buffer (point-min) (point-max)))) + (nntp-find-group-and-number group)))) (deffoo nntp-request-head (article &optional group server) (nntp-with-open-group @@ -1113,55 +1164,6 @@ command whose response triggered the error." (deffoo nntp-asynchronous-p () t) -(deffoo nntp-request-set-mark (group actions &optional server) - (when (and (not nntp-marks-is-evil) - nntp-marks-file-name) - (nntp-possibly-create-directory group server) - (nntp-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nntp-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nntp-marks)) range) - nntp-marks))))) - (nntp-save-marks group server)) - nil) - -(deffoo nntp-request-marks (group info &optional server) - (when (and (not nntp-marks-is-evil) - nntp-marks-file-name) - (nntp-possibly-create-directory group server) - (when (nntp-marks-changed-p group server) - (nnheader-message 8 "Updating marks for %s..." group) - (nntp-open-marks group server) - ;; Update info using `nntp-marks'. - (mapc (lambda (pred) - (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nntp-marks)) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - (let ((seen (cdr (assq 'read nntp-marks)))) - (gnus-info-set-read info - (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen))) - (nnheader-message 8 "Updating marks for %s...done" group))) - nil) - - ;;; Hooky functions. @@ -1172,7 +1174,7 @@ It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\n" "MODE READER")) -(declare-function netrc-parse "netrc" (file)) +(declare-function netrc-parse "netrc" (&optional file)) (declare-function netrc-machine "netrc" (list machine &optional port defaultport)) (declare-function netrc-get "netrc" (alist type)) @@ -1188,11 +1190,21 @@ If SEND-IF-FORCE, only send authinfo to the server if the (require 'netrc) (let* ((list (netrc-parse nntp-authinfo-file)) (alist (netrc-machine list nntp-address "nntp")) - (force (or (netrc-get alist "force") nntp-authinfo-force)) - (auth-info - (auth-source-user-or-password '("login" "password") nntp-address "nntp")) - (auth-user (nth 0 auth-info)) - (auth-passwd (nth 1 auth-info)) + (auth-info + (nth 0 (auth-source-search + :max 1 + :host (list nntp-address (nnoo-current-server 'nntp)) + :port `("119" "nntp" ,(format "%s" nntp-port-number) + "563" "nntps" "snews")))) + (auth-user (plist-get auth-info :user)) + (auth-force (plist-get auth-info :force)) + (auth-passwd (plist-get auth-info :secret)) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) + (force (or (netrc-get alist "force") + nntp-authinfo-force + auth-force)) (user (or ;; this is preferred to netrc-* auth-user @@ -1218,30 +1230,6 @@ If SEND-IF-FORCE, only send authinfo to the server if the (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)))))) - ;;; Internal functions. (defun nntp-handle-authinfo (process) @@ -1267,6 +1255,7 @@ password contained in '~/.nntp-authinfo'." (set (make-local-variable 'nntp-process-to-buffer) nil) (set (make-local-variable 'nntp-process-start-point) nil) (set (make-local-variable 'nntp-process-decode) nil) + (set (make-local-variable 'nntp-retrieval-in-progress) nil) (current-buffer))) (defun nntp-open-connection (buffer) @@ -1280,11 +1269,29 @@ password contained in '~/.nntp-authinfo'." `(lambda () (nntp-kill-buffer ,pbuffer))))) (process - (condition-case () - (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) + (condition-case err + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (map '((nntp-open-network-stream network) + (network-only plain) ; compat + (nntp-open-plain-stream plain) + (nntp-open-ssl-stream tls) + (nntp-open-tls-stream tls)))) + (if (assoc nntp-open-connection-function map) + (open-protocol-stream + "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" + :success "^3" + :starttls-function + (lambda (capabilities) + (if (not (string-match "STARTTLS" capabilities)) + nil + "STARTTLS\r\n"))) + (funcall nntp-open-connection-function pbuffer))) + (error + (nnheader-report 'nntp ">>> %s" err)) (quit (message "Quit opening connection to %s" nntp-address) (nntp-kill-buffer pbuffer) @@ -1292,10 +1299,23 @@ password contained in '~/.nntp-authinfo'." nil)))) (when timer (nnheader-cancel-timer timer)) + (when (and process + (not (memq (process-status process) '(open run)))) + (with-current-buffer pbuffer + (goto-char (point-min)) + (nnheader-report 'nntp "Error when connecting: %s" + (buffer-substring (point) (line-end-position)))) + (setq process nil)) (unless process (nntp-kill-buffer pbuffer)) (when (and (buffer-name pbuffer) process) + (when (and (fboundp 'set-network-process-option) ;; Unavailable in XEmacs. + (fboundp 'process-type) ;; Emacs 22 doesn't provide it. + (eq (process-type process) 'network)) + ;; Use TCP-keepalive so that connections that pass through a NAT router + ;; don't hang when left idle. + (set-network-process-option process :keepalive t)) (gnus-set-process-query-on-exit-flag process nil) (if (and (nntp-wait-for process "^2.*\n" buffer nil t) (memq (process-status process) '(open run))) @@ -1312,40 +1332,6 @@ password contained in '~/.nntp-authinfo'." (nntp-kill-buffer (process-buffer process)) nil)))) -(defun nntp-open-network-stream (buffer) - (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) - -(autoload 'format-spec "format-spec") -(autoload 'format-spec-make "format-spec") -(autoload 'open-tls-stream "tls") - -(defun nntp-open-ssl-stream (buffer) - (let* ((process-connection-type nil) - (proc (start-process "nntpd" buffer - shell-file-name - shell-command-switch - (format-spec nntp-ssl-program - (format-spec-make - ?s nntp-address - ?p nntp-port-number))))) - (gnus-set-process-query-on-exit-flag proc nil) - (with-current-buffer buffer - (let ((nntp-connection-alist (list proc buffer nil))) - (nntp-wait-for-string "^\r*20[01]")) - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - -(defun nntp-open-tls-stream (buffer) - (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number))) - (gnus-set-process-query-on-exit-flag proc nil) - (with-current-buffer buffer - (let ((nntp-connection-alist (list proc buffer nil))) - (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. @@ -1370,14 +1356,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)) @@ -1427,7 +1405,7 @@ password contained in '~/.nntp-authinfo'." (goto-char (point-max)) (save-restriction (narrow-to-region (point) (point)) - (nntp-insert-buffer-substring buf start) + (nnheader-insert-buffer-substring buf start) (when decode (nntp-decode-text)))))) ;; report it. @@ -1446,7 +1424,7 @@ password contained in '~/.nntp-authinfo'." (let ((message (buffer-string))) (while (string-match "[\r\n]+" message) (setq message (replace-match " " t t message))) - (nnheader-report 'nntp message) + (nnheader-report 'nntp "%s" message) message)) (defun nntp-accept-process-output (process) @@ -1632,12 +1610,12 @@ password contained in '~/.nntp-authinfo'." ;; Some nntp servers seem to have an extension to the XOVER ;; extension. On these servers, requesting an article range - ;; preceeding the active range does not return an error as + ;; preceding the active range does not return an error as ;; specified in the RFC. What we instead get is the NOV entry ;; for the first available article. Obviously, a client can ;; use that entry to avoid making unnecessary requests. The ;; only problem is for a client that assumes that the response - ;; will always be within the requested ranage. For such a + ;; will always be within the requested range. For such a ;; client, we can get N copies of the same entry (one for each ;; XOVER command sent to the server). @@ -1655,7 +1633,7 @@ password contained in '~/.nntp-authinfo'." (when in-process-buffer-p (set-buffer buf) (goto-char (point-max)) - (nntp-insert-buffer-substring process-buffer) + (nnheader-insert-buffer-substring process-buffer) (set-buffer process-buffer) (erase-buffer) (set-buffer buf)) @@ -2094,95 +2072,6 @@ Please refer to the following variables to customize the connection: (delete-region (point) (point-max))) proc))) -;; Marks handling - -(defun nntp-marks-directory (server) - (expand-file-name server nntp-marks-directory)) - -(defvar nntp-server-to-method-cache nil - "Alist of servers and select methods.") - -(defun nntp-group-pathname (server group &optional file) - "Return an absolute file name of FILE for GROUP on SERVER." - (let ((method (cdr (assoc server nntp-server-to-method-cache)))) - (unless method - (push (cons server (setq method (or (gnus-server-to-method server) - (gnus-find-method-for-group group)))) - nntp-server-to-method-cache)) - (nnmail-group-pathname - (mm-decode-coding-string group - (inline (gnus-group-name-charset method group))) - (nntp-marks-directory server) - file))) - -(defun nntp-possibly-create-directory (group server) - (let ((dir (nntp-group-pathname server group)) - (file-name-coding-system nnmail-pathname-coding-system)) - (unless (file-exists-p dir) - (make-directory (directory-file-name dir) t) - (nnheader-message 5 "Creating nntp marks directory %s" dir)))) - -(autoload 'time-less-p "time-date") - -(defun nntp-marks-changed-p (group server) - (let ((file (nntp-group-pathname server group nntp-marks-file-name)) - (file-name-coding-system nnmail-pathname-coding-system)) - (if (null (gnus-gethash file nntp-marks-modtime)) - t ;; never looked at marks file, assume it has changed - (time-less-p (gnus-gethash file nntp-marks-modtime) - (nth 5 (file-attributes file)))))) - -(defun nntp-save-marks (group server) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (nntp-group-pathname server group nntp-marks-file-name))) - (condition-case err - (progn - (nntp-possibly-create-directory group server) - (with-temp-file file - (erase-buffer) - (gnus-prin1 nntp-marks) - (insert "\n")) - (gnus-sethash file - (nth 5 (file-attributes file)) - nntp-marks-modtime)) - (error (or (gnus-yes-or-no-p - (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" file err)))))) - -(defun nntp-open-marks (group server) - (let ((file (nntp-group-pathname server group nntp-marks-file-name)) - (file-name-coding-system nnmail-pathname-coding-system)) - (if (file-exists-p file) - (condition-case err - (with-temp-buffer - (gnus-sethash file (nth 5 (file-attributes file)) - nntp-marks-modtime) - (nnheader-insert-file-contents file) - (setq nntp-marks (read (current-buffer))) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nntp-marks (gnus-remassoc el nntp-marks)))) - (error (or (gnus-yes-or-no-p - (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nntp marks file %s (%s)" file err)))) - ;; User didn't have a .marks file. Probably first time - ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. - (let ((info (gnus-get-info - (gnus-group-prefixed-name - group - (gnus-server-to-method (format "nntp:%s" server))))) - (decoded-name (mm-decode-coding-string - group - (gnus-group-name-charset - (gnus-server-to-method server) group)))) - (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name) - (setq nntp-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nntp-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nntp-marks (gnus-remassoc el nntp-marks))) - (nntp-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" - decoded-name))))) - (provide 'nntp) ;;; nntp.el ends here