;;; nntp.el --- nntp access for Gnus
-;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
+;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
+;; 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
;;; Commentary:
(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
+(require 'gnus)
(nnoo-declare nntp)
(eval-when-compile (require 'cl))
+(defgroup nntp nil
+ "NNTP access for Gnus."
+ :group 'gnus)
+
(defvoo nntp-address nil
"Address of the physical nntp server.")
Indirect connections:
- `nntp-open-via-rlogin-and-telnet',
+- `nntp-open-via-rlogin-and-netcat',
- `nntp-open-via-telnet-and-telnet'.")
(defvoo nntp-pre-command nil
(defvoo nntp-telnet-command "telnet"
"*Telnet command used to connect to the nntp server.
-This command is used by the various nntp-open-via-* methods.")
+This command is used by the methods `nntp-open-telnet-stream',
+`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.")
(defvoo nntp-telnet-switches '("-8")
"*Switches given to the telnet command `nntp-telnet-command'.")
(defvoo nntp-end-of-line "\r\n"
"*String to use on the end of lines when talking to the NNTP server.
-This is \"\\r\\n\" by default, but should be \"\\n\" when
-using and indirect connection method (nntp-open-via-*).")
+This is \"\\r\\n\" by default, but should be \"\\n\" when using and
+indirect telnet connection method (nntp-open-via-*-and-telnet).")
(defvoo nntp-via-rlogin-command "rsh"
"*Rlogin command used to connect to an intermediate host.
-This command is used by the `nntp-open-via-rlogin-and-telnet' method.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
+This command is used by the methods `nntp-open-via-rlogin-and-telnet'
+and `nntp-open-via-rlogin-and-netcat'. The default is \"rsh\", but \"ssh\"
+is a popular alternative.")
(defvoo nntp-via-rlogin-command-switches nil
"*Switches given to the rlogin command `nntp-via-rlogin-command'.
(defvoo nntp-via-telnet-switches '("-8")
"*Switches given to the telnet command `nntp-via-telnet-command'.")
+(defvoo nntp-via-netcat-command "nc"
+ "*Netcat command used to connect to the nntp server.
+This command is used by the `nntp-open-via-rlogin-and-netcat' method.")
+
+(defvoo nntp-via-netcat-switches nil
+ "*Switches given to the netcat command `nntp-via-netcat-command'.")
+
(defvoo nntp-via-user-name nil
"*User name to log in on an intermediate host with.
-This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
+This variable is used by the various nntp-open-via-* methods.")
(defvoo nntp-via-user-password nil
"*Password to use to log in on an intermediate host with.
(defvoo nntp-via-address nil
"*Address of an intermediate host to connect to.
-This variable is used by the `nntp-open-via-rlogin-and-telnet' and
-`nntp-open-via-telnet-and-telnet' methods.")
+This variable is used by the various nntp-open-via-* methods.")
(defvoo nntp-via-envuser nil
"*Whether both telnet client and server support the ENVIRON option.
server there that you can connect to. See also
`nntp-open-connection-function'")
-(defvoo nntp-warn-about-losing-connection t
- "*If non-nil, beep when a server closes connection.")
-
(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 'gnus
+ :type 'directory)
+
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
+ :group 'nntp
:type
'(choice file
(repeat :tag "Entries"
(defvar nntp-async-timer nil)
(defvar nntp-async-process-list nil)
-(defvar nntp-ssl-program
+(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
(kill-buffer buffer)
(nnheader-init-server-buffer)))
+(defun nntp-erase-buffer (buffer)
+ "Erase contents of BUFFER."
+ (with-current-buffer buffer
+ (erase-buffer)))
+
(defsubst nntp-find-connection (buffer)
"Find the connection delivering to BUFFER."
(let ((alist nntp-connection-alist)
(if process
(progn
(unless (or nntp-inhibit-erase nnheader-callback-function)
- (save-excursion
- (set-buffer (process-buffer process))
- (erase-buffer)))
+ (nntp-erase-buffer (process-buffer process)))
(condition-case err
(progn
(when command
"Send STRINGS to server and wait until WAIT-FOR returns."
(when (and (not nnheader-callback-function)
(not nntp-inhibit-output))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))
+ (nntp-erase-buffer nntp-server-buffer))
(let* ((command (mapconcat 'identity strings " "))
(process (nntp-find-connection nntp-server-buffer))
(buffer (and process (process-buffer process)))
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
- (gnus-point-at-bol))))
+ (point-at-bol))))
)))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
- (gnus-point-at-bol)))))))
+ (point-at-bol)))))))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
"Send STRINGS to server and wait until WAIT-FOR returns."
(when (and (not nnheader-callback-function)
(not nntp-inhibit-output))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))
+ (nntp-erase-buffer nntp-server-buffer))
(let* ((command (mapconcat 'identity strings " "))
(process (nntp-find-connection nntp-server-buffer))
(buffer (and process (process-buffer process)))
(unless wait-for
(nntp-accept-response)
(save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
- )))
+ (set-buffer buffer)
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1) (point-at-bol))))
+ )))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
"Send the current buffer to server and wait until WAIT-FOR returns."
(when (and (not nnheader-callback-function)
(not nntp-inhibit-output))
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)))
+ (nntp-erase-buffer
+ (nntp-find-connection-buffer nntp-server-buffer)))
(nntp-encode-text)
(mm-with-unibyte-current-buffer
;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
;; a line with only a "." on it.
((eq (char-after) ?2)
(if (re-search-forward "\n\\.\r?\n" nil t)
- t
+ (progn
+ ;; Some broken news servers add another dot at the end.
+ ;; Protect against inflooping there.
+ (while (looking-at "^\\.\r?\n")
+ (forward-line 1))
+ t)
nil))
;; A result that starts with a 3xx or 4xx code is terminated
;; by a newline.
(let ((timer
(and nntp-connection-timeout
- (nnheader-run-at-time
+ (run-at-time
nntp-connection-timeout nil
'(lambda ()
(let ((process (nntp-find-connection
(condition-case nil
(progn ,@forms)
(quit
- (nntp-close-server)
+ (unless debug-on-quit
+ (nntp-close-server))
(signal 'quit nil))))
(when timer
(nnheader-cancel-timer timer)))
(catch 'done
(save-excursion
;; Erase nntp-server-buffer before nntp-inhibit-erase.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
+ (nntp-erase-buffer nntp-server-buffer)
(set-buffer (nntp-find-connection-buffer nntp-server-buffer))
;; The first time this is run, this variable is `try'. So we
;; try.
(if (numberp article) (int-to-string article) article))))
(deffoo nntp-request-group (group &optional server dont-check)
- (nntp-with-open-group
+ (nntp-with-open-group
nil server
(when (nntp-send-command "^[245].*\n" "GROUP" group)
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(deffoo nntp-asynchronous-p ()
t)
+(deffoo nntp-request-set-mark (group actions &optional server)
+ (unless nntp-marks-is-evil
+ (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)
+ (unless nntp-marks-is-evil
+ (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.
(defun nntp-send-mode-reader ()
If SEND-IF-FORCE, only send authinfo to the server if the
.authinfo file has the FORCE token."
- (let* ((list (gnus-parse-netrc nntp-authinfo-file))
- (alist (gnus-netrc-machine list nntp-address "nntp"))
- (force (gnus-netrc-get alist "force"))
- (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
- (passwd (gnus-netrc-get alist "password")))
+ (let* ((list (netrc-parse nntp-authinfo-file))
+ (alist (netrc-machine list nntp-address "nntp"))
+ (force (netrc-get alist "force"))
+ (user (or (netrc-get alist "login") nntp-authinfo-user))
+ (passwd (netrc-get alist "password")))
(when (or (not send-if-force)
force)
(unless user
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
"^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (gnus-point-at-eol))))))
+ (buffer-substring (point) (point-at-eol))))))
;;; Internal functions.
(funcall nntp-authinfo-function)
;; We have to re-send the function that was interrupted by
;; the authinfo request.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
+ (nntp-erase-buffer nntp-server-buffer)
(nntp-send-string process last)))
(defun nntp-make-process-buffer (buffer)
(let* ((pbuffer (nntp-make-process-buffer buffer))
(timer
(and nntp-connection-timeout
- (nnheader-run-at-time
+ (run-at-time
nntp-connection-timeout nil
`(lambda ()
(nntp-kill-buffer ,pbuffer)))))
(nntp-kill-buffer pbuffer))
(when (and (buffer-name pbuffer)
process)
- (process-kill-without-query process)
+ (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)))
(prog1
(defun nntp-open-network-stream (buffer)
(open-network-stream "nntpd" buffer nntp-address nntp-port-number))
-(autoload 'format-spec "format")
-(autoload 'format-spec-make "format")
-(autoload 'open-tls-stream "tls")
+(eval-and-compile
+ (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
+ (proc (start-process "nntpd" buffer
shell-file-name
shell-command-switch
- (format-spec nntp-ssl-program
+ (format-spec nntp-ssl-program
(format-spec-make
?s nntp-address
?p nntp-port-number)))))
- (process-kill-without-query proc)
+ (gnus-set-process-query-on-exit-flag proc nil)
(save-excursion
(set-buffer buffer)
(let ((nntp-connection-alist (list proc buffer nil)))
(defun nntp-open-tls-stream (buffer)
(let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
- (process-kill-without-query proc)
+ (gnus-set-process-query-on-exit-flag proc nil)
(save-excursion
(set-buffer buffer)
(let ((nntp-connection-alist (list proc buffer nil)))
"Find out what the name of the server we have connected to is."
;; Wait for the status string to arrive.
(setq nntp-server-type (buffer-string))
- (let ((alist nntp-server-action-alist)
- (case-fold-search t)
- entry)
+ (let ((case-fold-search t))
;; Run server-specific commands.
- (while alist
- (setq entry (pop alist))
+ (dolist (entry nntp-server-action-alist)
(when (string-match (car entry) nntp-server-type)
(if (and (listp (cadr entry))
(not (eq 'lambda (caadr entry))))
;; doesn't trigger after-change-functions.
(unless nntp-async-timer
(setq nntp-async-timer
- (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
+ (run-at-time 1 1 'nntp-async-timer-handler)))
(add-to-list 'nntp-async-process-list process))
(defun nntp-async-timer-handler ()
;; that the server has closed the connection. This MUST be
;; handled here as the buffer restored by the save-excursion may
;; be the process's former output buffer (i.e. now killed)
- (or (and process
+ (or (and process
(memq (process-status process) '(open run)))
(nntp-report "Server closed connection"))))
(nntp-send-command "^[245].*\n" "GROUP" group)
(setcar (cddr entry) group)
(erase-buffer)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))))))))
+ (nntp-erase-buffer nntp-server-buffer)))))))
(defun nntp-decode-text (&optional cr-only)
"Decode the text in the current buffer."
(when (<= count 1)
(goto-char (point-min))
(when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
- (let ((low-limit (string-to-int
- (buffer-substring (match-beginning 1)
+ (let ((low-limit (string-to-number
+ (buffer-substring (match-beginning 1)
(match-end 1)))))
(while (and articles (<= (car articles) low-limit))
(setq articles (cdr articles))))))
(setq commands (cdr commands)))
;; If none of the commands worked, we disable XOVER.
(when (eq nntp-server-xover 'try)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq nntp-server-xover nil)))
+ (nntp-erase-buffer nntp-server-buffer)
+ (setq nntp-server-xover nil))
nntp-server-xover))))
(defun nntp-find-group-and-number (&optional group)
(goto-char (point-min))
;; We first find the number by looking at the status line.
(let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
- (string-to-int
+ (string-to-number
(buffer-substring (match-beginning 1)
(match-end 1)))))
newsgroups xref)
"\\([^ :]+\\):\\([0-9]+\\)")
xref))
(setq group (match-string 1 xref)
- number (string-to-int (match-string 2 xref))))
+ number (string-to-number (match-string 2 xref))))
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
(not (string-match "," newsgroups)))
(delete-region (point) (point-max)))
proc))
+(defun nntp-open-via-rlogin-and-netcat (buffer)
+ "Open a connection to an nntp server through an intermediate host.
+First rlogin to the remote host, and then connect to the real news
+server from there using the netcat command.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-rlogin-command',
+- `nntp-via-rlogin-command-switches',
+- `nntp-via-user-name',
+- `nntp-via-address',
+- `nntp-via-netcat-command',
+- `nntp-via-netcat-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+ (let ((command `(,@(when nntp-pre-command
+ (list nntp-pre-command))
+ ,nntp-via-rlogin-command
+ ,@(when nntp-via-rlogin-command-switches
+ nntp-via-rlogin-command-switches)
+ ,@(when nntp-via-user-name
+ (list "-l" nntp-via-user-name))
+ ,nntp-via-address
+ ,nntp-via-netcat-command
+ ,@nntp-via-netcat-switches
+ ,nntp-address
+ ,nntp-port-number)))
+ (apply 'start-process "nntpd" buffer command)))
+
(defun nntp-open-via-telnet-and-telnet (buffer)
"Open a connection to an nntp server through an intermediate host.
First telnet the remote host, and then telnet the real news server
(delete-region (point) (point-max)))
proc)))
+;; Marks handling
+
+(defun nntp-marks-directory (server)
+ (expand-file-name server nntp-marks-directory))
+
+(defun nntp-possibly-create-directory (group server)
+ (let ((dir (nnmail-group-pathname
+ group (nntp-marks-directory server))))
+ (unless (file-exists-p dir)
+ (make-directory (directory-file-name dir) t)
+ (nnheader-message 5 "Creating nntp marks directory %s" dir))))
+
+(eval-and-compile
+ (autoload 'time-less-p "time-date"))
+
+(defun nntp-marks-changed-p (group server)
+ (let ((file (expand-file-name
+ nntp-marks-file-name
+ (nnmail-group-pathname
+ group (nntp-marks-directory server)))))
+ (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 (expand-file-name
+ nntp-marks-file-name
+ (nnmail-group-pathname
+ group (nntp-marks-directory server)))))
+ (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 (expand-file-name
+ nntp-marks-file-name
+ (nnmail-group-pathname
+ group (nntp-marks-directory server)))))
+ (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))))))
+ (nnheader-message 7 "Bootstrapping marks for %s..." group)
+ (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" group)))))
+
(provide 'nntp)
+;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
;;; nntp.el ends here
projects / gnus / blobdiff