X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=100ba595354e57f0127f1e630e37bb489dd40765;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=234865ce66f138cf896f6e9f6051f2b742d4165e;hpb=7495b1372e8e5e347809c7be1bab9c7efde1f6a2;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index 234865c..100ba59 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,8 @@ ;;; nntp.el --- nntp access for Gnus ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka @@ -21,7 +22,8 @@ ;; 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: @@ -32,9 +34,14 @@ (require 'nnheader) (require 'nnoo) (require 'gnus-util) +(require 'gnus) (nnoo-declare nntp) +(defgroup nntp nil + "NNTP access for Gnus." + :group 'gnus) + (defvoo nntp-address nil "Address of the physical nntp server.") @@ -125,25 +132,15 @@ This is where you would put \"runsocks\" or stuff like that.") (defvoo nntp-telnet-command "telnet" "*Telnet command used to connect to the nntp server. This command is used by the methods `nntp-open-telnet-stream', -`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'. - -See `nntp-netcat-command' for the `nntp-open-via-rlogin-and-netcat' -method.") +`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-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-netcat-switches nil - "*Switches given to the netcat command `nntp-netcat-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. @@ -165,6 +162,13 @@ This command is used by the `nntp-open-via-telnet-and-telnet' method.") (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 various nntp-open-via-* methods.") @@ -221,8 +225,24 @@ server there that you can connect to. See also (defvoo nntp-warn-about-losing-connection t "*If non-nil, beep when a server closes connection.") +;; 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" @@ -576,7 +596,12 @@ be restored and the command retried." ;; 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. @@ -638,7 +663,8 @@ command whose response triggered the error." (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))) @@ -1078,6 +1104,54 @@ newsgroups that match the regexp." (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 () @@ -1095,11 +1169,11 @@ 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 "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 @@ -1192,7 +1266,7 @@ password contained in '~/.nntp-authinfo'." (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 @@ -1213,9 +1287,10 @@ password contained in '~/.nntp-authinfo'." (open-network-stream-as-binary "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) @@ -1227,7 +1302,7 @@ password contained in '~/.nntp-authinfo'." (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))) @@ -1238,7 +1313,7 @@ password contained in '~/.nntp-authinfo'." (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))) @@ -1251,12 +1326,9 @@ password contained in '~/.nntp-authinfo'." "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)))) @@ -1562,7 +1634,7 @@ password contained in '~/.nntp-authinfo'." (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 + (let ((low-limit (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))) (while (and articles (<= (car articles) low-limit)) @@ -1632,7 +1704,7 @@ password contained in '~/.nntp-authinfo'." (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) @@ -1670,7 +1742,7 @@ password contained in '~/.nntp-authinfo'." "\\([^ :]+\\):\\([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))) @@ -1885,8 +1957,8 @@ Please refer to the following variables to customize the connection: - `nntp-via-rlogin-command-switches', - `nntp-via-user-name', - `nntp-via-address', -- `nntp-netcat-command', -- `nntp-netcat-switches', +- `nntp-via-netcat-command', +- `nntp-via-netcat-switches', - `nntp-address', - `nntp-port-number', - `nntp-end-of-line'." @@ -1898,8 +1970,8 @@ Please refer to the following variables to customize the connection: ,@(when nntp-via-user-name (list "-l" nntp-via-user-name)) ,nntp-via-address - ,nntp-netcat-command - ,@nntp-netcat-switches + ,nntp-via-netcat-command + ,@nntp-via-netcat-switches ,nntp-address ,nntp-port-number))) (apply 'start-process "nntpd" buffer command))) @@ -1980,6 +2052,82 @@ 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)) + +(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) ;;; nntp.el ends here