X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=62f29ce438982e196951007480dea377a4de67cc;hb=786d05e27f23ae1e1254d90a50f61487e168c616;hp=f11364e5a932e5186aaaff151837f0c291042d69;hpb=d760bac8635b552c28cfc2ee5b24cf25f633bdbb;p=gnus diff --git a/lisp/nntp.el b/lisp/nntp.el index f11364e5a..62f29ce43 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. +;; 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 ;; Keywords: news @@ -20,7 +21,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: @@ -29,11 +31,16 @@ (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.") @@ -191,7 +198,7 @@ server there that you can connect to. See also ;; Marks (defvoo nntp-marks-is-evil nil - "*If non-nil, GNus will never generate and use marks file for nntp groups. + "*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") @@ -206,6 +213,7 @@ See `nnml-marks-is-evil' for more information.") (defcustom nntp-authinfo-file "~/.authinfo" ".netrc-like file that holds nntp authinfo passwords." + :group 'nntp :type '(choice file (repeat :tag "Entries" @@ -272,7 +280,7 @@ noticing asynchronous data.") (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 @@ -554,7 +562,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. @@ -616,7 +629,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))) @@ -903,7 +917,7 @@ command whose response triggered the error." (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))) @@ -1025,8 +1039,8 @@ command whose response triggered the error." t) (deffoo nntp-request-set-mark (group actions &optional server) - (nntp-possibly-change-group group 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)) @@ -1045,29 +1059,30 @@ command whose response triggered the error." nil) (deffoo nntp-request-update-info (group info &optional server) - (nntp-possibly-change-group group server) - (when (and (not nntp-marks-is-evil) (nntp-marks-changed-p group)) - (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) + (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) @@ -1088,11 +1103,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 @@ -1188,7 +1203,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 @@ -1208,20 +1223,21 @@ password contained in '~/.nntp-authinfo'." (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))) @@ -1232,7 +1248,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))) @@ -1245,12 +1261,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)))) @@ -1375,7 +1388,7 @@ password contained in '~/.nntp-authinfo'." ;; 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")))) @@ -1556,8 +1569,8 @@ 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 - (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)))))) @@ -1626,7 +1639,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) @@ -1664,7 +1677,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))) @@ -1980,15 +1993,18 @@ Please refer to the following variables to customize the connection: (make-directory (directory-file-name dir) t) (nnheader-message 5 "Creating nntp marks directory %s" dir)))) -(defun nntp-marks-changed-p (group) +(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 + 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))))))) + (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) @@ -2043,4 +2059,5 @@ Please refer to the following variables to customize the connection: (provide 'nntp) +;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 ;;; nntp.el ends here