diff lisp/gnus/nntp.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/nntp.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1335 @@
+;;; nntp.el --- nntp access for Gnus
+;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nntp)
+
+(eval-and-compile
+  (unless (fboundp 'open-network-stream)
+    (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (autoload 'cancel-timer "timer")
+  (autoload 'telnet "telnet" nil t)
+  (autoload 'telnet-send-input "telnet" nil t)
+  (autoload 'timezone-parse-date "timezone"))
+
+(defvoo nntp-server-hook nil
+  "*Hooks for the NNTP server.
+If the kanji code of the NNTP server is different from the local kanji
+code, the correct kanji code of the buffer associated with the NNTP
+server must be specified as follows:
+
+\(setq nntp-server-hook
+      (function
+       (lambda ()
+	 ;; Server's Kanji code is EUC (NEmacs hack).
+	 (make-local-variable 'kanji-fileio-code)
+	 (setq kanji-fileio-code 0))))
+
+If you'd like to change something depending on the server in this
+hook, use the variable `nntp-address'.")
+
+(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
+  "*Hook used for sending commands to the server at startup.  
+The default value is `nntp-send-mode-reader', which makes an innd
+server spawn an nnrpd server.  Another useful function to put in this
+hook might be `nntp-send-authinfo', which will prompt for a password
+to allow posting from the server.  Note that this is only necessary to
+do on servers that use strict access control.")  
+(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
+
+(defvoo nntp-server-action-alist 
+  '(("nntpd 1\\.5\\.11t" 
+     (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
+  "Alist of regexps to match on server types and actions to be taken.
+For instance, if you want Gnus to beep every time you connect
+to innd, you could say something like:
+
+\(setq nntp-server-action-alist
+       '((\"innd\" (ding))))
+
+You probably don't want to do that, though.")
+
+(defvoo nntp-open-server-function 'nntp-open-network-stream
+  "*Function used for connecting to a remote system.
+It will be called with the address of the remote system.
+
+Two pre-made functions are `nntp-open-network-stream', which is the
+default, and simply connects to some port or other on the remote
+system (see nntp-port-number).  The other is `nntp-open-rlogin', which
+does an rlogin on the remote system, and then does a telnet to the
+NNTP server available there (see nntp-rlogin-parameters).")
+
+(defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
+  "*Parameters to `nntp-open-login'.
+That function may be used as `nntp-open-server-function'.  In that
+case, this list will be used as the parameter list given to rsh.")
+
+(defvoo nntp-rlogin-user-name nil
+  "*User name on remote system when using the rlogin connect method.")
+
+(defvoo nntp-address nil
+  "*The name of the NNTP server.")
+
+(defvoo nntp-port-number "nntp"
+  "*Port number to connect to.")
+
+(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 rlogin to communicate with the server.")
+
+(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
+messages will be shown to indicate the current status.")
+
+(defvoo nntp-buggy-select (memq system-type '(fujitsu-uts))
+  "*t if your select routine is buggy.
+If the select routine signals error or fall into infinite loop while
+waiting for the server response, the variable must be set to t.  In
+case of Fujitsu UTS, it is set to T since `accept-process-output'
+doesn't work properly.")
+
+(defvoo nntp-maximum-request 400
+  "*The maximum number of the requests sent to the NNTP server at one time.
+If Emacs hangs up while retrieving headers, set the variable to a
+lower value.")
+
+(defvoo nntp-debug-read 10000
+  "*Display '...' every 10Kbytes of a message being received if it is non-nil.
+If it is a number, dots are displayed per the number.")
+
+(defvoo nntp-nov-is-evil nil
+  "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
+
+(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
+  "*List of strings that are used as commands to fetch NOV lines from a server.
+The strings are tried in turn until a positive response is gotten. If
+none of the commands are successful, nntp will just grab headers one
+by one.")
+
+(defvoo nntp-nov-gap 20
+  "*Maximum allowed gap between two articles.
+If the gap between two consecutive articles is bigger than this
+variable, split the XOVER request into two requests.")
+
+(defvoo nntp-connection-timeout nil
+  "*Number of seconds to wait before an nntp connection times out.
+If this variable is nil, which is the default, no timers are set.")
+
+(defvoo nntp-command-timeout nil
+  "*Number of seconds to wait for a response when sending a command.
+If this variable is nil, which is the default, no timers are set.")
+
+(defvoo nntp-retry-on-break nil
+  "*If non-nil, re-send the command when the user types `C-g'.")
+
+(defvoo nntp-news-default-headers nil
+  "*If non-nil, override `mail-default-headers' when posting news.")
+
+(defvoo nntp-prepare-server-hook nil
+  "*Hook run before a server is opened.
+If can be used to set up a server remotely, for instance.  Say you
+have an account at the machine \"other.machine\".  This machine has
+access to an NNTP server that you can't access locally.  You could
+then use this hook to rsh to the remote machine and start a proxy NNTP
+server there that you can connect to.")
+
+(defvoo nntp-async-number 5
+  "*How many articles should be prefetched when in asynchronous mode.")
+
+(defvoo nntp-warn-about-losing-connection t
+  "*If non-nil, beep when a server closes connection.")
+
+
+
+(defconst nntp-version "nntp 4.0"
+  "Version numbers of this version of NNTP.")
+
+(defvar nntp-server-buffer nil
+  "Buffer associated with the NNTP server process.")
+
+(defvoo nntp-server-process nil
+  "The NNTP server process.
+You'd better not use this variable in NNTP front-end program, but
+instead use `nntp-server-buffer'.")
+
+(defvoo nntp-status-string nil
+  "Save the server response message.")
+
+(defvar nntp-opened-connections nil
+  "All (possibly) opened connections.")
+
+(defvoo nntp-server-xover 'try)
+(defvoo nntp-server-list-active-group 'try)
+(defvoo nntp-current-group "")
+(defvoo nntp-server-type nil)
+
+(defvoo nntp-async-process nil)
+(defvoo nntp-async-buffer nil)
+(defvoo nntp-async-articles nil)
+(defvoo nntp-async-fetched nil)
+(defvoo nntp-async-group-alist nil)
+
+
+;;; Interface functions.
+
+(nnoo-define-basics nntp)
+
+(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
+  "Retrieve the headers of ARTICLES."
+  (nntp-possibly-change-server group server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (if (and (not gnus-nov-is-evil) 
+	     (not nntp-nov-is-evil)
+	     (nntp-retrieve-headers-with-xover articles fetch-old))
+	;; We successfully retrieved the headers via XOVER.
+        'nov
+      ;; XOVER didn't work, so we do it the hard, slow and inefficient
+      ;; way.  
+      (let ((number (length articles))
+	    (count 0)
+	    (received 0)
+	    (message-log-max nil)
+	    (last-point (point-min)))
+	;; Send HEAD command.
+	(while articles
+	  (nntp-send-strings-to-server 
+	   "HEAD" (if (numberp (car articles)) 
+		      (int-to-string (car articles))
+		    ;; `articles' is either a list of article numbers
+		    ;; or a list of article IDs.
+		    (car articles)))
+	  (setq articles (cdr articles)
+		count (1+ count))
+	  ;; Every 400 header requests we have to read the stream in
+	  ;; order to avoid deadlocks.
+	  (when (or (null articles)	;All requests have been sent.
+		    (zerop (% count nntp-maximum-request)))
+	    (nntp-accept-response)
+	    (while (progn
+		     (goto-char last-point)
+		     ;; Count replies.
+		     (while (re-search-forward "^[0-9]" nil t)
+		       (setq received (1+ received)))
+		     (setq last-point (point))
+		     (< received count))
+	      ;; If number of headers is greater than 100, give
+	      ;;  informative messages.
+	      (and (numberp nntp-large-newsgroup)
+		   (> number nntp-large-newsgroup)
+		   (zerop (% received 20))
+		   (nnheader-message 7 "NNTP: Receiving headers... %d%%"
+				     (/ (* received 100) number)))
+	      (nntp-accept-response))))
+	;; Wait for text of last command.
+	(goto-char (point-max))
+	(re-search-backward "^[0-9]" nil t)
+	(when (looking-at "^[23]")
+	  (while (progn
+		   (goto-char (- (point-max) 3))
+		   (not (looking-at "^\\.\r?\n")))
+	    (nntp-accept-response)))
+	(and (numberp nntp-large-newsgroup)
+	     (> number nntp-large-newsgroup)
+	     (nnheader-message 7 "NNTP: Receiving headers...done"))
+
+	;; Now all of replies are received.  Fold continuation lines.
+	(nnheader-fold-continuation-lines)
+	;; Remove all "\r"'s.
+	(goto-char (point-min))
+	(while (search-forward "\r" nil t)
+	  (replace-match "" t t))
+	'headers))))
+
+
+(deffoo nntp-retrieve-groups (groups &optional server)
+  "Retrieve group info on GROUPS."
+  (nntp-possibly-change-server nil server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    ;; The first time this is run, this variable is `try'.  So we
+    ;; try.   
+    (when (eq nntp-server-list-active-group 'try)
+      (nntp-try-list-active (car groups)))
+    (erase-buffer)
+    (let ((count 0)
+	  (received 0)
+	  (last-point (point-min))
+	  (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
+      (while groups
+	;; Send the command to the server.
+	(nntp-send-strings-to-server command (car groups))
+	(setq groups (cdr groups))
+	(setq count (1+ count))
+	;; Every 400 requests we have to read the stream in
+	;; order to avoid deadlocks.
+	(when (or (null groups)		;All requests have been sent.
+		  (zerop (% count nntp-maximum-request)))
+	  (nntp-accept-response)
+	  (while (progn
+		   (goto-char last-point)
+		   ;; Count replies.
+		   (while (re-search-forward "^[0-9]" nil t)
+		     (setq received (1+ received)))
+		   (setq last-point (point))
+		   (< received count))
+	    (nntp-accept-response))))
+
+      ;; Wait for the reply from the final command.
+      (when nntp-server-list-active-group
+	(goto-char (point-max))
+	(re-search-backward "^[0-9]" nil t)
+	(when (looking-at "^[23]")
+	  (while (progn
+		   (goto-char (- (point-max) 3))
+		   (not (looking-at "^\\.\r?\n")))
+	    (nntp-accept-response))))
+
+      ;; Now all replies are received. We remove CRs.
+      (goto-char (point-min))
+      (while (search-forward "\r" nil t)
+	(replace-match "" t t))
+
+      (if (not nntp-server-list-active-group)
+	  'group
+	;; We have read active entries, so we just delete the
+	;; superfluos gunk.
+	(goto-char (point-min))
+	(while (re-search-forward "^[.2-5]" nil t)
+	  (delete-region (match-beginning 0) 
+			 (progn (forward-line 1) (point))))
+	'active))))
+
+(deffoo nntp-open-server (server &optional defs connectionless)
+  "Open the virtual server SERVER.
+If CONNECTIONLESS is non-nil, don't attempt to connect to any physical
+servers."
+  ;; Called with just a port number as the defs.
+  (when (or (stringp (car defs))
+	    (numberp (car defs)))
+    (setq defs `((nntp-port-number ,(car defs)))))
+  (unless (assq 'nntp-address defs)
+    (setq defs (append defs `((nntp-address ,server)))))
+  (nnoo-change-server 'nntp server defs)
+  (if (nntp-server-opened server)
+      t
+    (or (nntp-server-opened server)
+	connectionless
+	(prog2
+	    (run-hooks 'nntp-prepare-server-hook)
+	    (nntp-open-server-semi-internal nntp-address nntp-port-number)
+	  (nnheader-insert "")))))
+
+(deffoo nntp-close-server (&optional server)
+  "Close connection to SERVER."
+  (nntp-possibly-change-server nil server t)
+  (unwind-protect
+      (progn
+	;; Un-set default sentinel function before closing connection.
+	(and nntp-server-process
+	     (eq 'nntp-default-sentinel
+		 (process-sentinel nntp-server-process))
+	     (set-process-sentinel nntp-server-process nil))
+	;; We cannot send QUIT command unless the process is running.
+	(when (nntp-server-opened server)
+	  (nntp-send-command nil "QUIT")
+	  ;; Give the QUIT time to arrive.
+	  (sleep-for 1)))
+    (nntp-close-server-internal server)))
+
+(deffoo nntp-request-close ()
+  "Close all server connections."
+  (let (proc)
+    (while nntp-opened-connections
+      (when (setq proc (pop nntp-opened-connections))
+	;; Un-set default sentinel function before closing connection.
+	(when (eq 'nntp-default-sentinel (process-sentinel proc))
+	  (set-process-sentinel proc nil))
+	(condition-case ()
+	    (process-send-string proc (concat "QUIT" nntp-end-of-line))
+	  (error nil))
+	;; Give the QUIT time to reach the server before we close
+	;; down the process.
+	(sleep-for 1)
+	(delete-process proc)))
+    (and nntp-async-buffer
+	 (buffer-name nntp-async-buffer)
+	 (kill-buffer nntp-async-buffer))
+    (let ((alist (cddr (assq 'nntp nnoo-state-alist)))
+	  entry)
+      (while (setq entry (pop alist))
+	(and (setq proc (cdr (assq 'nntp-async-buffer entry)))
+	     (buffer-name proc)
+	     (kill-buffer proc))))
+    (nnoo-close-server 'nntp)
+    (setq nntp-async-group-alist nil)))
+
+(deffoo nntp-server-opened (&optional server)
+  "Say whether a connection to SERVER has been opened."
+  (and (nnoo-current-server-p 'nntp server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)
+       nntp-server-process
+       (memq (process-status nntp-server-process) '(open run))))
+
+(deffoo nntp-status-message (&optional server)
+  "Return server status as a string."
+  (if (and nntp-status-string
+	   ;; NNN MESSAGE
+	   (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
+			 nntp-status-string))
+      (substring nntp-status-string (match-beginning 1) (match-end 1))
+    ;; Empty message if nothing.
+    (or nntp-status-string "")))
+
+(deffoo nntp-request-article (id &optional group server buffer)
+  "Request article ID (Message-ID or number)."
+  (nntp-possibly-change-server group server)
+
+  (let (found)
+
+    ;; First we see whether we can get the article from the async buffer. 
+    (when (and (numberp id)
+	       nntp-async-articles
+	       (memq id nntp-async-fetched))
+      (save-excursion
+	(set-buffer nntp-async-buffer)
+	(let ((opoint (point))
+	      (art (if (numberp id) (int-to-string id) id))
+	      beg end)
+	  (when (and (or (re-search-forward (concat "^2.. +" art) nil t)
+			 (progn
+			   (goto-char (point-min))
+			   (re-search-forward (concat "^2.. +" art) opoint t)))
+		     (progn
+		       (beginning-of-line)
+		       (setq beg (point)
+			     end (re-search-forward "^\\.\r?\n" nil t))))
+	    (setq found t)
+	    (save-excursion
+	      (set-buffer (or buffer nntp-server-buffer))
+	      (erase-buffer)
+	      (insert-buffer-substring nntp-async-buffer beg end)
+	      (let ((nntp-server-buffer (current-buffer)))
+		(nntp-decode-text)))
+	    (delete-region beg end)
+	    (when nntp-async-articles
+	      (nntp-async-fetch-articles id))))))
+
+    (if found 
+	id
+      ;; The article was not in the async buffer, so we fetch it now.
+      (unwind-protect
+	  (progn
+	    (if buffer (set-process-buffer nntp-server-process buffer))
+	    (let ((nntp-server-buffer (or buffer nntp-server-buffer))
+		  (art (or (and (numberp id) (int-to-string id)) id)))
+	      (prog1
+		  (and (nntp-send-command 
+			;; A bit odd regexp to ensure working over rlogin.
+			"^\\.\r?\n" "ARTICLE" art)
+		       (if (numberp id) 
+			   (cons nntp-current-group id)
+			 ;; We find out what the article number was.
+			 (nntp-find-group-and-number)))
+		(nntp-decode-text)
+		(and nntp-async-articles (nntp-async-fetch-articles id)))))
+	(when buffer 
+	  (set-process-buffer nntp-server-process nntp-server-buffer))))))
+
+(deffoo nntp-request-body (id &optional group server)
+  "Request body of article ID (Message-ID or number)."
+  (nntp-possibly-change-server group server)
+  (prog1
+      ;; If NEmacs, end of message may look like: "\256\215" (".^M")
+      (nntp-send-command
+       "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id))
+    (nntp-decode-text)))
+
+(deffoo nntp-request-head (id &optional group server)
+  "Request head of article ID (Message-ID or number)."
+  (nntp-possibly-change-server group server)
+  (prog1
+      (when (nntp-send-command 
+	     "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id))
+	(if (numberp id) id
+	  ;; We find out what the article number was.
+	  (nntp-find-group-and-number)))
+    (nntp-decode-text)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (nnheader-fold-continuation-lines))))
+
+(deffoo nntp-request-stat (id &optional group server)
+  "Request STAT of article ID (Message-ID or number)."
+  (nntp-possibly-change-server group server)
+  (nntp-send-command 
+   "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
+
+(deffoo nntp-request-type (group &optional article)
+  'news)
+
+(deffoo nntp-request-group (group &optional server dont-check)
+  "Select GROUP."
+  (nntp-possibly-change-server nil server)
+  (setq nntp-current-group
+	(when (nntp-send-command "^2.*\r?\n" "GROUP" group)
+	  group)))
+
+(deffoo nntp-request-asynchronous (group &optional server articles)
+  "Enable pre-fetch in GROUP."
+  (when nntp-async-articles
+    (nntp-async-request-group group))
+  (when nntp-async-number
+    (if (not (or (nntp-async-server-opened)
+		 (nntp-async-open-server)))
+	;; Couldn't open the second connection
+	(progn
+	  (message "Can't open second connection to %s" nntp-address)
+	  (ding)
+	  (setq nntp-async-articles nil)
+	  (sit-for 2))
+      ;; We opened the second connection (or it was opened already).  
+      (setq nntp-async-articles articles)
+      (setq nntp-async-fetched nil)
+      ;; Clear any old data.
+      (save-excursion
+	(set-buffer nntp-async-buffer)
+	(erase-buffer))
+      ;; Select the correct current group on this server.
+      (nntp-async-send-strings "GROUP" group)
+      t)))
+
+(deffoo nntp-list-active-group (group &optional server)
+  "Return the active info on GROUP (which can be a regexp."
+  (nntp-possibly-change-server group server)
+  (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
+
+(deffoo nntp-request-group-description (group &optional server)
+  "Get the description of GROUP."
+  (nntp-possibly-change-server nil server)
+  (prog1
+      (nntp-send-command "^.*\r?\n" "XGTITLE" group)
+    (nntp-decode-text)))
+
+(deffoo nntp-close-group (group &optional server)
+  "Close GROUP."
+  (setq nntp-current-group nil)
+  t)
+
+(deffoo nntp-request-list (&optional server)
+  "List all active groups."
+  (nntp-possibly-change-server nil server)
+  (prog1
+      (nntp-send-command "^\\.\r?\n" "LIST")
+    (nntp-decode-text)))
+
+(deffoo nntp-request-list-newsgroups (&optional server)
+  "Get descriptions on all groups on SERVER."
+  (nntp-possibly-change-server nil server)
+  (prog1
+      (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS")
+    (nntp-decode-text)))
+
+(deffoo nntp-request-newgroups (date &optional server)
+  "List groups that have arrived since DATE."
+  (nntp-possibly-change-server nil server)
+  (let* ((date (timezone-parse-date date))
+	 (time-string
+	  (format "%s%02d%02d %s%s%s"
+		  (substring (aref date 0) 2) (string-to-int (aref date 1)) 
+		  (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
+		  (substring 
+		   (aref date 3) 3 5) (substring (aref date 3) 6 8))))
+    (prog1
+	(nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
+      (nntp-decode-text))))
+
+(deffoo nntp-request-list-distributions (&optional server)
+  "List distributions."
+  (nntp-possibly-change-server nil server)
+  (prog1
+      (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS")
+    (nntp-decode-text)))
+
+(deffoo nntp-request-last (&optional group server)
+  "Decrease the current article pointer."
+  (nntp-possibly-change-server group server)
+  (nntp-send-command "^[23].*\r?\n" "LAST"))
+
+(deffoo nntp-request-next (&optional group server)
+  "Advance the current article pointer."
+  (nntp-possibly-change-server group server)
+  (nntp-send-command "^[23].*\r?\n" "NEXT"))
+
+(deffoo nntp-request-post (&optional server)
+  "Post the current buffer."
+  (nntp-possibly-change-server nil server)
+  (when (nntp-send-command "^[23].*\r?\n" "POST")
+    (nnheader-insert "")
+    (nntp-encode-text)
+    (nntp-send-region-to-server (point-min) (point-max))
+    ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+    ;;  appended to end of the status message.
+    (nntp-wait-for-response "^[23].*\n")))
+
+;;; Internal functions.
+
+(defun nntp-send-mode-reader ()
+  "Send the MODE READER command to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will make innd servers spawn an nnrpd process to allow actual article
+reading."
+  (nntp-send-command "^.*\r?\n" "MODE READER"))
+
+(defun nntp-send-nosy-authinfo ()
+  "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+  (nntp-send-command "^.*\r?\n" "AUTHINFO USER"
+		     (read-string "NNTP user name: "))
+  (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" 
+		     (read-string "NNTP password: ")))
+
+(defun nntp-send-authinfo ()
+  "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+  (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+  (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" 
+		     (read-string "NNTP password: ")))
+
+(defun nntp-send-authinfo-from-file ()
+  "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+  (when (file-exists-p "~/.nntp-authinfo")
+    (save-excursion
+      (set-buffer (get-buffer-create " *authinfo*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (insert-file-contents "~/.nntp-authinfo")
+      (goto-char (point-min))
+      (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+      (nntp-send-command 
+       "^.*\r?\n" "AUTHINFO PASS" 
+       (buffer-substring (point) (progn (end-of-line) (point))))
+      (kill-buffer (current-buffer)))))
+
+(defun nntp-default-sentinel (proc status)
+  "Default sentinel function for NNTP server process."
+  (let ((servers (cddr (assq 'nntp nnoo-state-alist)))
+	server)
+    ;; Go through the alist of server names and find the name of the
+    ;; server that the process that sent the signal is connected to.
+    ;; If you get my drift.
+    (if (equal proc nntp-server-process)
+	(setq server nntp-address)
+      (while (and servers 
+		  (not (equal proc (cdr (assq 'nntp-server-process
+					      (car servers))))))
+	(setq servers (cdr servers)))
+      (setq server (caar servers)))
+    (when (and server
+	       nntp-warn-about-losing-connection)
+      (nnheader-message 3 "nntp: Connection closed to server %s" server)
+      (setq nntp-current-group "")
+      (ding))))
+
+(defun nntp-kill-connection (server)
+  "Choke the connection to SERVER."
+  (let ((proc (cdr (assq 'nntp-server-process 
+			 (assoc server (cddr 
+					(assq 'nntp nnoo-state-alist)))))))
+    (when proc 
+      (delete-process (process-name proc)))
+    (nntp-close-server server)
+    (nnheader-report
+     'nntp (message "Connection timed out to server %s" server))
+    (ding)
+    (sit-for 1)))
+
+;; Encoding and decoding of NNTP text.
+
+(defun nntp-decode-text ()
+  "Decode text transmitted by NNTP.
+0. Delete status line.
+1. Delete `^M' at end of line.
+2. Delete `.' at end of buffer (end of text mark).
+3. Delete `.' at beginning of line."
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    ;; Insert newline at end of buffer.
+    (goto-char (point-max))
+    (or (bolp) (insert "\n"))
+    ;; Delete status line.
+    (delete-region (goto-char (point-min)) (progn (forward-line 1) (point)))
+    ;; Delete `^M's.
+    (while (search-forward "\r" nil t)
+      (replace-match "" t t))
+    ;; Delete `.' at end of the buffer (end of text mark).
+    (goto-char (point-max))
+    (forward-line -1)
+    (when (looking-at "^\\.\n")
+      (delete-region (point) (progn (forward-line 1) (point))))
+    ;; Replace `..' at beginning of line with `.'.
+    (goto-char (point-min))
+    ;; (replace-regexp "^\\.\\." ".")
+    (while (search-forward "\n.." nil t)
+      (delete-char -1))))
+
+(defun nntp-encode-text ()
+  "Encode text in current buffer for NNTP transmission.
+1. Insert `.' at beginning of line.
+2. Insert `.' at end of buffer (end of text mark)."
+  (save-excursion
+    ;; Replace `.' at beginning of line with `..'.
+    (goto-char (point-min))
+    (while (search-forward "\n." nil t)
+      (insert "."))
+    (goto-char (point-max))
+    ;; Insert newline at end of buffer.
+    (or (bolp) (insert "\n"))
+    ;; Insert `.' at end of buffer (end of text mark).
+    (insert "." nntp-end-of-line)))
+
+
+;;;
+;;; Synchronous Communication with NNTP servers.
+;;;
+
+(defvar nntp-retry-command)
+
+(defun nntp-send-command (response cmd &rest args)
+  "Wait for server RESPONSE after sending CMD and optional ARGS to server."
+  (let ((timer 
+	 (and nntp-command-timeout 
+	      (nnheader-run-at-time
+	       nntp-command-timeout nil 'nntp-kill-command 
+	       (nnoo-current-server 'nntp))))
+	(nntp-retry-command t)
+	result)
+    (unwind-protect
+	(save-excursion
+	  (while nntp-retry-command
+	    (setq nntp-retry-command nil)
+	    ;; Clear communication buffer.
+	    (set-buffer nntp-server-buffer)
+	    (widen)
+	    (erase-buffer)
+	    (if nntp-retry-on-break
+		(condition-case ()
+		    (progn
+		      (apply 'nntp-send-strings-to-server cmd args)
+		      (setq result
+			    (if response
+				(nntp-wait-for-response response)
+			      t)))
+		  (quit (setq nntp-retry-command t)))
+	      (apply 'nntp-send-strings-to-server cmd args)
+	      (setq result
+		    (if response
+			(nntp-wait-for-response response)
+		      t))))
+	  result)
+      (when timer 
+	(nnheader-cancel-timer timer)))))
+
+(defun nntp-kill-command (server)
+  "Kill and restart the connection to SERVER."
+  (let ((proc (cdr (assq 
+		    'nntp-server-process 
+		    (assoc server (cddr (assq 'nntp nnoo-state-alist)))))))
+    (when proc 
+      (delete-process (process-name proc)))
+    (nntp-close-server server)
+    (nntp-open-server server)
+    (when nntp-current-group
+      (nntp-request-group nntp-current-group))
+    (setq nntp-retry-command t)))
+
+(defun nntp-send-command-old (response cmd &rest args)
+  "Wait for server RESPONSE after sending CMD and optional ARGS to server."
+  (save-excursion
+    ;; Clear communication buffer.
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (apply 'nntp-send-strings-to-server cmd args)
+    (if response
+	(nntp-wait-for-response response)
+      t)))
+
+(defun nntp-wait-for-response (regexp &optional slow)
+  "Wait for server response which matches REGEXP."
+  (save-excursion
+    (let ((status t)
+	  (wait t)
+	  (dotnum 0)			;Number of "." being displayed.
+	  (dotsize			;How often "." displayed.
+	   (if (numberp nntp-debug-read) nntp-debug-read 10000)))
+      (set-buffer nntp-server-buffer)
+      ;; Wait for status response (RFC977).
+      ;; 1xx - Informative message.
+      ;; 2xx - Command ok.
+      ;; 3xx - Command ok so far, send the rest of it.
+      ;; 4xx - Command was correct, but couldn't be performed for some
+      ;;       reason.
+      ;; 5xx - Command unimplemented, or incorrect, or a serious
+      ;;       program error occurred.
+      (nntp-accept-response)
+      (while wait
+	(goto-char (point-min))
+	(if slow
+	    (progn
+	      (cond ((re-search-forward "^[23][0-9][0-9]" nil t)
+		     (setq wait nil))
+		    ((re-search-forward "^[45][0-9][0-9]" nil t)
+		     (setq status nil)
+		     (setq wait nil))
+		    (t (nntp-accept-response)))
+	      (if (not wait) (delete-region (point-min) 
+					    (progn (beginning-of-line)
+						   (point)))))
+	  (cond ((looking-at "[23]")
+		 (setq wait nil))
+		((looking-at "[45]")
+		 (setq status nil)
+		 (setq wait nil))
+		(t (nntp-accept-response)))))
+      ;; Save status message.
+      (end-of-line)
+      (setq nntp-status-string
+	    (nnheader-replace-chars-in-string 
+	     (buffer-substring (point-min) (point)) ?\r ? ))
+      (when status
+	(setq wait t)
+	(while wait
+	  (goto-char (point-max))
+	  (if (bolp) (forward-line -1) (beginning-of-line))
+	  (if (looking-at regexp)
+	      (setq wait nil)
+	    (when nntp-debug-read
+	      (let ((newnum (/ (buffer-size) dotsize))
+		    (message-log-max nil))
+		(unless (= dotnum newnum)
+		  (setq dotnum newnum)
+		  (nnheader-message 7 "NNTP: Reading %s"
+				    (make-string dotnum ?.)))))
+	    (nntp-accept-response)))
+	;; Remove "...".
+	(when (and nntp-debug-read (> dotnum 0))
+	  (message ""))
+	;; Successfully received server response.
+	t))))
+
+
+
+;;;
+;;; Low-Level Interface to NNTP Server.
+;;; 
+
+(defun nntp-find-group-and-number ()
+  (save-excursion
+    (save-restriction
+      (set-buffer nntp-server-buffer)
+      (narrow-to-region (goto-char (point-min))
+			(or (search-forward "\n\n" nil t) (point-max)))
+      (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
+			  (buffer-substring (match-beginning 1)
+					    (match-end 1)))))
+	    group newsgroups xref)
+	(and number (zerop number) (setq number nil))
+	;; Then we find the group name.
+	(setq group
+	      (cond 
+	       ;; If there is only one group in the Newsgroups header,
+	       ;; then it seems quite likely that this article comes
+	       ;; from that group, I'd say.
+	       ((and (setq newsgroups (mail-fetch-field "newsgroups"))
+		     (not (string-match "," newsgroups)))
+		newsgroups)
+	       ;; If there is more than one group in the Newsgroups
+	       ;; header, then the Xref header should be filled out.
+	       ;; We hazard a guess that the group that has this
+	       ;; article number in the Xref header is the one we are
+	       ;; looking for.  This might very well be wrong if this
+	       ;; article happens to have the same number in several
+	       ;; groups, but that's life. 
+	       ((and (setq xref (mail-fetch-field "xref"))
+		     number
+		     (string-match (format "\\([^ :]+\\):%d" number) xref))
+		(substring xref (match-beginning 1) (match-end 1)))
+	       (t "")))
+	(when (string-match "\r" group) 
+	  (setq group (substring group 0 (match-beginning 0))))
+	(cons group number)))))
+
+(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
+  (erase-buffer)
+  (cond 
+
+   ;; This server does not talk NOV.
+   ((not nntp-server-xover)
+    nil)
+
+   ;; We don't care about gaps.
+   ((or (not nntp-nov-gap)
+	fetch-old)
+    (nntp-send-xover-command 
+     (if fetch-old
+	 (if (numberp fetch-old) 
+	     (max 1 (- (car articles) fetch-old)) 
+	   1)
+       (car articles))
+     (nntp-last-element articles) 'wait)
+
+    (goto-char (point-min))
+    (when (looking-at "[1-5][0-9][0-9] ")
+      (delete-region (point) (progn (forward-line 1) (point))))
+    (while (search-forward "\r" nil t)
+      (replace-match "" t t))
+    (goto-char (point-max))
+    (forward-line -1)
+    (when (looking-at "\\.")
+      (delete-region (point) (progn (forward-line 1) (point)))))
+
+   ;; We do it the hard way.  For each gap, an XOVER command is sent
+   ;; to the server.  We do not wait for a reply from the server, we
+   ;; just send them off as fast as we can.  That means that we have
+   ;; to count the number of responses we get back to find out when we
+   ;; have gotten all we asked for.
+   ((numberp nntp-nov-gap)
+    (let ((count 0)
+	  (received 0)
+	  (last-point (point-min))
+	  (buf (current-buffer))
+	  first)
+      ;; 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.
+      (while (and nntp-server-xover articles)
+	(setq first (car articles))
+	;; Search forward until we find a gap, or until we run out of
+	;; articles. 
+	(while (and (cdr articles) 
+		    (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
+	  (setq articles (cdr articles)))
+
+	(when (nntp-send-xover-command first (car articles))
+	  (setq articles (cdr articles)
+		count (1+ count))
+
+	  ;; Every 400 requests we have to read the stream in
+	  ;; order to avoid deadlocks.
+	  (when (or (null articles)	;All requests have been sent.
+		    (zerop (% count nntp-maximum-request)))
+	    (accept-process-output)
+	    ;; On some Emacs versions the preceding function has
+	    ;; a tendency to change the buffer. Perhaps. It's
+	    ;; quite difficult to reproduce, because it only
+	    ;; seems to happen once in a blue moon. 
+	    (set-buffer buf) 
+	    (while (progn
+		     (goto-char last-point)
+		     ;; Count replies.
+		     (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
+		       (setq received (1+ received)))
+		     (setq last-point (point))
+		     (< received count))
+	      (accept-process-output)
+	      (set-buffer buf)))))
+
+      (when nntp-server-xover
+	;; Wait for the reply from the final command.
+	(goto-char (point-max))
+	(re-search-backward "^[0-9][0-9][0-9] " nil t)
+	(when (looking-at "^[23]")
+	  (while (progn
+		   (goto-char (point-max))
+		   (forward-line -1)
+		   (not (looking-at "^\\.\r?\n")))
+	    (nntp-accept-response)))
+	
+	;; We remove any "." lines and status lines.
+	(goto-char (point-min))
+	(while (search-forward "\r" nil t)
+	  (delete-char -1))
+	(goto-char (point-min))
+	(delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")))))
+
+  nntp-server-xover)
+
+(defun nntp-send-xover-command (beg end &optional wait-for-reply)
+  "Send the XOVER command to the server."
+  (let ((range (format "%d-%d" (or beg 1) (or end beg 1))))
+    (if (stringp nntp-server-xover)
+	;; If `nntp-server-xover' is a string, then we just send this
+	;; command.
+	(if wait-for-reply
+	    (nntp-send-command "^\\.\r?\n" nntp-server-xover range)
+	  ;; We do not wait for the reply.
+	  (nntp-send-strings-to-server nntp-server-xover range))
+      (let ((commands nntp-xover-commands))
+	;; `nntp-xover-commands' is a list of possible XOVER commands.
+	;; We try them all until we get at positive response. 
+	(while (and commands (eq nntp-server-xover 'try))
+	  (nntp-send-command "^\\.\r?\n" (car commands) range)
+	  (save-excursion
+	    (set-buffer nntp-server-buffer)
+	    (goto-char (point-min))
+	    (and (looking-at "[23]") ; No error message.
+		 ;; We also have to look at the lines.  Some buggy
+		 ;; servers give back simple lines with just the
+		 ;; article number.  How... helpful.
+		 (progn
+		   (forward-line 1)
+		   (looking-at "[0-9]+\t...")) ; More text after number.
+		 (setq nntp-server-xover (car commands))))
+	  (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-server-xover))))
+
+(defun nntp-send-strings-to-server (&rest strings)
+  "Send STRINGS to the server."
+  (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line)))
+    ;; We open the nntp server if it is down.
+    (or (nntp-server-opened (nnoo-current-server 'nntp))
+	(nntp-open-server (nnoo-current-server 'nntp))
+	(error (nntp-status-message)))
+    ;; Send the strings.
+    (process-send-string nntp-server-process cmd)
+    t))
+
+(defun nntp-send-region-to-server (begin end)
+  "Send the current buffer region (from BEGIN to END) to the server."
+  (save-excursion
+    (let ((cur (current-buffer)))
+      ;; Copy the buffer over to the send buffer.
+      (nnheader-set-temp-buffer " *nntp send*")
+      (insert-buffer-substring cur begin end)
+      (save-excursion
+	(set-buffer cur)
+	(erase-buffer))
+      ;; `process-send-region' does not work if the text to be sent is very
+      ;; large, so we send it piecemeal.
+      (let ((last (point-min))
+	    (size 100))			;Size of text sent at once.
+	(while (and (/= last (point-max))
+		    (memq (process-status nntp-server-process) '(open run)))
+	  (process-send-region 
+	   nntp-server-process
+	   last (setq last (min (+ last size) (point-max))))
+	  ;; Read any output from the server.  May be unnecessary.
+	  (accept-process-output)))
+      (kill-buffer (current-buffer)))))
+
+(defun nntp-open-server-semi-internal (server &optional service)
+  "Open SERVER.
+If SERVER is nil, use value of environment variable `NNTPSERVER'.
+If SERVICE, this this as the port number."
+  (nnheader-insert "")
+  (let ((server (or server (getenv "NNTPSERVER")))
+	(status nil)
+	(timer 
+	 (and nntp-connection-timeout 
+	      (nnheader-run-at-time nntp-connection-timeout
+				    nil 'nntp-kill-connection server))))
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (setq nntp-status-string "")
+      (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address)
+      (cond ((and server (nntp-open-server-internal server service))
+	     (setq nntp-address server)
+	     (setq status
+		   (condition-case nil
+		       (nntp-wait-for-response "^[23].*\r?\n" 'slow)
+		     (error nil)
+		     (quit nil)))
+	     (unless status
+	       (nntp-close-server-internal server)
+	       (nnheader-report 
+		'nntp "Couldn't open connection to %s" 
+		(if (and nntp-address
+			 (not (equal nntp-address "")))
+		    nntp-address server)))
+	     (when nntp-server-process
+	       (set-process-sentinel 
+		nntp-server-process 'nntp-default-sentinel)
+	       ;; You can send commands at startup like AUTHINFO here.
+	       ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
+	       (run-hooks 'nntp-server-opened-hook)))
+	    ((null server)
+	     (nnheader-report 'nntp "NNTP server is not specified."))
+	    (t				; We couldn't open the server.
+	     (nnheader-report 
+	      'nntp (buffer-substring (point-min) (point-max)))))
+      (when timer 
+	(nnheader-cancel-timer timer))
+      (message "")
+      (unless status
+	(nnoo-close-server 'nntp server)
+	(setq nntp-async-number nil))
+      status)))
+
+(defvar nntp-default-directories '("~" "/tmp" "/")
+  "Directories to as current directory in the nntp server buffer.")
+
+(defun nntp-open-server-internal (server &optional service)
+  "Open connection to news server on SERVER by SERVICE (default is nntp)."
+  (let (proc)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      ;; Make sure we have a valid current directory for the
+      ;; nntp server buffer.
+      (unless (file-exists-p default-directory)
+	(let ((dirs nntp-default-directories))
+	  (while dirs
+	    (when (file-exists-p (car dirs))
+	      (setq default-directory (car dirs)
+		    dirs nil))
+	    (setq dirs (cdr dirs)))))
+      (cond
+       ((and (setq proc
+		   (condition-case nil
+		       (funcall nntp-open-server-function server)
+		     (error nil)))
+	     (memq (process-status proc) '(open run)))
+	(setq nntp-server-process proc)
+	(setq nntp-address server)
+	;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+	(process-kill-without-query proc)
+	(run-hooks 'nntp-server-hook)
+	(push proc nntp-opened-connections)
+	(condition-case ()
+	    (nntp-read-server-type)
+	  (error 
+	   (nnheader-report 'nntp "Couldn't open server %s" server)
+	   (nntp-close-server)))
+	nntp-server-process)
+       (t
+	(nnheader-report 'nntp "Couldn't open server %s" server))))))
+
+(defun nntp-read-server-type ()
+  "Find out what the name of the server we have connected to is."
+  ;; Wait for the status string to arrive.
+  (nntp-wait-for-response "^.*\n" t)
+  (setq nntp-server-type (buffer-string))
+  (let ((alist nntp-server-action-alist)
+	entry)
+    ;; Run server-specific commmands.
+    (while alist
+      (setq entry (pop alist))
+      (when (string-match (car entry) nntp-server-type)
+	(if (and (listp (cadr entry))
+		 (not (eq 'lambda (caadr entry))))
+	    (eval (cadr entry))
+	  (funcall (cadr entry)))))))
+
+(defun nntp-open-network-stream (server)
+  (open-network-stream 
+   "nntpd" nntp-server-buffer server nntp-port-number))
+
+(defun nntp-open-rlogin (server)
+  (let ((proc (if nntp-rlogin-user-name
+		  (start-process
+		   "nntpd" nntp-server-buffer "rsh"
+		   "-l" nntp-rlogin-user-name server
+		   (mapconcat 'identity
+			      nntp-rlogin-parameters " "))
+		(start-process
+		 "nntpd" nntp-server-buffer "rsh" server
+		 (mapconcat 'identity
+			    nntp-rlogin-parameters " ")))))
+    proc))
+
+(defun nntp-telnet-to-machine ()
+  (let (b)
+    (telnet "localhost")
+    (goto-char (point-min))
+    (while (not (re-search-forward "^login: *" nil t))
+      (sit-for 1)
+      (goto-char (point-min)))
+    (goto-char (point-max))
+    (insert "larsi")
+    (telnet-send-input)
+    (setq b (point))
+    (while (not (re-search-forward ">" nil t))
+      (sit-for 1)
+      (goto-char b))
+    (goto-char (point-max))
+    (insert "ls")
+    (telnet-send-input)))
+
+(defun nntp-close-server-internal (&optional server)
+  "Close connection to news server."
+  (nntp-possibly-change-server nil server)
+  (if nntp-server-process
+      (delete-process nntp-server-process))
+  (setq nntp-server-process nil)
+  (setq nntp-address ""))
+
+(defun nntp-accept-response ()
+  "Read response of server.
+It is well-known that the communication speed will be much improved by
+defining this function as macro."
+  ;; To deal with server process exiting before
+  ;;  accept-process-output is called.
+  ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
+  ;; This is a copy of `nntp-default-sentinel'.
+  (let ((buf (current-buffer)))
+    (prog1
+	(if (or (not nntp-server-process)
+		(not (memq (process-status nntp-server-process) '(open run))))
+	    (error "nntp: Process connection closed; %s" (nntp-status-message))
+	  (if nntp-buggy-select
+	      (progn
+		;; We cannot use `accept-process-output'.
+		;; Fujitsu UTS requires messages during sleep-for.
+		;; I don't know why.
+		(nnheader-message 5 "NNTP: Reading...")
+		(sleep-for 1)
+		(nnheader-message 5 ""))
+	    (condition-case errorcode
+		(accept-process-output nntp-server-process 1)
+	      (error
+	       (cond ((string-equal "select error: Invalid argument" 
+				    (nth 1 errorcode))
+		      ;; Ignore select error.
+		      nil)
+		     (t
+		      (signal (car errorcode) (cdr errorcode))))))))
+      (set-buffer buf))))
+
+(defun nntp-last-element (list)
+  "Return last element of LIST."
+  (while (cdr list)
+    (setq list (cdr list)))
+  (car list))
+
+(defun nntp-possibly-change-server (newsgroup server &optional connectionless)
+  "Check whether the virtual server needs changing."
+  (when (and server
+	     (not (nntp-server-opened server)))
+    ;; This virtual server isn't open, so we (re)open it here.
+    (nntp-open-server server nil t))
+  (when (and newsgroup 
+	     (not (equal newsgroup nntp-current-group)))
+    ;; Set the proper current group.
+    (nntp-request-group newsgroup server)))
+ 
+(defun nntp-try-list-active (group)
+  (nntp-list-active-group group)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (goto-char (point-min))
+    (cond ((looking-at "5[0-9]+")
+	   (setq nntp-server-list-active-group nil))
+	  (t
+	   (setq nntp-server-list-active-group t)))))
+
+(defun nntp-async-server-opened ()
+  (and nntp-async-process
+       (memq (process-status nntp-async-process) '(open run))))
+
+(defun nntp-async-open-server ()
+  (save-excursion
+    (set-buffer (generate-new-buffer " *async-nntp*"))
+    (setq nntp-async-buffer (current-buffer))
+    (buffer-disable-undo (current-buffer)))
+  (let ((nntp-server-process nil)
+	(nntp-server-buffer nntp-async-buffer))
+    (nntp-open-server-semi-internal nntp-address nntp-port-number)
+    (if (not (setq nntp-async-process nntp-server-process))
+	(progn
+	  (setq nntp-async-number nil))
+      (set-process-buffer nntp-async-process nntp-async-buffer))))
+
+(defun nntp-async-fetch-articles (article)
+  (if (stringp article)
+      ()
+    (let ((articles (cdr (memq (assq article nntp-async-articles)
+			       nntp-async-articles)))
+	  (max (cond ((numberp nntp-async-number)
+		      nntp-async-number) 
+		     ((eq nntp-async-number t)
+		      (length nntp-async-articles))
+		     (t 0)))
+	  nart)
+      (while (and (>= (setq max (1- max)) 0)
+		  articles)
+	(or (memq (setq nart (caar articles)) nntp-async-fetched)
+	    (progn
+	      (nntp-async-send-strings "ARTICLE " (int-to-string nart))
+	      (setq nntp-async-fetched (cons nart nntp-async-fetched))))
+	(setq articles (cdr articles))))))
+
+(defun nntp-async-send-strings (&rest strings)
+  (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line)))
+    (or (nntp-async-server-opened)
+	(nntp-async-open-server)
+	(error (nntp-status-message)))
+    (process-send-string nntp-async-process cmd)))
+
+(defun nntp-async-request-group (group)
+  (if (equal group nntp-current-group)
+      ()
+    (let ((asyncs (assoc group nntp-async-group-alist)))
+      ;; A new group has been selected, so we push the current state
+      ;; of async articles on an alist, and pull the old state off.
+      (setq nntp-async-group-alist 
+	    (cons (list nntp-current-group
+			nntp-async-articles nntp-async-fetched
+			nntp-async-process)
+		  (delq asyncs nntp-async-group-alist)))
+      (and asyncs
+	   (progn
+	     (setq nntp-async-articles (nth 1 asyncs))
+	     (setq nntp-async-fetched (nth 2 asyncs))
+	     (setq nntp-async-process (nth 3 asyncs)))))))
+
+(provide 'nntp)
+
+;;; nntp.el ends here