;;; cmail-gnuspop3.el --- Post Office Protocol (RFC 1460) interface for cmail

;; Copyright (C) 1996-1999 Free Software Foundation, Inc.

;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;;      Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
;; Keywords: mail, pop3
;; Version: 1.3s-cmail-1.0

;; This file is originally part of GNU Emacs. It has been modified for
;; use by cmail and no longer part of GNU Emacs.

;; ---------------------------------------------------------------------
;; Maintainer: Takeshi Morishima <tm@interaccess.com> for cmail version
;;
;; IMPORTANT NOTE: In order to allow cmail interface to use some low
;; level functions defined in the original pop3.el without causing
;; version incompatibility problems, this module has been duplicated by
;; changing module names. Please try not to make second level
;; modification off this module, use the original pop3.el instead.
;; Any questions about this module should be directed to the maintainer
;; indicated above.
;;
;; CHANGES:
;; Function and variable names has been modified to have prefix of
;; cmail-gnuspop3- instead of pop3- in order to avoid name conflicts.
;; ---------------------------------------------------------------------

;; This program 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.

;; This program 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:

;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
;; are implemented.  The LIST command has not been implemented due to lack
;; of actual usefulness.
;; The optional POP3 command TOP has not been implemented.

;; This program was inspired by Kyle E. Jones's vm-pop program.

;;; Code:

