;;; nntp.el --- nntp access for Gnus
;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
"*Hook used for sending commands to the server at startup.
The default value is `nntp-send-mode-reader', which makes an innd
-server spawn an nnrpd server. Another useful function to put in this
-hook might be `nntp-send-authinfo', which will prompt for a password
-to allow posting from the server. Note that this is only necessary to
-do on servers that use strict access control.")
+server spawn an nnrpd server.")
(defvoo nntp-authinfo-function 'nntp-send-authinfo
- "Function used to send AUTHINFO to the server.")
+ "Function used to send AUTHINFO to the server.
+It is called with no parameters.")
(defvoo nntp-server-action-alist
'(("nntpd 1\\.5\\.11t"
The default is \"rsh\", but \"ssh\" is a popular alternative.")
(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-login'.
+ "*Parameters to `nntp-open-rlogin'.
That function may be used as `nntp-open-connection-function'. In that
case, this list will be used as the parameter list given to rsh.")
If the gap between two consecutive articles is bigger than this
variable, split the XOVER request into two requests.")
-(defvoo nntp-connection-timeout nil
- "*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.")
-
(defvoo nntp-prepare-server-hook nil
"*Hook run before a server is opened.
If can be used to set up a server remotely, for instance. Say you
(defvoo nntp-coding-system-for-write 'binary
"*Coding system to write to NNTP.")
-(defvar nntp-netrc-file "~/.netrc"
- "*The location of the file containing authinfo information.")
+(defcustom nntp-authinfo-file "~/.authinfo"
+ ".netrc-like file that holds nntp authinfo passwords."
+ :type
+ '(choice file
+ (repeat :tag "Entries"
+ :menu-tag "Inline"
+ (list :format "%v"
+ :value ("" ("login" . "") ("password" . ""))
+ (string :tag "Host")
+ (checklist :inline t
+ (cons :format "%v"
+ (const :format "" "login")
+ (string :format "Login: %v"))
+ (cons :format "%v"
+ (const :format "" "password")
+ (string :format "Password: %v")))))))
\f
;;; Internal variables.
+(defvar nntp-record-commands nil
+ "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")
+
(defvar nntp-have-messaged nil)
(defvar nntp-process-wait-for nil)
(defvoo nntp-last-command-time nil)
(defvoo nntp-last-command nil)
(defvoo nntp-authinfo-password nil)
+(defvoo nntp-authinfo-user nil)
(defvar nntp-connection-list nil)
(defvoo nntp-server-list-active-group 'try)
(eval-and-compile
- (autoload 'nnmail-read-passwd "nnmail"))
+ (autoload 'nnmail-read-passwd "nnmail")
+ (autoload 'open-ssl-stream "ssl"))
\f
(defsubst nntp-send-string (process string)
"Send STRING to PROCESS."
+ ;; We need to store the time to provide timeouts, and
+ ;; to store the command so the we can replay the command
+ ;; if the server gives us an AUTHINFO challenge.
(setq nntp-last-command-time (current-time)
nntp-last-command string)
+ (when nntp-record-commands
+ (nntp-record-command string))
(process-send-string process (concat string nntp-end-of-line)))
+(defun nntp-record-command (string)
+ "Record the command STRING."
+ (save-excursion
+ (set-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"))))
+
(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
"Wait for WAIT-FOR to arrive from PROCESS."
(save-excursion
(set-buffer (process-buffer process))
(goto-char (point-min))
- (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
- (looking-at "480"))
+ (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
+ (looking-at "480"))
+ (memq (process-status process) '(open run)))
(when (looking-at "480")
(nntp-handle-authinfo process))
(nntp-accept-process-output process)
(goto-char (point-min)))
(prog1
- (if (looking-at "[45]")
- (progn
- (nntp-snarf-error-message)
- nil)
+ (cond
+ ((looking-at "[45]")
+ (progn
+ (nntp-snarf-error-message)
+ nil))
+ ((not (memq (process-status process) '(open run)))
+ (nnheader-report 'nntp "Server closed connection"))
+ (t
(goto-char (point-max))
(let ((limit (point-min)))
(while (not (re-search-backward wait-for limit t))
;; Nix out "nntp reading...." message.
(when nntp-have-messaged
(setq nntp-have-messaged nil)
- (message ""))
- t)))
+ (nnheader-message 5 ""))
+ t))))
(unless discard
(erase-buffer)))))
(nnoo-define-basics nntp)
(defsubst nntp-next-result-arrived-p ()
- (let ((point (point)))
- (cond
- ((eq (following-char) ?2)
- (if (re-search-forward "\n\\.\r?\n" nil t)
- t
- (goto-char point)
- nil))
- ((looking-at "[34]")
- (forward-line 1)
- t)
- (t
- nil))))
+ (cond
+ ;; A result that starts with a 2xx code is terminated by
+ ;; a line with only a "." on it.
+ ((eq (following-char) ?2)
+ (if (re-search-forward "\n\\.\r?\n" nil t)
+ t
+ nil))
+ ;; A result that startx with a 3xx or 4xx code is terminated
+ ;; by a newline.
+ ((looking-at "[34]")
+ (if (search-forward "\n" nil t)
+ t
+ nil))
+ ;; No result here.
+ (t
+ nil)))
(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
"Retrieve the headers of ARTICLES."
(deffoo nntp-close-server (&optional server)
(nntp-possibly-change-group nil server t)
- (let (process)
- (while (setq process (car (pop nntp-connection-alist)))
+ (let ((process (nntp-find-connection nntp-server-buffer)))
+ (while process
(when (memq (process-status process) '(open run))
- (set-process-sentinel process nil)
(ignore-errors
(nntp-send-string process "QUIT")
(unless (eq nntp-open-connection-function 'nntp-open-network-stream)
(sleep-for 1))))
(when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process))))
+ (kill-buffer (process-buffer process)))
+ (setq process (car (pop nntp-connection-alist))))
(nnoo-close-server 'nntp)))
(deffoo nntp-request-close ()
(let (process)
(while (setq process (pop nntp-connection-list))
(when (memq (process-status process) '(open run))
- (set-process-sentinel process nil)
(ignore-errors
(nntp-send-string process "QUIT")
(unless (eq nntp-open-connection-function 'nntp-open-network-stream)
(nntp-possibly-change-group nil server)
(save-excursion
(set-buffer nntp-server-buffer)
- (let* ((date (timezone-parse-date date))
- (time-string
- (format "%s%02d%02d %s%s%s"
- (substring (aref date 0) 2) (string-to-int (aref date 1))
- (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
- (substring
- (aref date 3) 3 5) (substring (aref date 3) 6 8))))
- (prog1
- (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
- (nntp-decode-text)))))
+ (prog1
+ (nntp-send-command
+ "^\\.\r?\n" "NEWGROUPS"
+ (format-time-string "%y%m%d %H%M%S" (nnmail-date-to-time date)))
+ (nntp-decode-text))))
(deffoo nntp-request-post (&optional server)
(nntp-possibly-change-group nil server)
reading."
(nntp-send-command "^.*\r?\n" "MODE READER"))
-(defun nntp-send-authinfo ()
+(defun nntp-send-authinfo (&optional send-if-force)
"Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will look in the \"~/.netrc\" file for matching entries. If
+It will look in the \"~/.authinfo\" file for matching entries. If
nothing suitable is found there, it will prompt for a user name
-and a password."
- (let* ((list (gnus-parse-netrc nntp-netrc-file))
+and a password.
+
+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))
- (user (gnus-netrc-get alist "login"))
+ (force (gnus-netrc-get alist "force"))
+ (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
(passwd (gnus-netrc-get alist "password")))
- (nntp-send-command
- "^3.*\r?\n" "AUTHINFO USER"
- (or user (read-string (format "NNTP (%s) user name: " nntp-address))))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (or passwd
- nntp-authinfo-password
- (setq nntp-authinfo-password
- (nnmail-read-passwd (format "NNTP (%s) password: "
- nntp-address)))))))
+ (when (or (not send-if-force)
+ force)
+ (unless user
+ (setq user (read-string (format "NNTP (%s) user name: " nntp-address))
+ nntp-authinfo-user user))
+ (unless (member user '(nil ""))
+ (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
+ (when t ;???Should check if AUTHINFO succeeded
+ (nntp-send-command
+ "^2.*\r?\n" "AUTHINFO PASS"
+ (or passwd
+ nntp-authinfo-password
+ (setq nntp-authinfo-password
+ (nnmail-read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address))))))))))
(defun nntp-send-nosy-authinfo ()
- "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
- (nntp-send-command
- "^3.*\r?\n" "AUTHINFO USER"
- (read-string (format "NNTP (%s) user name: " nntp-address)))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
+ "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"
+ (nnmail-read-passwd "NNTP (%s@%s) password: "
+ user nntp-address))))))
(defun nntp-send-authinfo-from-file ()
"Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
The authinfo login name is taken from the user's login name and the
password contained in '~/.nntp-authinfo'."
(generate-new-buffer
(format " *server %s %s %s*"
nntp-address nntp-port-number
- (buffer-name (get-buffer buffer)))))
+ (gnus-buffer-exists-p buffer))))
(buffer-disable-undo (current-buffer))
(set (make-local-variable 'after-change-functions) nil)
(set (make-local-variable 'nntp-process-wait-for) nil)
(defun nntp-open-connection (buffer)
"Open a connection to PORT on ADDRESS delivering output to BUFFER."
- (gnus-run-hooks 'nntp-prepare-server-hook)
+ (run-hooks 'nntp-prepare-server-hook)
(let* ((pbuffer (nntp-make-process-buffer buffer))
(process
(condition-case ()
- (let ((coding-system-for-read nntp-coding-system-for-read))
+ (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)
(quit nil))))
(erase-buffer)
(set-buffer nntp-server-buffer)
(let ((nnheader-callback-function nil))
- (gnus-run-hooks 'nntp-server-opened-hook))))
+ (run-hooks 'nntp-server-opened-hook)
+ (nntp-send-authinfo t))))
(when (buffer-name (process-buffer process))
(kill-buffer (process-buffer process)))
nil))))
(defun nntp-open-network-stream (buffer)
(open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+(defun nntp-open-ssl-stream (buffer)
+ (let* ((ssl-program-arguments '("-connect" (concat host ":" service)))
+ (proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number)))
+ (save-excursion
+ (set-buffer buffer)
+ (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.
(when (and (> (point) nntp-process-start-point)
(re-search-backward nntp-process-wait-for
nntp-process-start-point t))
- (when (buffer-name (get-buffer nntp-process-to-buffer))
+ (when (gnus-buffer-exists-p nntp-process-to-buffer)
(let ((cur (current-buffer))
(start nntp-process-start-point))
(save-excursion
- (set-buffer (get-buffer nntp-process-to-buffer))
+ (set-buffer nntp-process-to-buffer)
(goto-char (point-max))
(let ((b (point)))
(insert-buffer-substring cur start)
(goto-char (point-min))
(while (not (eobp))
(end-of-line)
- (insert "\r")
- (forward-line 1))))
+ (delete-char 1)
+ (insert nntp-end-of-line))
+ (forward-char -1)
+ (unless (eq (char-after (1- (point))) ?\r)
+ (insert "\r"))))
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
(set-buffer nntp-server-buffer)
(apply 'start-process
"nntpd" buffer nntp-rlogin-program nntp-address
nntp-rlogin-parameters))))
- (set-buffer buffer)
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc))
+ (save-excursion
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
(defun nntp-find-group-and-number ()
(save-excursion
projects / gnus / blobdiff