X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=e8be835bb75974586ac81f6400a49afc3adcfd50;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=f8bd011a3404ff1fe8a28a0c3e69a64d40084ce1;hpb=0a919ac2e96918074f11c8740a5acadbec21a676;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index f8bd011..e8be835 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 ;; 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: @@ -220,9 +222,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP 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.") - ;; Marks (defvoo nntp-marks-is-evil nil "*If non-nil, Gnus will never generate and use marks file for nntp groups. @@ -307,7 +306,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 @@ -594,7 +593,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. @@ -656,7 +660,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))) @@ -943,7 +948,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))) @@ -1118,29 +1123,29 @@ newsgroups that match the regexp." (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) + (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) @@ -1258,7 +1263,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 @@ -1279,9 +1284,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) @@ -1293,7 +1299,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))) @@ -1304,7 +1310,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))) @@ -1444,7 +1450,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")))) @@ -1625,8 +1631,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)))))) @@ -1695,7 +1701,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) @@ -1733,7 +1739,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))) @@ -2055,20 +2061,23 @@ 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)))) +(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) (file (expand-file-name - nntp-marks-file-name + nntp-marks-file-name (nnmail-group-pathname group (nntp-marks-directory server))))) (condition-case err