(eval-when-compile (require 'cl))

(require 'mail-utils)

(defconst cmail-gnuspop3-version "1.3s-cmail-1.0")

(defvar cmail-gnuspop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
  "*POP3 maildrop.")
(defvar cmail-gnuspop3-mailhost (or (getenv "MAILHOST") nil)
  "*POP3 mailhost.")
(defvar cmail-gnuspop3-port 110
  "*POP3 port.")
(defvar cmail-gnuspop3-connection-type nil
  "*POP3 connection type.")

(defvar cmail-gnuspop3-password-required t
  "*Non-nil if a password is required when connecting to POP server.")
(defvar cmail-gnuspop3-password nil
  "*Password to use when connecting to POP server.")

(defvar cmail-gnuspop3-authentication-scheme 'pass
  "*POP3 authentication scheme.
Defaults to 'pass, for the standard USER/PASS authentication.  Other valid
values are 'apop.")

(defvar cmail-gnuspop3-timestamp nil
  "Timestamp returned when initially connected to the POP server.
Used for APOP authentication.")

(defvar cmail-gnuspop3-leave-mail-on-server nil
  "Non-nil if mail is to be left on the server and UIDL used for message retrieval.")

(defvar cmail-gnuspop3-maximum-message-size nil
  "If non-nil only download messages smaller than this.")

(defvar cmail-gnuspop3-except-header-regexp nil
  "If non-nil we do not retrieve messages whose headers are matching this regexp.")

(defvar cmail-gnuspop3-uidl-file-name "~/.uidls"
  "File in which to store the UIDL of processed messages.")

(defvar cmail-gnuspop3-uidl-support 'dont-know
  "Whether the server supports UIDL.
Nil means no, t means yes, not-nil-or-t means yet to be determined.")

(defvar cmail-gnuspop3-uidl-obarray (make-vector 31 0)
  "Uidl hash table.")

(defvar cmail-gnuspop3-read-point nil)
(defvar cmail-gnuspop3-debug nil)

(eval-and-compile
  (autoload 'open-ssl-stream "ssl")
  (autoload 'starttls-open-stream "starttls")
  (autoload 'starttls-negotiate "starttls"))

(defvar cmail-gnuspop3-ssl-program-arguments
  '("s_client" "-quiet")
  "Arguments to be passed to the program `cmail-gnuspop3-ssl-program-name'.")

(defun cmail-gnuspop3-progress-message (format percent &rest args)
  (apply (function message) format args))

(defun cmail-gnuspop3-movemail (&optional crashbox)
  "Transfer contents of a maildrop to the specified CRASHBOX."
  (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
  (let* ((process (cmail-gnuspop3-open-server cmail-gnuspop3-mailhost cmail-gnuspop3-port))
	 (crashbuf (get-buffer-create " *cmail-gnuspop3-retr*"))
	 (n 1)
	 (cmail-gnuspop3-password cmail-gnuspop3-password)
	 (cmail-gnuspop3-uidl-file-name
	  (convert-standard-filename
	   (concat cmail-gnuspop3-uidl-file-name "-" cmail-gnuspop3-mailhost)))
	 (retrieved-messages nil)
	 messages message-count)
    ;; for debugging only
    (if cmail-gnuspop3-debug (switch-to-buffer (process-buffer process)))
    ;; query for password
    (if (and cmail-gnuspop3-password-required (not cmail-gnuspop3-password))
	(setq cmail-gnuspop3-password
	      (cmail-gnuspop3-read-passwd (format "Password for %s: " cmail-gnuspop3-maildrop))))
    (cond ((equal 'apop cmail-gnuspop3-authentication-scheme)
	   (cmail-gnuspop3-apop process cmail-gnuspop3-maildrop))
	  ((equal 'pass cmail-gnuspop3-authentication-scheme)
	   (cmail-gnuspop3-user process cmail-gnuspop3-maildrop)
	   (cmail-gnuspop3-pass process))
	  (t (error "Invalid POP3 authentication scheme")))
    ;; get messages that are suitable for download
    (message "Retrieving message list...")
    (setq messages (cmail-gnuspop3-get-message-numbers process)
	  message-count (length (cdr messages)))
    (message "Retrieving message list...%d of %d unread"
	     message-count (pop messages))
    (unwind-protect
	(unless (not (stringp crashbox))
	  (while messages
	    (cmail-gnuspop3-progress-message
	     "Retrieving message %d of %d (%d octets) from %s..."
	     (floor (* (/ (float n) message-count) 100))
	     n message-count (cdar messages) cmail-gnuspop3-mailhost)
	    (cmail-gnuspop3-retr process (caar messages) crashbuf)
	    (push (caar messages) retrieved-messages)
	    (setq messages (cdr messages)
		  n (1+ n)))
	  (with-current-buffer crashbuf
	    (write-region-as-binary (point-min) (point-max)
				    crashbox 'append 'nomesg))
	  ;; mark messages as read
	  (when cmail-gnuspop3-leave-mail-on-server
	    (cmail-gnuspop3-save-uidls))
	  ;; now delete the messages we have retrieved
	  (unless cmail-gnuspop3-leave-mail-on-server
	    (dolist (n retrieved-messages)
	      (message "Deleting message %d of %d from %s..."
		       n message-count cmail-gnuspop3-mailhost)
	      (cmail-gnuspop3-dele process n)))
	  )
      (cmail-gnuspop3-quit process))
    (kill-buffer crashbuf)
    message-count))

(defun cmail-gnuspop3-get-message-count ()
  "Return the number of messages in the maildrop."
  (let* ((process (cmail-gnuspop3-open-server cmail-gnuspop3-mailhost cmail-gnuspop3-port))
	 message-count
	 (cmail-gnuspop3-password cmail-gnuspop3-password)
	 )
    ;; for debugging only
    (if cmail-gnuspop3-debug (switch-to-buffer (process-buffer process)))
    ;; query for password
    (if (and cmail-gnuspop3-password-required (not cmail-gnuspop3-password))
	(setq cmail-gnuspop3-password
	      (cmail-gnuspop3-read-passwd (format "Password for %s: " cmail-gnuspop3-maildrop))))
    (cond ((equal 'apop cmail-gnuspop3-authentication-scheme)
	   (cmail-gnuspop3-apop process cmail-gnuspop3-maildrop))
	  ((equal 'pass cmail-gnuspop3-authentication-scheme)
	   (cmail-gnuspop3-user process cmail-gnuspop3-maildrop)
	   (cmail-gnuspop3-pass process))
	  (t (error "Invalid POP3 authentication scheme.")))
    (setq message-count (car (cmail-gnuspop3-stat process)))
    (cmail-gnuspop3-quit process)
    message-count))

(defun cmail-gnuspop3-open-server (mailhost port)
  "Open TCP connection to MAILHOST.
Returns the process associated with the connection.
Argument PORT specifies connecting port."
  (let ((process-buffer
	 (get-buffer-create (format "trace of POP session to %s" mailhost)))
	(process))
    (save-excursion
      (set-buffer process-buffer)
      (erase-buffer))
    (setq
     process
     (cond
      ((eq cmail-gnuspop3-connection-type 'ssl)
       (cmail-gnuspop3-open-ssl-stream "POP" process-buffer mailhost port))
      ((eq cmail-gnuspop3-connection-type 'tls)
       (cmail-gnuspop3-open-tls-stream "POP" process-buffer mailhost port))
      (t
       (open-network-stream-as-binary "POP" process-buffer mailhost port))))
    (setq cmail-gnuspop3-read-point (point-min))
    (let ((response (cmail-gnuspop3-read-response process t)))
      (setq cmail-gnuspop3-timestamp
	    (substring response (or (string-match "<" response) 0)
		       (+ 1 (or (string-match ">" response) -1)))))
    process))

(defun cmail-gnuspop3-open-ssl-stream-1 (name buffer host service extra-arg)
  (require 'path-util)
  (let* ((ssl-program-name
	  (cond ((exec-installed-p "openssl")
		 "openssl")
		(t
		 "ssleay")))
	 (ssl-program-arguments
	  `(,@cmail-gnuspop3-ssl-program-arguments ,extra-arg
	    "-connect" ,(format "%s:%d" host service)))
         (process (open-ssl-stream name buffer host service)))
    (when process
      (with-current-buffer buffer
	(goto-char (point-min))
	(while (and (memq (process-status process) '(open run))
                    (goto-char (point-max))
                    (forward-line -1)
                    (not (looking-at "+OK")))
          (accept-process-output process 1)
          (sit-for 1))
	(delete-region (point-min) (point)))
      (and process (memq (process-status process) '(open run))
	   process))))

(defun cmail-gnuspop3-open-ssl-stream (name buffer host service)
  "Open a SSL connection for a service to a host.
Returns a subprocess-object to represent the connection.
Args are NAME BUFFER HOST SERVICE."
  (cond ((eq system-type 'windows-nt)
	 (let (selective-display
	       (coding-system-for-write 'binary)
	       (coding-system-for-read 'raw-text-dos))
	   (or (cmail-gnuspop3-open-ssl-stream-1 name buffer host service "-ssl3")
	       (cmail-gnuspop3-open-ssl-stream-1 name buffer host service "-ssl2"))))
	(t
	 (as-binary-process
	   (or (cmail-gnuspop3-open-ssl-stream-1 name buffer host service "-ssl3")
	       (cmail-gnuspop3-open-ssl-stream-1 name buffer host service "-ssl2"))))))

(defun cmail-gnuspop3-open-tls-stream (name buffer host service)
  "Open a TLSv1 connection for a service to a host.
Returns a subprocess-object to represent the connection.
Args are NAME BUFFER HOST SERVICE."
  (let ((process
	 (as-binary-process (starttls-open-stream
			     name buffer host service))))
    (cmail-gnuspop3-stls process)
    (starttls-negotiate process)
    process))

;; Support functions

(defun cmail-gnuspop3-process-filter (process output)
  (save-excursion
    (set-buffer (process-buffer process))
    (goto-char (point-max))
    (insert output)))

(defun cmail-gnuspop3-send-command (process command)
  (set-buffer (process-buffer process))
  (goto-char (point-max))
  ;;    (if (= (aref command 0) ?P)
  ;;	(insert "PASS <omitted>\r\n")
  ;;      (insert command "\r\n"))
  (setq cmail-gnuspop3-read-point (point))
  (goto-char (point-max))
  (process-send-string process (concat command "\r\n"))
  )

(defun cmail-gnuspop3-read-response (process &optional return)
  "Read the response from the server PROCESS.
Return the response string if optional second argument RETURN is non-nil."
  (let ((case-fold-search nil)
	match-end)
    (save-excursion
      (set-buffer (process-buffer process))
      (goto-char cmail-gnuspop3-read-point)
      (while (not (search-forward "\r\n" nil t))
	(accept-process-output process 3)
	(goto-char cmail-gnuspop3-read-point))
      (setq match-end (point))
      (goto-char cmail-gnuspop3-read-point)
      (if (looking-at "-ERR")
	  (signal 'error (list (buffer-substring (point) (- match-end 2))))
	(if (not (looking-at "+OK"))
	    (progn (setq cmail-gnuspop3-read-point match-end) nil)
	  (setq cmail-gnuspop3-read-point match-end)
	  (if return
	      (buffer-substring (point) match-end)
	    t)
	  )))))

(defvar cmail-gnuspop3-read-passwd nil)
(defun cmail-gnuspop3-read-passwd (prompt)
  (if (not cmail-gnuspop3-read-passwd)
      (if (functionp 'read-passwd)
	  (setq cmail-gnuspop3-read-passwd 'read-passwd)
	(if (load "passwd" t)
	    (setq cmail-gnuspop3-read-passwd 'read-passwd)
	  (autoload 'ange-ftp-read-passwd "ange-ftp")
	  (setq cmail-gnuspop3-read-passwd 'ange-ftp-read-passwd))))
  (funcall cmail-gnuspop3-read-passwd prompt))

(defun cmail-gnuspop3-clean-region (start end)
  (setq end (set-marker (make-marker) end))
  (save-excursion
    (goto-char start)
    (while (and (< (point) end) (search-forward "\r\n" end t))
      (replace-match "\n" t t))
    (goto-char start)
    (while (re-search-forward "\n\n\\(From \\)" end t)
      (replace-match "\n\n>\\1" t nil))
    (goto-char start)
    (while (and (< (point) end) (re-search-forward "^\\." end t))
      (replace-match "" t t)
      (forward-char)))
  (set-marker end nil))

(defun cmail-gnuspop3-munge-message-separator (start end)
  "Check to see if a message separator exists.  If not, generate one."
  (if (not (fboundp 'parse-time-string))
      (autoload 'parse-time-string "parse-time"))
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (if (not (or (looking-at "From .?") ; Unix mail
		   (looking-at "\001\001\001\001\n") ; MMDF
		   (looking-at "BABYL OPTIONS:") ; Babyl
		   ))
	  (let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
		(date (mail-fetch-field "Date"))
		(From_))
	    ;; sample date formats I have seen
	    ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
	    ;; Date: 08 Jul 1996 23:22:24 -0400
	    ;; should be
	    ;; Tue Jul 9 09:04:21 1996
	    (setq date (format-time-string
			"%a %b %e %T %Y"
			(if date
			    (condition-case nil
				(apply 'encode-time (parse-time-string date))
			      (error (current-time)))
			  (current-time))))
	    (setq From_ (format "\nFrom %s  %s\n" from date))
	    (while (string-match "," From_)
	      (setq From_ (concat (substring From_ 0 (match-beginning 0))
				  (substring From_ (match-end 0)))))
	    (goto-char (point-min))
	    (insert From_))))))

;; UIDL support

(defun cmail-gnuspop3-get-message-numbers (process)
  "Get the list of message numbers and lengths to retrieve via PROCESS."
  ;; we use the LIST comand first anyway to get the message lengths.
  ;; then if we're leaving mail on the server, see if the UIDL command
  ;; is implemented. if so, we use it to get the message number list.
  (let* ((messages (cmail-gnuspop3-list process))
	 (total (or (pop messages) 0))
	 (uidl (if cmail-gnuspop3-leave-mail-on-server
		   (cmail-gnuspop3-get-uidl process)))
	 out)
    (while messages
      ;; only retrieve messages matching our regexp or in the uidl list
      (when (and
	     ;; remove elements not in the uidl, this assumes the uidl is short
	     (or (not (eq cmail-gnuspop3-uidl-support t))
		 (memq (caar messages) uidl))
	     (caar messages)
	     ;; don't download messages that are too large
	     (not (and cmail-gnuspop3-maximum-message-size
		       (> (cdar messages) cmail-gnuspop3-maximum-message-size)))
	     (not (and cmail-gnuspop3-except-header-regexp
		       (string-match cmail-gnuspop3-except-header-regexp
				     (cmail-gnuspop3-top process (caar messages) 0)))))
	(push (car messages) out))
      (setq messages (cdr messages)))
    (cons total (reverse out))))

(defun cmail-gnuspop3-get-uidl (process)
  "Use PROCESS to get a list of unread message numbers."
  (let ((messages (cmail-gnuspop3-uidl process)) uidl)
    (if (or (null messages) (null cmail-gnuspop3-uidl-support))
	(setq cmail-gnuspop3-uidl-support nil)
      (setq cmail-gnuspop3-uidl-support t)
      (save-excursion
	(with-temp-buffer
	  (when (file-readable-p cmail-gnuspop3-uidl-file-name)
	    (insert-file-contents cmail-gnuspop3-uidl-file-name))
	  (goto-char (point-min))
	  (while (looking-at "\\([^ \n\t]+\\)")
	    (set (intern (match-string 1) cmail-gnuspop3-uidl-obarray)
		 (cons nil t))
	    (forward-line 1))
	  ))
      (dolist (message (cdr messages))
	(if (setq uidl (intern-soft (cdr message) cmail-gnuspop3-uidl-obarray))
	    (setcar (symbol-value uidl) (car message))
	  (set (intern (cdr message) cmail-gnuspop3-uidl-obarray)
	       (cons (car message) nil))))
      (cmail-gnuspop3-get-unread-message-numbers))
    ))

(defun cmail-gnuspop3-get-unread-message-numbers ()
  "Return a sorted list of unread msg numbers to retrieve."
  (let (nums)
    (mapatoms (lambda (atom)
		(if (not (cdr (symbol-value atom)))
		    (push (car (symbol-value atom)) nums)))
	      cmail-gnuspop3-uidl-obarray)
    (sort nums '<)))

(defun cmail-gnuspop3-save-uidls ()
  "Save the updated UIDLs to disk for use next time."
  (when (and cmail-gnuspop3-leave-mail-on-server
	     ;; UIDL hash table is non-empty
	     (let ((len (length cmail-gnuspop3-uidl-obarray)))
	       (while (< 0 len)
		 (setq len (if (symbolp (aref cmail-gnuspop3-uidl-obarray (1- len)))
			       -1 (1- len))))
	       (minusp len)))
    (when (file-readable-p cmail-gnuspop3-uidl-file-name)
      (copy-file cmail-gnuspop3-uidl-file-name
		 (concat cmail-gnuspop3-uidl-file-name ".old")
		 'overwrite 'keeptime))
    (save-excursion
      (with-temp-file cmail-gnuspop3-uidl-file-name
	(mapatoms
	 (lambda (atom)
	   (when (car (symbol-value atom))
	     (insert (format "%s\n" atom))))
	 cmail-gnuspop3-uidl-obarray)))))
    

;; The Command Set

;; AUTHORIZATION STATE

(defun cmail-gnuspop3-user (process user)
  "Send USER information to POP3 server."
  (cmail-gnuspop3-send-command process (format "USER %s" user))
  (let ((response (cmail-gnuspop3-read-response process t)))
    (if (not (and response (string-match "+OK" response)))
	(error (format "USER %s not valid." user)))))

(defun cmail-gnuspop3-pass (process)
  "Send authentication information to the server."
  (cmail-gnuspop3-send-command process (format "PASS %s" cmail-gnuspop3-password))
  (let ((response (cmail-gnuspop3-read-response process t)))
    (if (not (and response (string-match "+OK" response)))
	(cmail-gnuspop3-quit process))))

(autoload 'md5 "md5")

(defun cmail-gnuspop3-apop (process user)
  "Send alternate authentication information to the server."
  (let ((hash (md5 (concat cmail-gnuspop3-timestamp cmail-gnuspop3-password))))
    (cmail-gnuspop3-send-command process (format "APOP %s %s" user hash))
    (let ((response (cmail-gnuspop3-read-response process t)))
      (if (not (and response (string-match "+OK" response)))
	  (cmail-gnuspop3-quit process)))))

(defun cmail-gnuspop3-stls (process)
  "Query whether TLS extension is supported"
  (cmail-gnuspop3-send-command process "STLS")
  (let ((response (cmail-gnuspop3-read-response process t)))
    (if (not (and response (string-match "+OK" response)))
	(cmail-gnuspop3-quit process))))

;; TRANSACTION STATE

(defun cmail-gnuspop3-stat (process)
  "Return the number of messages in the maildrop and the maildrop's size."
  (cmail-gnuspop3-send-command process "STAT")
  (let ((response (cmail-gnuspop3-read-response process t)))
    (list (string-to-int (nth 1 (split-string response)))
	  (string-to-int (nth 2 (split-string response))))
    ))

(defun cmail-gnuspop3-retr (process msg crashbuf)
  "Retrieve message-id MSG to buffer CRASHBUF."
  (cmail-gnuspop3-send-command process (format "RETR %s" msg))
  (cmail-gnuspop3-read-response process)
  (save-excursion
    (let ((region (cmail-gnuspop3-get-extended-response process)))
      (cmail-gnuspop3-munge-message-separator (car region) (cadr region))
      (append-to-buffer crashbuf (car region) (cadr region))
      (delete-region (car region) (cadr region))
      )))

(defun cmail-gnuspop3-dele (process msg)
  "Mark message-id MSG as deleted."
  (cmail-gnuspop3-send-command process (format "DELE %s" msg))
  (cmail-gnuspop3-read-response process))

(defun cmail-gnuspop3-noop (process msg)
  "No-operation."
  (cmail-gnuspop3-send-command process "NOOP")
  (cmail-gnuspop3-read-response process))

(defun cmail-gnuspop3-last (process)
  "Return highest accessed message-id number for the session."
  (cmail-gnuspop3-send-command process "LAST")
  (let ((response (cmail-gnuspop3-read-response process t)))
    (string-to-int (nth 1 (split-string response)))
    ))

(defun cmail-gnuspop3-rset (process)
  "Remove all delete marks from current maildrop."
  (cmail-gnuspop3-send-command process "RSET")
  (cmail-gnuspop3-read-response process))

;; UPDATE

(defun cmail-gnuspop3-quit (process)
  "Close connection to POP3 server.
Tell server to remove all messages marked as deleted, unlock the maildrop,
and close the connection."
  (cmail-gnuspop3-send-command process "QUIT")
  (cmail-gnuspop3-read-response process t)
  (when process
    (save-excursion
      (set-buffer (process-buffer process))
      (goto-char (point-max))
      (delete-process process)
      ))
  (when cmail-gnuspop3-leave-mail-on-server
    (mapatoms
     (lambda (atom)
       (when (car (symbol-value atom))
	 (unintern atom cmail-gnuspop3-uidl-obarray)))
     cmail-gnuspop3-uidl-obarray)))

(defun cmail-gnuspop3-uidl (process &optional msgno)
  "Return the results of a UIDL command in PROCESS for optional MSGNO.
If UIDL is unsupported on this mail server or if msgno is invalid, return nil.
Otherwise, return a list in the form

   (N (1 UIDL-1) (2 UIDL-2) ... (N UIDL-N))

where

   N is an integer for the number of UIDLs returned (could be 0)
   UIDL-n is a string."

  (if msgno
      (cmail-gnuspop3-send-command process (format "UIDL %d" msgno))
    (cmail-gnuspop3-send-command process "UIDL"))
  
  (if (null (cmail-gnuspop3-read-response process t))
      nil ;; UIDL is not supported on this server
    (let (pairs uidl)
      (save-excursion
	(save-restriction
	  (apply 'narrow-to-region (cmail-gnuspop3-get-extended-response process))
	  (goto-char (point-min))
	  (while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
	    (setq msgno (string-to-int (match-string 1))
		  uidl (match-string 2))
	    (push (cons msgno uidl) pairs)
	    (beginning-of-line 2))
	  (cons (length pairs) (nreverse pairs))
	  )))))

(defun cmail-gnuspop3-list (process &optional msgno)
  "Return the results of a LIST command for PROCESS and optional MSGNO.
If (optional) msgno is invalid, return nil.  Otherwise, return a list
in the form

   (N (1 LEN-1) (2 LEN-2) ... (N LEN-N))

where

   N is an integer for the number of msg/len pairs (could be 0)
   LEN-n is an integer."
  (if msgno
      (cmail-gnuspop3-send-command process (format "LIST %d" msgno))
    (cmail-gnuspop3-send-command process "LIST"))

  (if (null (cmail-gnuspop3-read-response process t))
      nil ;; MSGNO is not valid number
    (let (pairs len)
      (save-excursion
	(save-restriction
	  (apply 'narrow-to-region (cmail-gnuspop3-get-extended-response process))
	  (goto-char (point-min))
	  (while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
	    (setq msgno (string-to-int (match-string 1))
		  len (string-to-int (match-string 2)))
	    (push (cons msgno len) pairs)
	    (beginning-of-line 2))
	  (cons (length pairs) (nreverse pairs))
	  )))))

(defun cmail-gnuspop3-top (process msgno &optional lines)
  "Return the top LINES of messages for PROCESS and MSGNO.
If msgno is invalid, return nil.  Otherwise, return a string."
  (cmail-gnuspop3-send-command process (format "TOP %d %d" msgno (or lines 1)))
  (if (cmail-gnuspop3-read-response process t)
      nil ;; MSGNO is not valid number
    (save-excursion
      (apply 'buffer-substring (cmail-gnuspop3-get-extended-response process)))
    ))

;;; Utility code

(defun cmail-gnuspop3-get-extended-response (process)
  "Get the extended pop3 response in the PROCESS buffer."
  (let ((start cmail-gnuspop3-read-point) end)
    (set-buffer (process-buffer process))
    (goto-char start)
    (while (not (re-search-forward "^\\.\r\n" nil t))
      (accept-process-output process 3)
      (goto-char start))
    (setq cmail-gnuspop3-read-point (point-marker))
    (goto-char (match-beginning 0))
    (setq end (point-marker))
    (cmail-gnuspop3-clean-region start end)
    (list start end)))


;; Summary of POP3 (Post Office Protocol version 3) commands and responses

;;; AUTHORIZATION STATE

;; Initial TCP connection
;; Arguments: none
;; Restrictions: none
;; Possible responses:
;;  +OK [POP3 server ready]

;; USER name
;; Arguments: a server specific user-id (required)
;; Restrictions: authorization state [after unsuccessful USER or PASS
;; Possible responses:
;;  +OK [valid user-id]
;;  -ERR [invalid user-id]

;; PASS string
;; Arguments: a server/user-id specific password (required)
;; Restrictions: authorization state, after successful USER
;; Possible responses:
;;  +OK [maildrop locked and ready]
;;  -ERR [invalid password]
;;  -ERR [unable to lock maildrop]

;; STLS
;; Arguments: none
;; Restrictions: authorization state
;; Possible responses:
;;  +OK [negotiation is ready]
;;  -ERR [security layer is already active]

;;; TRANSACTION STATE

;; STAT
;; Arguments: none
;; Restrictions: transaction state
;; Possible responses:
;;  +OK nn mm [# of messages, size of maildrop]

;; LIST [msg]
;; Arguments: a message-id (optional)
;; Restrictions: transaction state; msg must not be deleted
;; Possible responses:
;;  +OK [scan listing follows]
;;  -ERR [no such message]

;; TOP msg [lines]
;; Arguments: a message-id (required), number of lines (optional)
;; Restrictions: transaction state; msg must not be deleted
;; Possible responses:
;;  +OK [partial message listing follows]
;;  -ERR [no such message]

;; UIDL [msg]
;; Arguments: a message-id (optional)
;; Restrictions: transaction state; msg must not be deleted
;; Possible responses:
;;  +OK [uidl listing follows]
;;  -ERR [no such message]

;; RETR msg
;; Arguments: a message-id (required)
;; Restrictions: transaction state; msg must not be deleted
;; Possible responses:
;;  +OK [message contents follow]
;;  -ERR [no such message]

;; DELE msg
;; Arguments: a message-id (required)
;; Restrictions: transaction state; msg must not be deleted
;; Possible responses:
;;  +OK [message deleted]
;;  -ERR [no such message]

;; NOOP
;; Arguments: none
;; Restrictions: transaction state
;; Possible responses:
;;  +OK

;; LAST
;; Arguments: none
;; Restrictions: transaction state
;; Possible responses:
;;  +OK nn [highest numbered message accessed]

;; RSET
;; Arguments: none
;; Restrictions: transaction state
;; Possible responses:
;;  +OK [all delete marks removed]

;;; UPDATE STATE

;; QUIT
;; Arguments: none
;; Restrictions: none
;; Possible responses:
;;  +OK [TCP connection closed]

(provide 'cmail-gnuspop3)

;;; cmail-gnuspop3.el ends here
