new file mode 100644

@@ -0,0 +1,11 @@

+1999-09-27  John Foderaro  <jkf@tiger.franz.com>

+version 1.0

+	* start ChangeLog.

+	* imap.cl - the code for the imap and pop interface

+	* imap.html - the documentation

+	* t-imap.cl - the test suite

+	* rfc1939.html - pop spec

+	* rfc2060.txt  - imap spec

+	

+	

+

@@ -1,8 +1,8 @@

 ;; imap protocol

 ;; (with hooks for pop too)

-(defpackage :mailbox

-  (:nicknames :mb)

+(defpackage :post-office

+  (:nicknames :po)

   (:use :lisp :excl)

   (:export 

    #:address-name

@@ -11,7 +11,7 @@

    #:address-host

    #:alter-flags

-   #:close-imap-connection

+   #:close-connection

    #:close-mailbox

    #:copy-to-mailbox

    #:create-mailbox

@@ -32,6 +32,8 @@

    #:expunge-mailbox

    #:fetch-field

    #:fetch-letter

+   #:fetch-parts

+   #:*imap-version-number*

    #:mailbox-flags      ; accessor

    #:mailbox-permanent-flags ; acc

    #:mailbox-list

@@ -43,6 +45,7 @@

    #:mailbox-separator  ; accessor

    #:mailbox-uidvalidity

    #:make-imap-connection

+   #:make-pop-connection

    #:noop

    #:rename-mailbox

    #:search-mailbox

@@ -50,41 +53,26 @@

    )

   )

-(in-package :mailbox)

-

-; kinds of things that come back from the server

-; <tag> OK random text 

-; <tag> OK [atom] random text 

-; <tag> OK [atom value] random text

-; * <number> atom random text

-; * LIST (atom ...) string string

-; * STATUS mboxname (atom value .... ...)

-; * CAPABILITY atom ...

-

-; our parsing will return

-; tag

-;    a string or :untagged or :continue

-; command 

-;    the string like "OK" which describes what this response is saying

-; args

-;    list of arguments.

-;       

+(in-package :post-office)

+

+

+(defparameter *imap-version-number* '(:major 1 :minor 0)) ; major.minor

 (defvar *debug-imap* nil)

-(defclass mailbox ()

+(defclass post-office ()

   ((socket :initarg :socket

-	   :accessor mailbox-socket)

+	   :accessor post-office-socket)

    (host :initarg :host

-	 :accessor  mailbox-host

+	 :accessor  post-office-host

 	 :initform nil)

    (user  :initarg :user

-	  :accessor mailbox-user

+	  :accessor post-office-user

 	  :initform nil)

-   (state :accessor mailbox-state

+   (state :accessor post-office-state

 	  :initarg :state

 	  :initform :unconnected)

@@ -96,7 +84,7 @@

     :accessor timeout) 

   ))

-(defclass imap-mailbox (mailbox)

+(defclass imap-mailbox (post-office)

   ((mailbox-name   ; currently selected mailbox

     :accessor mailbox-name

     :initform nil)

@@ -136,13 +124,15 @@

     :accessor first-unseen

     :initform 0)

-   ;;; end list of values for the currently selected maibox

+   ;;; end list of values for the currently selected mailbox

    )

   )

-(defclass pop-mailbox (mailbox)

-  ())

+(defclass pop-mailbox (post-office)

+  ((message-count  ; how many in the mailbox

+    :accessor mailbox-message-count

+    :initform 0)))

@@ -222,9 +212,9 @@

     imap))

