@@ -1,3 +1,12 @@

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

+version 1.1

+	

+	* imap.html - document send-letter, send-smtp 

+	* smtp.cl - add this to the imap module

+	* t-imap.cl - adjust for the change in package

+	

+	  

+

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

 version 1.0

 	* start ChangeLog.

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

 ;; Commercial Software developed at private expense as specified in

 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.

 ;;

-;; $Id: imap.cl,v 1.4 1999/09/27 20:26:15 jkf Exp $

+;; $Id: imap.cl,v 1.5 1999/09/29 16:25:23 jkf Exp $

 ;; Description:

 ;;

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

 (in-package :post-office)

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

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

 (defvar *debug-imap* nil)

@@ -20,9 +20,21 @@ protocol.&nbsp;&nbsp; It is <strong>not</strong> an upward compatible successor.

 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 commands and rfc2060

+<p align="left">The contents of this document are:</p>

+

+<ul>

+  <li><p align="left">the <strong>imap</strong> interface</p>

+  </li>

+  <li><p align="left"><a href="#pop">the <strong>pop</strong> interface</a></p>

+  </li>

+  <li><p align="left"><a href="#smtp">the <strong>smtp</strong> interface</a> (used for

+    sending mail)</p>

+  </li>

+</ul>

+

+<p align="left">The imap 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 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>

@@ -68,12 +80,12 @@ between simple names to create a hierarchical name (in this example "/&quot

 separator character). </p>

 <p align="left">Each mailbox has an associated unique number called its <strong>uidvalidity</strong>.

-&nbsp;&nbsp;&nbsp; This number won't change as long as only <strong>imap</strong> is the

-only program used to manipulate the mailbox.   In fact if you see that the

-number has changed then that means that some other program has done something to the

-mailbox that destroyed the information that <strong>imap</strong> had been keeping about

-the mailbox.    In particular you can't now retrieve messages by their

-unique ids that you had used before.</p>

+&nbsp;&nbsp;&nbsp; This number won't change as long as <strong>imap</strong> is the only

+program used to manipulate the mailbox.   In fact if you see that the number has

+changed then that means that some other program has done something to the mailbox that

+destroyed the information that <strong>imap</strong> had been keeping about the

+mailbox.    In particular you can't now retrieve messages by their unique

+ids that you had used before.</p>

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

@@ -816,7 +828,7 @@ t

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

-<h1>The Pop interface</h1>

+<h1><a name="pop"></a>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>

@@ -885,6 +897,67 @@ will contain the current count of messages in the mailbox.</p>

 <p>&nbsp;</p>

+<h1><a name="smtp"></a>The smtp interface</h1>

+

+<p>With the smtp interface, a Lisp program can contact a mail server and send electronic

+mail.   The contents of the message must be a simple text string.  There is

+no provision for encoding binary data and sending it as a Mime attachment.</p>

+

+<p>&nbsp;</p>

+

+<p><font face="Courier New"><strong>(send-letter mail-server from to message &amp;key

+subject reply-to)</strong></font></p>

+

+<p><strong>mail-server</strong> can be a string naming a machine or an integer IP address.

+&nbsp; The <strong>mail-server</strong> is contacted and asked to send a <strong>message</strong>

+(a string) <strong>from</strong> a given email address <strong>to</strong> a given email

+address or list of addresses.   The email addresses must be of the form

+&quot;foo&quot; or <a href="mailto:foo@bar.com">&quot;foo@bar.com&quot;</a>.&nbsp; You can

+<strong>not</strong> use addresses like <a href="mailto:Joe%20%3cfoo@bar.com%3e">&quot;Joe

+&lt;foo@bar.com&gt;&quot;</a> or <a href="mailto:(Joe)%20foo@bar.com">&quot;(Joe)

+foo@bar.com&quot;</a>.&nbsp;&nbsp; </p>

+

+<p>A mail header is built and prepended to the <strong>message</strong> before it is sent.

