X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnntp.el;h=b25f5f57051b1bbb98de2a0e16611a130c19ad5c;hb=7709e53c759e9432e8b52e5280062d0b03b4dab2;hp=4213bdc637a35c7bc836a363ae1875a0c0016647;hpb=1ef8709e8cc596a386619071fec2e9824b8aae4a;p=gnus

diff --git a/lisp/nntp.el b/lisp/nntp.el
index 4213bdc63..b25f5f570 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 <larsi@gnus.org>
 ;; Keywords: news
@@ -80,6 +80,7 @@ Direct connections:
 
 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
@@ -88,20 +89,22 @@ 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'.
@@ -117,9 +120,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.
@@ -127,8 +137,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.
@@ -180,6 +189,21 @@ 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."
   :type
@@ -357,6 +381,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)
@@ -391,9 +420,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
@@ -420,9 +447,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)))
@@ -445,7 +470,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))))
@@ -470,7 +495,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))))
 
@@ -478,9 +503,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)))
@@ -495,11 +518,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))))
 
@@ -508,9 +531,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.
@@ -572,7 +594,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
@@ -674,8 +696,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.
@@ -1003,6 +1024,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 (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)
+
+
+
 ;;; Hooky functions.
 
 (defun nntp-send-mode-reader ()
@@ -1063,7 +1132,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) (gnus-point-at-eol))))))
+       (buffer-substring (point) (point-at-eol))))))
 
 ;;; Internal functions.
 
@@ -1073,9 +1142,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)
@@ -1101,7 +1168,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)))))
@@ -1210,7 +1277,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 ()
@@ -1338,9 +1405,7 @@ password contained in '~/.nntp-authinfo'."
                (nntp-send-command "^[245].*\n" "GROUP" group)
                (setcar (cddr entry) group)
                (erase-buffer)
-               (save-excursion
-                 (set-buffer nntp-server-buffer)
-                 (erase-buffer))))))))
+	       (nntp-erase-buffer nntp-server-buffer)))))))
 
 (defun nntp-decode-text (&optional cr-only)
   "Decode the text in the current buffer."
@@ -1549,10 +1614,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)
@@ -1801,6 +1864,36 @@ Please refer to the following variables to customize the connection:
       (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.
 First telnet the remote host, and then telnet the real news server
@@ -1876,6 +1969,80 @@ 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))))
+
+(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
+      (not (equal (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