-(defmethod close-imap-connection ((mb imap-mailbox))

+(defmethod close-connection ((mb imap-mailbox))

-  (let ((sock (mailbox-socket mb)))

+  (let ((sock (post-office-socket mb)))

     (if* sock

        then (ignore-errors

 	     (send-command-get-results 

@@ -238,20 +228,62 @@

 	      #'(lambda (mb command count extra)

 		  (check-for-success mb command count extra

 				     "logout")))))

-    (setf (mailbox-socket mb) nil)

+    (setf (post-office-socket mb) nil)

+    (if* sock then (ignore-errors (close sock)))

+    t))

+

+

+(defmethod close-connection ((pb pop-mailbox))

+  (let ((sock (post-office-socket pb)))

+    (if* sock

+       then (ignore-errors

+	     (send-pop-command-get-results 

+	      pb

+	      "QUIT")))

+    (setf (post-office-socket pb) nil)

     (if* sock then (ignore-errors (close sock)))

     t))

+

+(defun make-pop-connection (host &key (port 110)

+				      user

+				      password

+				      (timeout 30))

+  (let* ((sock (socket:make-socket :remote-host host

+				   :remote-port port))

+	 (pop (make-instance 'pop-mailbox

+		:socket sock

+		:host   host

+		:timeout timeout

+		:state :unauthorized)))

+    

+    (multiple-value-bind (result)

+	(get-and-parse-from-pop-server pop)

+      (if* (not (eq :ok result))

+	 then  (error "unexpected line from server after connect")))

+      

+    ; now login

+    (send-pop-command-get-results pop (format nil "user ~a" user))

+    (send-pop-command-get-results pop (format nil "pass ~a" password))

+

+    (let ((res (send-pop-command-get-results pop "stat")))

+      (setf (mailbox-message-count pop) (car res)))

+    

+    			    

+				    

+    pop))

+			    

+

 (defmethod send-command-get-results ((mb imap-mailbox) 

 				     command untagged-handler tagged-handler)

   ;; send a command and retrieve results until we get the tagged

   ;; response for the command we sent

   ;;

   (let ((tag (get-next-tag)))

-    (format (mailbox-socket mb)

+    (format (post-office-socket mb)

 	    "~a ~a~a" tag command *crlf*)

-    (force-output (mailbox-socket mb))

+    (force-output (post-office-socket mb))

     (if* *debug-imap*

        then (format t

@@ -284,7 +316,7 @@

     (:recent (setf (mailbox-recent-messages mb) count))

     (:flags  (setf (mailbox-flags mb) (mapcar #'kwd-intern extra)))

     (:bye ; occurs when connection times out or mailbox lock is stolen

-     (ignore-errors (close (mailbox-socket mb)))

+     (ignore-errors (close (post-office-socket mb)))

      (error "connection to the imap server was closed by the server"))

     (:no ; used when grabbing a lock from another process

      (warn "grabbing mailbox lock from another process"))

@@ -304,6 +336,69 @@

   )

+

+

+(defun send-pop-command-get-results (pop command &optional extrap)

+  ;; if extrap is true then we're expecting data to follow an +ok

+  (format (post-office-socket pop) "~a~a" command *crlf*)

+  (force-output (post-office-socket pop))

+  

+  (if* *debug-imap*

+     then (format t "~a~a" command *crlf*)

+	  (force-output t))

+

+  (multiple-value-bind (result parsed line)

+      (get-and-parse-from-pop-server pop)

+    (if* (not (eq result :ok))

+       then (error "error from pop server: ~a" line))

+

+    (if* extrap

+       then ; get the rest of the data

+	    

+	    (let ((buf (get-line-buffer (+ (car parsed) 50)))

+		  (pos 0)

+		  ; states

+		  ;  1 - after lf

+		  ;  2 - seen dot at beginning of line

+		  ;  3 - seen regular char on line

+		  (state 1)

+		  (sock (post-office-socket pop)))

+	      (flet ((add-to-buffer (ch)

+		       (if* (>= pos (length buf))

+			  then (error "missinfomation from pop")

+			  else (setf (schar buf pos) ch)

+			       (incf pos))))

+		(loop

+		  (let ((ch (read-char sock nil nil)))

+		    (if* (null ch)

+		       then (error "premature end of file from server"))

+		    (if* (eq ch #\return)

+		       thenret ; ignore crs

+		       else (case state

+			      (1 (if* (eq ch #\.)

+				    then (setq state 2)

+				  elseif (eq ch #\linefeed)

+				    then (add-to-buffer ch)

+					 ; state stays at 1

+				    else (add-to-buffer ch)

+					 (setq state 3)))

+			      (2 ; seen first dot

+			       (if* (eq ch #\linefeed)

+				  then ; end of message

+				       (return)

+				  else (add-to-buffer ch)

+				       (setq state 3)))

+			      (3 ; normal reading

+			       (add-to-buffer ch)

+			       (if* (eq ch #\linefeed)

+				  then (setq state 1))))))))

+	      (prog1 (subseq buf 0 pos)

+		(free-line-buffer buf)))

+       else parsed)))

+  

+

+  

+  

 (defun convert-flags-plist (plist)

   ;; scan the plist looking for "flags" indicators and 

   ;; turn value into a list of symbols rather than strings

@@ -313,8 +408,8 @@

        then (setf (cadr xx) (mapcar #'kwd-intern (cadr xx))))))

-(defun select-mailbox (mb name)

-  ;; select the given maibox

+(defmethod select-mailbox ((mb imap-mailbox) name)

+  ;; select the given mailbox

   (send-command-get-results mb

 			    (format nil "select ~a" name)

 			    #'handle-untagged-response

@@ -327,8 +422,21 @@

   )

+(defmethod fetch-letter ((mb imap-mailbox) number &key uid)

+  ;; return the whole letter

+  (fetch-field number "body[]"

+	       (fetch-parts mb number "body[]" :uid uid)

+	       :uid uid))

-(defun fetch-letter (mb number parts &key uid)

+

+(defmethod fetch-letter ((pb pop-mailbox) number &key uid)

+  (declare (ignore uid))

+  (send-pop-command-get-results pb 

+				(format nil "RETR ~d" number) 

+				t ; extra stuff

+				))

+

+(defmethod fetch-parts ((mb imap-mailbox) number parts &key uid)

   (let (res)

     (send-command-get-results 

      mb

@@ -394,15 +502,42 @@

-(defun delete-letter (mb messages &key (expunge t) uid)

+(defmethod delete-letter ((mb imap-mailbox) messages &key (expunge t) uid)

   ;; delete all the mesasges and do the expunge to make 

   ;; it permanent if expunge is true

   (alter-flags mb messages :add-flags :\\deleted :uid uid)

   (if* expunge then (expunge-mailbox mb)))

+

+(defmethod delete-letter ((pb pop-mailbox) messages  &key (expunge nil) uid)

+  ;; delete all the messages.   We can't expunge without quitting so

+  ;; we don't expunge

+  (declare (ignore expunge uid))

+  

+  (if* (or (numberp messages) 

+	   (and (consp messages) (eq :seq (car messages))))

+     then (setq messages (list messages)))

+  

+  (if* (not (consp messages))

+     then (error "expect a mesage number or list of messages, not ~s"

+		 messages))

+  

+  (dolist (message messages)

+    (if* (numberp message)

+       then (send-pop-command-get-results pb

+					  (format nil "DELE ~d" message))

+     elseif (and (consp message) (eq :seq (car message)))

+       then (do ((start (cadr message) (1+ start))

+		 (end (caddr message)))

+		((> start end))

+	      (send-pop-command-get-results pb

+					    (format nil "DELE ~d" start)))

+       else (error "bad message number ~s" message))))

+	    

+	    

-(defun noop (mb)

+(defmethod noop ((mb imap-mailbox))

   ;; just poke the server... keeping it awake and checking for

   ;; new letters

   (send-command-get-results mb

@@ -414,6 +549,13 @@

 				 "noop"))))

+(defmethod noop ((pb pop-mailbox))

+  ;; send the stat command instead so we can update the message count

+  (let ((res (send-pop-command-get-results pb "stat")))

+      (setf (mailbox-message-count pb) (car res)))

+  )

+

+

 (defun check-for-success (mb command count extra command-string)

   (declare (ignore mb count extra))

   (if* (not (eq command :ok))

@@ -423,7 +565,7 @@

-(defun mailbox-list (mb &key (reference "") (pattern ""))

+(defmethod mailbox-list ((mb imap-mailbox) &key (reference "") (pattern ""))

   ;; return a list of mailbox names with respect to a given

   (let (res)

     (send-command-get-results mb

@@ -447,7 +589,7 @@

     ))

-(defun create-mailbox (mb mailbox-name)

+(defmethod create-mailbox ((mb imap-mailbox) mailbox-name)

   ;; create a mailbox name of the given name.

   ;; use mailbox-separator if you want to create a hierarchy

   (send-command-get-results mb

@@ -459,7 +601,7 @@

   t)

-(defun delete-mailbox (mb mailbox-name)

+(defmethod delete-mailbox ((mb imap-mailbox) mailbox-name)

   ;; create a mailbox name of the given name.

   ;; use mailbox-separator if you want to create a hierarchy

   (send-command-get-results mb

@@ -469,7 +611,7 @@

 				  (check-for-success 

 				   mb command count extra "delete"))))

-(defun rename-mailbox (mb old-mailbox-name new-mailbox-name)

+(defmethod rename-mailbox ((mb imap-mailbox) old-mailbox-name new-mailbox-name)

   ;; create a mailbox name of the given name.

   ;; use mailbox-separator if you want to create a hierarchy

   (send-command-get-results mb

@@ -483,7 +625,9 @@

-(defun alter-flags (mb messages &key (flags nil flags-p) add-flags remove-flags

+(defmethod alter-flags ((mb imap-mailbox)

+			messages &key (flags nil flags-p) 

+				      add-flags remove-flags

 				      silent uid)

   ;;

   ;; change the flags using the store command

@@ -598,7 +742,7 @@

 ;; search command

-(defun search-mailbox (mb search-expression &key uid)

+(defmethod search-mailbox ((mb imap-mailbox) search-expression &key uid)

   (let (res)

     (send-command-get-results mb

 			      (format nil "~asearch ~a" 

@@ -816,6 +960,22 @@

     ))

+

+(defmethod get-and-parse-from-pop-server ((mb pop-mailbox))

+  ;; read the next line from the pop server

+  ;; return the result of parsing it

+  (multiple-value-bind (line count)

+      (get-line-from-server mb)

+    

+    (if* *debug-imap* 

+       then (format t "from server: " count)

+	    (dotimes (i count)(write-char (schar line i)))

+	    (terpri))

+    

+    (parse-pop-response line count)))

+

+  

+  

 ;; Parse and return the data from each line

 ;; values returned

 ;;  tag -- either a string or the symbol :untagged

@@ -911,7 +1071,42 @@

        (values kind nil next))

       (t (error "bad sexpression")))))

+

+(defun parse-pop-response (line end)

+  ;; return values:

+  ;;   :ok or :error 

+  ;;   a list of rest of the tokens on the line

+  ;;   the whole line after the +ok or -err

+  ;;

+  (let (res lineres result)

+    (multiple-value-bind (kind value next)

+	(get-next-token line 0 end)

+    

+      (case kind

+	(:string (setq result (if* (equal "+OK" value) 

+				 then :ok

+				 else :error)))

+	(t (error "bad response from server: ~s" (subseq line 0 end))))

+      (setq lineres (subseq line next end))

+

+      (loop

+	(multiple-value-setq (kind value next)

+	  (get-next-token line next end))

+	

+	(case kind

+	  (:eof (return))

+	  ((:string :number) (push value res))))

+      

+      (values result (nreverse res) lineres))))

+    

+	

+    

+    

+    

+    

+      

+      

 (defparameter *char-to-kind*

@@ -1074,7 +1269,7 @@

   (let* ((buff (get-line-buffer 0))

 	 (len  (length buff))

 	 (i 0)

-	 (p (mailbox-socket mailbox))

+	 (p (post-office-socket mailbox))

 	 (ch nil)

 	 (whole-count) 

 	 )

@@ -1181,7 +1376,7 @@

   ;; like lisp likes).

   ;;

   (let ((buff (get-line-buffer count))

-	(p (mailbox-socket mb))

+	(p (post-office-socket mb))

 	(ind 0))

     (mp:with-timeout ((timeout mb)

 		      (error "imap server timed out"))

@@ -1,13 +1,13 @@

 <html>

 <head>

-<title>Allegro CL imap interface</title>

+<title>Allegro CL imap and pop interface</title>

 <meta name="GENERATOR" content="Microsoft FrontPage 3.0">

 </head>

 <body>

-<h1 align="center">Allegro CL imap interface</h1>

+<h1 align="center">Allegro CL imap and pop interface</h1>

 <p align="left">copyright (c) 1999 Franz Inc.</p>

@@ -15,11 +15,14 @@

 <p align="left"><strong>imap</strong> is a client-server protocol for processing

 electronic mail boxes.&nbsp; <strong>imap </strong>is the successor to the <strong>pop</strong>

-protocol.&nbsp;&nbsp; It is not an upward compatible successor.</p>

+protocol.&nbsp;&nbsp; It is <strong>not</strong> an upward compatible successor.

+&nbsp;&nbsp;&nbsp;&nbsp; The main focus of this document is the <strong>imap</strong>

+protocol.&nbsp;&nbsp;&nbsp; Only one small section describes the functions in the <strong>pop</strong>

+interface.</p>

 <p align="left">This document and interface is based on the Imap4rev1 protocol described

 in rfc2060.   Where this document is describing the actions of the imap commands

-it should be considered a secondary source of information about those command and rfc2060

+it should be considered a secondary source of information about those commands and rfc2060

 should be considered the primary source.</p>

 <p align="left">The advantages of <strong>imap</strong> over <strong>pop</strong> are:</p>

@@ -46,6 +49,13 @@ should be considered the primary source.</p>

 <p align="left">&nbsp;</p>

+<h1 align="left">Package</h1>

+

+<p align="left">The functions in this interface are defined in the <strong>post-office</strong>

+package which has a nickname <strong>po</strong>.</p>

+

+<p align="left">&nbsp;</p>

+

 <h1 align="left">Mailboxes</h1>

 <p align="left">Mailboxes are repositories for messages.&nbsp;&nbsp; Mailboxes are named

@@ -144,7 +154,7 @@ select a mailbox using <strong>select-mailbox</strong> shortly after connecting.

 <p align="left">&nbsp;</p>

-<p align="left"><strong><font face="Courier New">(close-imap-connection mailbox)</font></strong></p>

+<p align="left"><strong><font face="Courier New">(close-connection mailbox)</font></strong></p>

 <p align="left">This sends a <strong>logout</strong> command to the <strong>imap</strong>

 server and then closes the socket that's communicating with the <strong>imap</strong>

@@ -324,20 +334,29 @@ string just as used in the call to <strong>fetch-letter</strong>.</p>

 <p align="left">&nbsp;</p>

-<p align="left"><font face="Courier New"><strong>(fetch-letter mailbox messages parts

+<p align="left"><strong><font face="Courier New">(fetch-letter mailbox message &amp;key

+uid)</font></strong></p>

+

+<p align="left">Return the complete message, headers and body, as one big string. &nbsp;

+This is a combination of <strong>fetch-field</strong> and <strong>fetch-parts</strong>

+where the part specification is &quot;body[]&quot;.</p>

+

+<p align="left">&nbsp;</p>

+

+<p align="left"><font face="Courier New"><strong>(fetch-parts mailbox messages parts

 &amp;key uid)</strong></font></p>

 <p align="left">retrieves the specified <strong>parts</strong> of the specified <strong>messages.

 &nbsp;&nbsp; </strong>If <strong>uid</strong> is true then the <strong>messages</strong>

 are considered to be unique ids rather than message sequence numbers.

 &nbsp;&nbsp;&nbsp;&nbsp; The description of what can be specified for <strong>parts </strong>is

-quite complex and has been moved to the section below &quot;Fetching a Letter&quot;.</p>

+quite complex and is described in the section below &quot;Fetching a Letter&quot;.</p>

 <p align="left">The return value from this function is a structure that can be examined

 with <strong>fetch-field</strong>.</p>

 <p align="left">When the result returned includes an envelope value the following

-functions can be used to extract&nbsp; the parts of the envelope:</p>

+functions can be used to extract&nbsp; the components of the envelope:</p>

 <ul>

   <li><p align="left"><font face="Courier New"><strong>envelope-date</strong></font></p>

@@ -443,7 +462,7 @@ next message.</p>

 <h1 align="left">Fetching a Letter</h1>

-<p align="left">When using <strong>fetch-letter</strong> to access letters, you must

+<p align="left">When using <strong>fetch-parts</strong> to access letters, you must

 specify the parts of the messages in which you're interested.   There are a wide

 variety of specifiers, some redundant and overlapping, described in the imap specification

 in rfe2060.  We'll describe the most common ones here.   The specification

@@ -454,7 +473,8 @@ the string, e.g. &quot;(flags envelope)&quot;.&nbsp;&nbsp; </p>

 <ul>

   <li><p align="left"><strong>body[]</strong> - this returns the full message: headers and

-    body.</p>

+    body.&nbsp;&nbsp; You can use <strong>fetch-letter</strong> if you only want this part and

+    you want to avoid having to call <strong>fetch-field</strong>.</p>

   </li>

   <li><p align="left"><strong>body[text]</strong> - this returns just the the text of the body

     of the message, not the header.</p>

@@ -474,7 +494,7 @@ the string, e.g. &quot;(flags envelope)&quot;.&nbsp;&nbsp; </p>

 <p align="left">&nbsp;</p>

-<p align="left">The result of a <strong>fetch-letter</strong> is a data structure

+<p align="left">The result of a <strong>fetch-parts</strong> is a data structure

 containing all of the requested information.&nbsp;&nbsp; The <strong>fetch-field</strong>

 function is then used to extract the particular information for the particular message.</p>

@@ -606,7 +626,7 @@ these forms:</p>

 <p align="left"><strong>Connect to the imap server on the machine holding the email:</strong></p>

 <div align="left">

-<pre>user(2): (setq mb (mb:make-imap-connection &quot;mailmachine.franz.com&quot; 

+<pre>user(2): (setq mb (po:make-imap-connection &quot;mailmachine.franz.com&quot; 

                             :user "myacct" 

                             :password "mypasswd"))

 #&lt;mailbox::imap-mailbox @ #x2064ca4a&gt;</pre>

@@ -618,7 +638,7 @@ these forms:</p>

 <div align="left">

 <pre>

-user(3): (mb:select-mailbox mb "inbox")

+user(3): (po:select-mailbox mb "inbox")

 t</pre>

 </div>

@@ -628,16 +648,17 @@ t</pre>

 <div align="left">

 <pre>

-user(4): (mb:mailbox-message-count mb)

+user(4): (po:mailbox-message-count mb)

 7</pre>

 </div>

 <p align="left"><strong>There are seven messages at the moment.&nbsp;&nbsp; Fetch the

-whole 4th message</strong></p>

+whole 4th message.  We could call (po:fetch-letter mb 4) here instead and then not

+have to call fetch-field later.</strong></p>

 <div align="left">

 <pre>

-user(5): (setq body (mb:fetch-letter mb 4 "body[]"))

+user(5): (setq body (po:fetch-parts mb 4 "body[]"))

 ((4

 ("BODY[]" "Return-Path: <jkfmail@tiger.franz.com>

 Received: from tiger.franz.com (jkf@tiger [192.132.95.103])

@@ -657,7 +678,7 @@ information we want we use fetch-field:</strong></p>

 <div align="left">

 <pre>

-user(6): (mb:fetch-field 4 "body[]" body)

+user(6): (po:fetch-field 4 "body[]" body)

 "Return-Path: <jkfmail@tiger.franz.com>

 Received: from tiger.franz.com (jkf@tiger [192.132.95.103])

     by tiger.franz.com (8.8.7/8.8.7) with SMTP id LAA20261

@@ -676,9 +697,9 @@ that message.</strong></p>

 <div align="left">

 <pre>

-user(7): (mb:search-mailbox mb '(:text "blitzfig"))

+user(7): (po:search-mailbox mb '(:text "blitzfig"))

 (7)

-user(8): (mb:fetch-field 7 "body[]" (mb:fetch-letter mb 7 "body[]"))

+user(8): (po:fetch-field 7 "body[]" (po:fetch-letter mb 7 "body[]"))

 "Return-Path: <jkf@verada.com>

 Received: from main.verada.com (main.verada.com [208.164.216.3])

     by tiger.franz.com (8.8.7/8.8.7) with ESMTP id NAA20541

@@ -697,16 +718,16 @@ ok?

 &quot;</pre>

 </div>

-<p align="left"><strong>We've been using message sequence numbers up to now.

-   The are the simplest to use but if you're concerned with keeping track of

-messages when deletions are being done then using unique id's is useful.   Here

-we do the above search example using uids:</strong></p>

+<p align="left"><strong>We've been using message sequence numbers up to now. &nbsp;&nbsp;

+The are the simplest to use but if you're concerned with keeping track of messages when

+deletions are being done then using unique id's is useful.   Here we do the

+above search example using uids:</strong></p>

 <div align="left">

 <pre>

-user(9): (mb:search-mailbox mb '(:text "blitzfig") :uid t)

+user(9): (po:search-mailbox mb '(:text "blitzfig") :uid t)

 (68)

-user(10): (mb:fetch-field 68 "body[]" (mb:fetch-letter mb 68 "body[]" :uid t) :uid t)

+user(10): (po:fetch-field 68 "body[]" (po:fetch-letter mb 68 "body[]" :uid t) :uid t)

 "Return-Path: <jkf@verada.com>

 Received: from main.verada.com (main.verada.com [208.164.216.3])

     by tiger.franz.com (8.8.7/8.8.7) with ESMTP id NAA20541

@@ -730,9 +751,9 @@ we have only six messages in the mailbox.</strong></p>

 <div align="left">

 <pre>

-user(11): (mb:delete-letter mb 68 :uid t)

+user(11): (po:delete-letter mb 68 :uid t)

 (7)

-user(12): (mb:mailbox-message-count mb)

+user(12): (po:mailbox-message-count mb)

 6</pre>

 </div>

@@ -744,9 +765,9 @@ do we issue the noop command, which does nothing on the server.</strong></p>

 <div align="left">

 <pre>

-user(13): (mb:noop mb)

+user(13): (po:noop mb)

 nil

-user(14): (mb:mailbox-message-count mb)

+user(14): (po:mailbox-message-count mb)

 7</pre>

 </div>

@@ -757,13 +778,13 @@ to specify a sequence of messages.</strong></p>

 <div align="left">

 <pre>

-user(15): (mb:create-mailbox mb "tempbox")

+user(15): (po:create-mailbox mb "tempbox")

 t

-user(18): (let ((count (mb:mailbox-message-count mb)))

-(mb:copy-to-mailbox mb `(:seq 1 ,count) "tempbox")

-(mb:delete-letter mb `(:seq 1 ,count)))

+user(18): (let ((count (po:mailbox-message-count mb)))

+(po:copy-to-mailbox mb `(:seq 1 ,count) "tempbox")

+(po:delete-letter mb `(:seq 1 ,count)))

 (1 1 1 1 1 1 1)

-user(19): (mb:mailbox-message-count mb)

+user(19): (po:mailbox-message-count mb)

 0</pre>

 </div>

@@ -773,9 +794,9 @@ messages are there.</strong></p>

 <div align="left">

 <pre>

-user(22): (mb:select-mailbox mb "tempbox")

+user(22): (po:select-mailbox mb "tempbox")

 t

-user(23): (mb:mailbox-message-count mb)

+user(23): (po:mailbox-message-count mb)

 7</pre>

 </div>

@@ -788,13 +809,82 @@ the lisp side in order to free up the resources still in use for the now dead co

 <div align="left">

 <pre>

-user(24): (mb:close-imap-connection mb)

+user(24): (po:close-connection mb)

 t

 </pre>

 </div>

 <p align="left">&nbsp;</p>

+<h1>The Pop interface</h1>

+

+<p>The <strong>pop</strong> protocol is a very simple means for retreiving messages from a

+single mailbox.&nbsp;&nbsp;&nbsp;&nbsp; The functions in the interface are:</p>

+

+<p>&nbsp;</p>

+

+<p align="left"><font face="Courier New">(<strong>make-pop-connection host &amp;key user

+password port timeout)</strong></font></p>

+

+<p align="left">This creates a connection to the <strong>pop</strong> server on machine <strong>host</strong>

+and logs in as <strong>user </strong>with password <strong>password.&nbsp;&nbsp; </strong>The

+<strong>port</strong> argument defaults to 110, which is the port on which the <strong>pop</strong>

+server normally listens.&nbsp;&nbsp;&nbsp; The <strong>timeout</strong> argument defaults

+to 30 (seconds) and this value is used to limit the amount of time this pop interface code

+will wait for a response from the server before giving up.    In certain

+circumstances the server may get so busy that you see timeout errors signaled in this

+code.&nbsp; In that case you should specify a larger timeout when connecting. </p>

+

+<p>The value returned by this function is a <strong>mailbox</strong> object.&nbsp; You can

+call <strong>mailbox-message-count</strong> on the <strong>mailbox</strong> object to

+determine how many letters are currently stored in the mailbox.</p>

+

+<p>&nbsp;</p>

+

+<p><font face="Courier New"><strong>(close-connection mb)</strong></font></p>

+

+<p>Disconnect from the pop server.&nbsp; All messages marked for deletion will be deleted.</p>

+

+<p>&nbsp;</p>

+

+<p><strong><font face="Courier New">(delete-letter mb messages)</font></strong></p>

+

+<p>Mark the specified <strong>messages</strong> for deletion.&nbsp; <strong>mb </strong>is

+the mailbox object returned by <strong>make-pop-connection</strong>.&nbsp; The messages

+are only&nbsp; marked for deletion.&nbsp; They are not removed until a <strong>close-connection</strong>

+is done.&nbsp; If the connection to the <strong>pop</strong> server is broken before a <strong>close-connection</strong>

+is done, the messages will <strong>not</strong> be deleted and they will no longer be

+marked for deletion either.</p>

+

+<p><strong>messages</strong> can either be a message number, a list of the form <strong>(:seq

+N M)</strong> meaning messages <strong>N </strong>through <strong>M </strong>or it can be

+a list of message numbers and/or <strong>:seq </strong>specifiers.&nbsp;&nbsp; The

+messages in a mailbox are numbered starting with one.  Marking a message for deletion

+does not affect the numbering of other messages in the mailbox.</p>

+

+<p>&nbsp;</p>

+

+<p><font face="Courier New"><strong>(fetch-letter mb message)</strong></font></p>

+

+<p>Fetch from the pop server connection <strong>mb</strong> the letter numbered <strong>message</strong>.

+   The letters in a mailbox are numbered starting with one.  The entire

+message, including the headers,  is returned as a string.    It is an

+error to attempt to fetch a letter marked for deletion.</p>

+

+<p>&nbsp;</p>

+

+<p><font face="Courier New"><strong>(noop mb)</strong></font></p>

+

+<p>This is the no-operation command.&nbsp; It is useful for letting the <strong>pop</strong>

+server know that this connection should be kept alive (<strong>pop </strong>servers tend

+to disconnect after a few minutes of inactivity).&nbsp;&nbsp; In order to make <strong>noop</strong>

+have behavior similar to that of the <strong>imap</strong> version of <strong>noop</strong>,

+we don't send a 'noop' command to the pop server, instead we send a 'stat' command.

+&nbsp;&nbsp; This means that after this command is completed the <strong>mailbox-message-count</strong>

+will contain the current count of messages in the mailbox.</p>

+

+<p>&nbsp;</p>

+

 <p>&nbsp;</p>

 </body>

 </html>

@@ -2,10 +2,15 @@

 (load (compile-file-if-needed "../smtp/smtp"))

 (defun test ()

-  (setq *xx* (mb::make-imap-connection "tiger.franz.com"

+  (setq *xx* (po::make-imap-connection "tiger.franz.com"

 				   :user "jkfmail"

 				   :password "jkf.imap"

 				   ))

-  (mb::select-mailbox *xx* "inbox"))

+  (po::select-mailbox *xx* "inbox"))

+(defun testp ()

+  (setq *xx* (po::make-pop-connection "tiger.franz.com"

+				   :user "jkfmail"

+				   :password "jkf.imap"

+				   )))

@@ -19,7 +19,7 @@

 (defun test-connect ()

   ;; test connecting and disconnecting from the server

-  (let ((mb (mb:make-imap-connection *test-machine*

+  (let ((mb (po:make-imap-connection *test-machine*

 				     :user *test-account*

 				     :password *test-password*)))

     (unwind-protect

@@ -28,19 +28,19 @@

 	  (test-t (not (null mb)))  ; make sure we got a mailbox object

 	  ; check that we've stored resonable values in the mb object

-	  (test-equal "/" (mb:mailbox-separator mb)) 

+	  (test-equal "/" (po:mailbox-separator mb)) 

-	  (test-t (mb::select-mailbox mb "inbox"))

+	  (test-t (po::select-mailbox mb "inbox"))

-	  (test-t (> (mb:mailbox-uidvalidity mb) 0))