Trivially convert the macros to procedures.

Fix a bunch of bugs where a transaction would be closed prematurely
and/or repeatedly.

scheme/lib/smtp.scm

@@ -52,12 +52,13 @@
    (lambda (bailout)
      (let ((local (host-info:name (host-info (system-name))))
 	   (socket (smtp/open (:optional maybe-host "localhost"))))
-       (receive (code text) (smtp-transactions socket	; Do prologue.
-			      (smtp/helo socket local)
-			      (smtp/mail socket (string-append (user-login-name)
+       (receive (code text)
+	   (smtp-transactions/no-close socket ; Do prologue.
+				       (smtp/helo local)
+				       (smtp/mail (string-append (user-login-name)
 								 "@" local)))
-	 (if (>= code 400) (values code text) ; error
-
+	 (if (>= code 400)
+	     (values code text)		; error
 	     ;; Send over recipients and collect the losers.
 	     (let ((losers (filter-map
 			    (lambda (to)
@@ -71,8 +72,7 @@
 
 	       ;; Send the message body and wrap things up.
 	       (receive (code text) (smtp-transactions socket
-				      (smtp/data socket body)
-				      (smtp/quit socket))
+						       (smtp/data body))
 		 (if (and (< code 400) (null? losers))
 		     (values code text)
 		     (values 700 losers))))))))))
@@ -90,11 +90,10 @@
 (define (%sendmail from local-host to dest-host message)
   (let ((socket (smtp/open dest-host)))
     (smtp-transactions socket
-      (smtp/helo socket local-host)
-      (smtp/mail socket from)
-      (smtp/rcpt socket to)
-      (smtp/data socket message)
-      (smtp/quit socket))))
+		       (smtp/helo local-host)
+		       (smtp/mail from)
+		       (smtp/rcpt to)
+		       (smtp/data message))))
 
 
 ;;; EXPN, VRFY, MAIL-HELP
@@ -104,10 +103,8 @@
 (define (smtp-query socket query arg)
   (receive (code text)
       (smtp-transactions socket
-               (smtp/helo socket (system-name))
-	       (query socket arg))
-      (if (not (or (= code 421) (= code 221)))
-	  (smtp/quit socket))
+			 (smtp/helo (system-name))
+			 (query arg))
     (values code text)))
 
 (define (expn name host)
@@ -120,10 +117,10 @@
   (smtp-query (smtp/open host) smtp/help (apply string-append (cons " " details))))
 
 
-;;; (smtp-transactions socket ?transaction1 ...)
-;;; (smtp-transactions/no-close socket ?transaction1 ...)
+;;; (smtp-transactions socket transaction1 ...)
+;;; (smtp-transactions/no-close socket transaction1 ...)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; These macros make it easy to do simple sequences of SMTP commands.
+;;; These procedures make it easy to do simple sequences of SMTP commands.
 ;;;
 ;;; Evaluate a series of expressions ?transaction1, ?transaction2, ...
 ;;; - Each expression should perform an SMTP transaction, 
@@ -147,9 +144,7 @@
 ;;; - Otherwise, we throw away the current CODE and TEXT values, and
 ;;;   proceed to the next transaction.
 ;;;
-;;; Since SMTP-TRANSACTIONS closes the socket whenever it aborts a sequence,
-;;; an SMTP-TRANSACTIONS form terminated with an (smtp/quit socket) transaction
-;;; will always close the socket.
+;;; SMTP-TRANSACTIONS closes the socket after the transaction.
 ;;;
 ;;; If the socket should be kept open in the case of an abort, use
 ;;; SMTP-TRANSACTIONS/NO-CLOSE.
@@ -160,59 +155,25 @@
 ;;; than proceeding to mail the other four. This may not be what you want;
 ;;; if so, you'll have to roll your own.
 
-(define-syntax smtp-transactions 
-  (syntax-rules ()
-    ((smtp-transactions socket ?T1 ?T2 ...)
-     (let ((s socket))
-       (receive (code text) (smtp-transactions/no-close s ?T1 ?T2 ...)
-	 (if (<= 400 code) (smtp/quit s))
-	 (values code text))))))
+(define (smtp-transactions socket . transactions)
+  (receive (code text) (apply smtp-transactions/no-close socket transactions)
+    (cond
+     ((or (= code 221)
+	  (= code 421))
+      (values))
+     (else
+      (smtp/quit socket)))
+    (values code text)))
 
-(define-syntax smtp-transactions/no-close
-  (syntax-rules ()
-    ((smtp-transactions/no-close socket ?T1 ?T2 ...)
-     ;; %smtp-transactions/no-close replicates the socket argument, 
-     ;; so we have to force it to be a variable.
-     (let ((s socket))
-       (%smtp-transactions/no-close s ?T1 ?T2 ...)))))
-
-;;; SOCKET must be a variable, hence replicable.
-(define-syntax %smtp-transactions/no-close
-  (syntax-rules ()
-    ((%smtp-transactions/no-close socket ?T1 ?T2 ?T3 ...)
-     (receive (code text) ?T1
-       (if (or (= code 221)
+(define (smtp-transactions/no-close socket . transactions)
+  (let loop ((transactions transactions))
+    (receive (code text) ((car transactions) socket)
+      (if (or (null? (cdr transactions))
+	      (= code 221)
 	      (= code 421)		; Redundant, I know.
 	      (<= 400 code))
 	  (values code text)
-	   (%smtp-transactions/no-close socket ?T2 ?T3 ...))))
-
-    ((%smtp-transactions/no-close socket ?T1)
-     ?T1)))
-
-;;; I can't make this nested definition work. I'm not enough of a macro stud.
-;(define-syntax smtp-transactions/no-close
-;  (syntax-rules ()
-;    ((smtp-transactions/no-close socket ?T1 ...)
-;     (letrec-syntax ((%smtp-transactions/no-close
-;		      (syntax-rules ()
-;
-;		        ((%smtp-transactions/no-close socket ?T1 ?T2 ...)
-;			 (receive (code text) ?T1
-;			   (if (or (= code 221)
-;				   (= code 421)		; Redundant, I know.
-;				   (<= 400 code))
-;			       (values code text)
-;			       (%smtp-transactions/no-close socket ?T2 ...))))
-;
-;			((%smtp-transactions/no-close socket ?T1)
-;			 ?T1))))
-;
-;       ;; %smtp-transactions/no-close replicates the socket argument, 
-;       ;; so we have to force it to be a variable.
-;       (let ((s socket))
-;	 (%smtp-transactions/no-close s ?T1 ...))))))
-
+	  (loop (cdr transactions))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; The basics of the protocol
@@ -224,15 +185,15 @@
       (write-crlf port))
     (handle-smtp-reply socket)))
 
-
 (define (unary-smtp-command command)
-  (lambda (socket data)
+  (lambda (data)
+    (lambda (socket)
       (let ((port (socket:outport socket)))
 	(write-string command port)
 	(display      #\space port)
 	(write-string data    port)
 	(write-crlf           port))
-    (handle-smtp-reply socket)))
+      (handle-smtp-reply socket))))
 
 
 (define (smtp/open host . maybe-port)
@@ -254,7 +215,8 @@
 ;; DATA
 (define smtp/data
   (let ((send-DATA-msg (nullary-smtp-command "DATA")))
-    (lambda (socket message)  ; MESSAGE is a string or an input port.
+    (lambda (message)			; MESSAGE is a string or an input port.
+      (lambda (socket)
 	(receive (code text) (send-DATA-msg socket)
 	  (if (>= code 400) (values code text) ; Error.
 
@@ -278,7 +240,7 @@
 
 		(write-string "\r\n.\r\n" p)
 		(force-output p)
-	      (handle-smtp-reply socket)))))))
+		(handle-smtp-reply socket))))))))
 
 ;; SEND FROM: <sender-address>
 (define smtp/send (unary-smtp-command "SEND FROM:"))
@@ -301,8 +263,8 @@
 ;; HELP <details>
 (define smtp/help
   (let ((send-help (unary-smtp-command "HELP")))
-    (lambda (socket . details)
-      (send-help socket (apply string-append details)))))
+    (lambda details
+      (send-help (apply string-append details)))))
 
 ;; NOOP
 (define smtp/noop (nullary-smtp-command "NOOP"))