+&nbsp; The mail header includes a <strong>From </strong>and <strong>To</strong> line and

+will optionally include a&nbsp; <strong>Subject</strong> and <strong>Reply-To</strong>

+line if those are given in the call to <strong>send-letter.</strong>.</p>

+

+<p>The text of the <strong>message</strong> should be lines separated by #\newline's.

+&nbsp;&nbsp; The <strong>smtp</strong> interface will automatically insert the necessary

+#\returns's when it transmits the message to the mail server.</p>

+

+<p>&nbsp;</p>

+

+<p>&nbsp;</p>

+

+<p><font face="Courier New"><strong>(send-smtp mail-server from to &amp;rest messages)</strong></font></p>

+

+<p><strong>mail-server</strong> can be a string naming a machine or an integer IP address.

+&nbsp; The <strong>mail-server</strong> is contacted and asked to send a&nbsp; message <strong>from</strong>

+a given email address <strong>to</strong> a given email address or list of addresses.

+&nbsp;&nbsp; The email addresses must be of the form &quot;foo&quot; or <a

+href="mailto:foo@bar.com">&quot;foo@bar.com&quot;</a>.&nbsp; You can <strong>not</strong>

+use addresses like <a href="mailto:Joe%20%3cfoo@bar.com%3e">&quot;Joe

+&lt;foo@bar.com&gt;&quot;</a> or <a href="mailto:(Joe)%20foo@bar.com">&quot;(Joe)

+foo@bar.com&quot;</a>.&nbsp;&nbsp; </p>

+

+<p>The message sent is a concatenation of all of the <strong>messages</strong> (which

+should be strings).&nbsp;&nbsp; A header is <strong>not</strong> prepended to the message.

+  This means that the application program can build its own header if it wants to

+include in that header more than <strong>send-letter</strong> supports (e.g. a Mime

+encoded attachment).&nbsp; If no header is provided then some mail servers (e.g. <strong>sendmail</strong>)

+will notice this fact and will automatically create a header.</p>

+

+<p>The text of the <strong>messages</strong> should be lines separated by #\newline's.

+&nbsp;&nbsp; The <strong>smtp</strong> interface will automatically insert the necessary

+#\returns's when it transmits the message to the mail server.</p>

+

+<p>&nbsp;</p>

+

+<p>&nbsp;</p>

+

+<p>&nbsp;</p>

+

 <p>&nbsp;</p>

 </body>

 </html>

new file mode 100644

@@ -0,0 +1,290 @@

+;; mail sending package

+;;

+;; smtp -  rfc821

+;;

