;;; 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 <larsi@gnus.org>
;; Keywords: news
;;; 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)
(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."
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.
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
(const :format "" "password")
(string :format "Password: %v")))))))
+(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1")
+
\f
(defvoo nntp-connection-timeout nil
"*Hook run just before posting an article. It is supposed to be used
to insert Cancel-Lock headers.")
+(defvoo nntp-server-list-active-group 'try
+ "If nil, then always use GROUP instead of LIST ACTIVE.
+This is usually slower, but on misconfigured servers that don't
+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.")
(defvoo nntp-inhibit-output nil)
(defvoo nntp-server-xover 'try)
-(defvoo nntp-server-list-active-group 'try)
(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
"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."
(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)))))
(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)
(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)))
(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.
(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
(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)
(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.
(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)
(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
"\r?\n\\.\r?\n" "BODY"
(if (numberp article) (int-to-string article) article))))
-(deffoo nntp-request-group (group &optional server dont-check)
+(deffoo nntp-request-group (group &optional server dont-check info)
(nntp-with-open-group
nil server
(when (nntp-send-command "^[245].*\n" "GROUP" group)
(unless (assq 'nntp-address defs)
(setq defs (append defs (list (list 'nntp-address server)))))
(nnoo-change-server 'nntp server defs)
- (unless connectionless
+ (if connectionless
+ t
(or (nntp-find-connection nntp-server-buffer)
(nntp-open-connection nntp-server-buffer)))))
(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-update-info (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.
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))
(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
(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)
(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)
`(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)
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)))
(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.
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))
(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.
(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)
;; 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).
(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))
(while (and (setq proc (get-buffer-process buf))
(memq (process-status proc) '(open run))
(not (re-search-forward regexp nil t)))
- (accept-process-output proc)
+ (accept-process-output proc 0.1)
(set-buffer buf)
(goto-char (point-min)))))
(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
projects / gnus / blobdiff