X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=bd8591cc0eea84793eba62b9e75129f148c03d59;hb=9dd8d144dd2d47bd0ea84e76881ec0f46af778f1;hp=7f50446bc8d0101e5651ac78c63bb676902eef32;hpb=73c6f05af6afc303948a77bc5c94412a480e2164;p=elisp%2Fgnus.git- diff --git a/lisp/nntp.el b/lisp/nntp.el index 7f50446..bd8591c 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; nntp.el --- nntp access for Gnus ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -29,11 +29,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.") @@ -75,10 +80,12 @@ host. 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 @@ -87,27 +94,29 @@ 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 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. @@ -116,9 +125,16 @@ 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 `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. @@ -126,8 +142,7 @@ This variable is used by the `nntp-open-via-telnet-and-telnet' method.") (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. @@ -138,8 +153,8 @@ If non-nil, there will be no prompt for a login name.") 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 @@ -179,8 +194,24 @@ server there that you can connect to. See also (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." + :group 'nntp :type '(choice file (repeat :tag "Entries" @@ -207,13 +238,6 @@ NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") "*Hook run just before posting an article. It is supposed to be used to insert Cancel-Lock headers.") -(defvoo nntp-read-timeout (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" - (symbol-name system-type)) - 1.0 - 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 @@ -254,9 +278,12 @@ noticing asynchronous data.") (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.") @@ -360,6 +387,11 @@ be restored and the command retried." (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) @@ -394,9 +426,7 @@ be restored and the command retried." (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 @@ -423,9 +453,7 @@ be restored and the command retried." "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))) @@ -448,7 +476,7 @@ be restored and the command retried." (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)))) @@ -473,8 +501,7 @@ be restored and the command retried." (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)))) @@ -482,9 +509,7 @@ be restored and the command retried." "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))) @@ -499,11 +524,11 @@ be restored and the command retried." (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)))) @@ -512,9 +537,8 @@ be restored and the command retried." "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. @@ -576,7 +600,7 @@ command whose response triggered the error." (let ((timer (and nntp-connection-timeout - (nnheader-run-at-time + (run-at-time nntp-connection-timeout nil '(lambda () (let ((process (nntp-find-connection @@ -678,8 +702,7 @@ command whose response triggered the error." (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. @@ -1007,6 +1030,54 @@ command whose response triggered the error." (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 () @@ -1024,11 +1095,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 @@ -1042,9 +1113,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the (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." @@ -1053,8 +1123,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the (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. @@ -1068,7 +1138,7 @@ password contained in '~/.nntp-authinfo'." (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. @@ -1078,9 +1148,7 @@ password contained in '~/.nntp-authinfo'." (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) @@ -1106,7 +1174,7 @@ password contained in '~/.nntp-authinfo'." (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))))) @@ -1147,11 +1215,35 @@ 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") + (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))) @@ -1160,12 +1252,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)))) @@ -1191,7 +1280,7 @@ password contained in '~/.nntp-authinfo'." ;; 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 () @@ -1280,17 +1369,12 @@ password contained in '~/.nntp-authinfo'." (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 @@ -1315,16 +1399,16 @@ password contained in '~/.nntp-authinfo'." (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." @@ -1408,8 +1492,7 @@ password contained in '~/.nntp-authinfo'." 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. @@ -1443,15 +1526,22 @@ password contained in '~/.nntp-authinfo'." (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)))) @@ -1527,10 +1617,8 @@ password contained in '~/.nntp-authinfo'." (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) @@ -1669,7 +1757,7 @@ via telnet.") 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 @@ -1769,7 +1857,45 @@ Please refer to the following variables to customize the connection: (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. @@ -1821,8 +1947,7 @@ Please refer to the following variables to customize the connection: (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" @@ -1847,6 +1972,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)))) + +(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) +;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 ;;; nntp.el ends here