+(defpackage :post-office

+  (:nicknames :po)

+  (:use #:lisp #:excl)

+  (:export 

+   #:send-letter

+   #:send-smtp))

+

+(in-package :post-office)

+

+;; the exported functions:

+

+;; (send-letter "mail-server" "from" "to" "message" &key subject reply-to)

+;;  

+;;    sends a message to the mail server (which may be a relay server

+;;    or the final destination).  "from" is the address to be given

+;;    as the sender.  "to" can be a string or a list of strings naming

+;;    recipients.   

+;;    "message" is the message to be sent

+;;    This builds a header and inserts the optional subject and reply-to

+;;    lines.

+;;

+;; (send-smtp "mail-server" "from" "to" &rest messages)

+;;    this is like send-letter except that it doesn't build a header.

+;;    the messages should contain a header (and if not then sendmail

+;;    notices this and builds one -- other MTAs may not be that smart).

+;;    The messages ia  list of string to be concatenated together

+;;    and sent as one message

+;;

+;;

+

+

+

+

+

+

+

+

+

+

+

+(defmacro response-case ((ftp-stream) &rest case-clauses)

+  (let ((response-class (gensym)))

+    `(multiple-value-bind (,response-class ftp-response)

+	 (progn (force-output ,ftp-stream)

+		(wait-for-response ,ftp-stream))

+       (declare (ignorable ftp-response))

+       (case ,response-class

+	 ,@case-clauses))))

+

+(defvar *smtp-debug* nil)

+

+

+

+(defun send-letter (server from to message

+		    &key subject

+			 reply-to)

+  (let ((header (make-string-output-stream)))

+    (format header "From: ~a~c~cTo: "

+	    from

+	    #\return

+	    #\linefeed)

+    (let ((tos (if* (stringp to) 

+			then (list to) 

+		      elseif (consp to)

+			then to

+			else (error "to should be a string or list, not ~s"

+				    to))))

+      (format header "~{ ~a~^,~}~c~c" tos #\return #\linefeed))

+    

+    (if* subject

+       then (format header "Subject: ~a~c~c" subject #\return #\linefeed))

+    

+    (if* reply-to

+       then (format header "Reply-To: ~a~c~c" reply-to #\return #\linefeed))

+    

+    

+    (format header "~c~c" #\return #\linefeed)

+    

+    (send-smtp server from to (get-output-stream-string header) message)

+  

+  

+  

+    ))

+    

+    

+	  

+		    

+

+(defun send-smtp (server from to &rest messages)

+  ;; send the effective concatenation of the messages via

+  ;; smtp to the mail server

+  ;; Each message should be a string

+  ;;

+  ;; 'to' can be a single string or a list of strings.

+  ;; each string should be in the official rfc822 format  "foo@bar.com"

+  ;;

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

+				  :remote-port 25  ; smtp

+				  )))

+    (unwind-protect

+	(progn

+	  (response-case (sock)

+			 (2 ;; to the initial connect

+			  nil)

+			 (t (error "initial connect failed")))

+	  

+	  ;; now that we're connected we can compute our hostname

+	  (let ((hostname (socket:ipaddr-to-hostname

+			   (socket:local-host sock))))

+	    (if* (null hostname)

+	       then (format nil "[~a]" (socket:ipaddr-to-dotted

+					(socket:local-host sock))))

+	    (smtp-command sock "HELO ~a" hostname)

+	    (response-case (sock)

+			   (2 ;; ok

+			    nil)

+			   (t (error "hello greeting failed"))))

+	    

+	  (smtp-command sock "MAIL from:<~a>" from)

+	  (response-case (sock)

+			 (2 ;; cool

+			  nil

+			  )

+			 (t (error "Mail from command failed")))

+

+	  (let ((tos (if* (stringp to) 

+			then (list to) 

+		      elseif (consp to)

+			then to

+			else (error "to should be a string or list, not ~s"

+				    to))))

+	    (dolist (to tos)

+	      (smtp-command sock "RCPT to:<~a>" to)

+	      (response-case (sock)

+			     (2 ;; cool

+			      nil

+			      )

+			     (t (error "rcpt to command failed")))))

+	

+	  (smtp-command sock "DATA")

+	  (response-case (sock)

+			 (3 ;; cool

+			  nil)

+			 (t (error "Data command failed")))

+	  ;(format t "sending message~%") (force-output t)	

+	  

+	  

+	  (let ((at-bol t))

+	    (dolist (message messages)

+	      (dotimes (i (length message))

+		(let ((ch (aref message i)))

+		  (if* (and at-bol (eq ch #\.))

+		     then ; to prevent . from being interpreted as eol

+			  (write-char #\. sock))

+		  (if* (eq ch #\newline)

+		     then (setq at-bol t)

+			  (write-char #\return sock)

+		     else (setq at-bol nil))

+		  (write-char ch sock)))))

+	

+	  (write-char #\return sock) (write-char #\linefeed sock)

+	  (write-char #\. sock)

+	  (write-char #\return sock) (write-char #\linefeed sock)

+	

+	  (response-case (sock)

+			 (2 nil ; (format t "Message sent to ~a~%" to)

+			    )

+			 

+			 (t (error "message not sent")))

+

+	  (force-output t)

+	  

+	  (smtp-command sock "QUIT")

+	  (response-case (sock)

+			 (2 ;; cool

+			  nil)

+			 (t (error "quit failed"))))

+      (close sock))))

+

+

+

+

+

+

+

+	

+      

+(defun wait-for-response (stream)

+  ;; read the response of the ftp server.

+  ;; collect it all in a string.

+  ;; Return two values:

+  ;; 	response class

+  ;;    whole string

+  ;; The string should begin with a decimal digit, and that is converted

+  ;; into a number which is returned as the response class.

+  ;; If the string doesn't begin with a decimal digit then the

+  ;; response class is -1.

+  ;;

+  (flet ((match-chars (string pos1 pos2 count)

+	   ;; like strncmp

+	   (dotimes (i count t)

+	     (if* (not (eq (aref string (+ pos1 i))

+			   (aref string (+ pos2 i))))

+		then (return nil)))))

+

+    (let ((res (make-array 20 :element-type 'character

+			   :adjustable t

+			   :fill-pointer 0)))

+      (if* (null (read-a-line stream res))

+	 then ; eof encountered before end of line

+	      (return-from wait-for-response (values -1 res)))

+

+      ;; a multi-line response begins with line containing

+      ;; a hyphen in the 4th column:

+      ;; xyz-  some text

+      ;;

+      ;;  and ends with a line containing the same reply code but no

+      ;;  hyphen.

+      ;; xyz  some text

+      ;;

+

+      (if* (and (>= (length res) 4) (eq #\- (aref res 3)))

+	 then ;; multi line response

+	      (let ((old-length (length res))

+		    (new-length nil))

+		(loop

+		  (if* (null (read-a-line stream res))

+		     then ; eof encountered before end of line

+			  (return-from wait-for-response (values -1 res)))

+		  (setq new-length (length res))

+		  ;; see if this is the last line

+		  (if* (and (>= (- new-length old-length) 4)

+			    (eq (aref res (+ old-length 3)) #\space)

+			    (match-chars res 0 old-length 3))

+		     then (return))

+

+		  (setq old-length new-length))))

+

+      ;; complete response is in res

+      ;; compute class and return the whole thing

+      (let ((class (or (and (> (length res) 0)

+			    (digit-char-p (aref res 0)))

+		       -1)))

+	(values class res)))))      

+

+(defun smtp-command (stream &rest format-args)

+  ;; send a command to the smtp server

+  (let ((command (apply #'format nil format-args)))

+    (if* *smtp-debug*

+       then (format *smtp-debug* "to smtp command: ~s~%" command)

+	    (force-output *smtp-debug*))

+    (write-string command stream)

+    (write-char #\return stream)

+    (write-char #\newline stream)

+    (force-output stream)))

+

+(defun read-a-line (stream res)

+  ;; read from stream and put the result in the adjust able array res

+  ;; if line ends in cr-lf, only put a newline in res.

+  ;; If we get an eof before the line finishes, return nil,

+  ;; else return t if all is ok

+  (let (ch last-ch)

+    (loop

+      (setq ch (read-char stream nil nil))

+      (if* (null ch)

+	 then ; premature eof

+	      (return nil))

+

+      (if* *smtp-debug*

+	 then (format *smtp-debug* "~c" ch)

+	      (force-output *smtp-debug*)

+	      )

+

+      (if* (eq last-ch #\return)

+	 then (if* (eq ch #\linefeed)

+		 then (vector-push-extend #\newline res)

+		      (return t)

+		 else (vector-push-extend last-ch res))

+       elseif (eq ch #\linefeed)

+	 then ; line ends with just lf, not cr-lf

+	      (vector-push-extend #\newline res)

+	      (return t)

+       elseif (not (eq ch #\return))

+	 then (vector-push-extend ch res))

+

+      (setq last-ch ch))))

@@ -66,7 +66,7 @@

 	  ;; send five letters

 	  (dotimes (i 5)

-	    (smtp:send-smtp *test-machine*

+	    (po:send-smtp *test-machine*

 			    *test-email*

 			    *test-email*

 			    (format nil "message number ~d" (1+ i))))