;;; nntp.el --- nntp access for Gnus
;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; 1997, 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
Direct connections:
- `nntp-open-network-stream' (the default),
- `nntp-open-ssl-stream',
+- `nntp-open-tls-stream',
- `nntp-open-telnet-stream'.
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'.
If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
\(\"-C\") in order to compress all data connections, otherwise set this
-to \(\"-t\") or (\"-C\" \"-t\") if the telnet command requires a pseudo-tty
-allocation on an intermediate host.")
+to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet
+command requires a pseudo-tty allocation on an intermediate host.")
(defvoo nntp-via-telnet-command "telnet"
"*Telnet command used to connect to an intermediate host.
(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.
This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
(defvoo nntp-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+ "*The number of articles which indicates a large newsgroup.
+If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status.")
(defvoo nntp-maximum-request 400
(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."
:type
"*Hook run just before posting an article. It is supposed to be used
to insert Cancel-Lock headers.")
-(defvoo nntp-read-timeout 0.1
- "How long nntp should wait between checking for the end of output.
-Shorter values mean quicker response, but is more CPU intensive.")
-
;;; Internal variables.
(defvar nntp-record-commands nil
(defvar nntp-async-timer nil)
(defvar nntp-async-process-list nil)
-(eval-and-compile
- (autoload 'mail-source-read-passwd "mail-source")
- (autoload 'open-ssl-stream "ssl"))
+(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.")
\f
(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.
(let ((timer
(and nntp-connection-timeout
- (nnheader-run-at-time
+ (run-at-time
nntp-connection-timeout nil
'(lambda ()
(let ((process (nntp-find-connection
(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.
(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 (and (not nntp-marks-is-evil) (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))
+ info)
+
+
+
;;; Hooky functions.
(defun nntp-send-mode-reader ()
(or passwd
nntp-authinfo-password
(setq nntp-authinfo-password
- (mail-source-read-passwd
- (format "NNTP (%s@%s) password: "
- user nntp-address))))))))))
+ (read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address))))))))))
(defun nntp-send-nosy-authinfo ()
"Send the AUTHINFO to the nntp server."
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
(when t ;???Should check if AUTHINFO succeeded
(nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (mail-source-read-passwd "NNTP (%s@%s) password: "
- user nntp-address))))))
+ (read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address)))))))
(defun nntp-send-authinfo-from-file ()
"Send the AUTHINFO to the nntp server.
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
"^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (progn (end-of-line) (point)))))))
+ (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)))))
(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")
+
(defun nntp-open-ssl-stream (buffer)
- (let ((proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number)))
+ (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)))))
+ (process-kill-without-query proc)
(save-excursion
(set-buffer buffer)
- (nntp-wait-for-string "^\r*20[01]")
+ (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)))
+ (process-kill-without-query proc)
+ (save-excursion
+ (set-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)))
;; 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 ()
(save-excursion
(set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
nntp-server-buffer))
- (let ((len (/ (point-max) 1024))
+ (let ((len (/ (buffer-size) 1024))
message-log-max)
(unless (< len 10)
(setq nntp-have-messaged t)
(nnheader-message 7 "nntp read: %dk" len)))
- (accept-process-output
- process
- (truncate nntp-read-timeout)
- (truncate (* (- nntp-read-timeout
- (truncate nntp-read-timeout))
- 1000)))
+ (nnheader-accept-process-output process)
;; accept-process-output may update status of process to indicate
;; that the server has closed the connection. This MUST be
;; handled here as the buffer restored by the save-excursion may
(when group
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (when (not (equal group (caddr entry)))
- (save-excursion
- (set-buffer (process-buffer (car entry)))
- (erase-buffer)
- (nntp-send-command "^[245].*\n" "GROUP" group)
- (setcar (cddr entry) group)
- (erase-buffer)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))))))
+ (cond ((not entry)
+ (nntp-report "Server closed connection"))
+ ((not (equal group (caddr entry)))
+ (save-excursion
+ (set-buffer (process-buffer (car entry)))
+ (erase-buffer)
+ (nntp-send-command "^[245].*\n" "GROUP" group)
+ (setcar (cddr entry) group)
+ (erase-buffer)
+ (nntp-erase-buffer nntp-server-buffer)))))))
(defun nntp-decode-text (&optional cr-only)
"Decode the text in the current buffer."
in-process-buffer-p
(buf nntp-server-buffer)
(process-buffer (nntp-find-connection-buffer nntp-server-buffer))
- first
- last)
+ first last status)
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
;; won't know that until we try.
(while (progn
(goto-char (or last-point (point-min)))
;; Count replies.
- (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
- (incf received))
+ (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
+ nil t)
+ (incf received)
+ (setq status (match-string 1))
+ (if (string-match "^[45]" status)
+ (setq status 'error)
+ (setq status 'ok)))
(setq last-point (point))
(or (< received count)
- ;; I haven't started reading the final response
- (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))))
+ (if (eq status 'error)
+ nil
+ ;; I haven't started reading the final response
+ (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n"))))))
;; I haven't read the end of the final response
(nntp-accept-response)
(set-buffer process-buffer))))
(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)
proc (concat
(or nntp-telnet-passwd
(setq nntp-telnet-passwd
- (mail-source-read-passwd "Password: ")))
+ (read-passwd "Password: ")))
"\n"))
(nntp-wait-for-string nntp-telnet-shell-prompt)
(process-send-string
(nntp-wait-for-string "^\r*20[01]")
(beginning-of-line)
(delete-region (point-min) (point))
- proc)))
+ (process-send-string proc "\^]")
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc "mode character\n")
+ (accept-process-output proc 1)
+ (sit-for 1)
+ (goto-char (point-min))
+ (forward-line 1)
+ (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.
(concat
(or nntp-via-user-password
(setq nntp-via-user-password
- (mail-source-read-passwd
- "Password: ")))
+ (read-passwd "Password: ")))
"\n"))
(nntp-wait-for-string nntp-via-shell-prompt)
(let ((real-telnet-command `("exec"
(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))))
+
+(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
+ (not (equal (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