In SMTP-SEND-MAIL, signal a condition instead of returning funny reply

codes upon failure.

doc/latex/smtp.tex

@@ -5,12 +5,14 @@ Transfer Protocol, commonly used for sending email on the Internet.
 This library provides a simple wrapper for sending complete emails as
 well as procedures for composing custom SMTP transactions.
 
-The procedures described here usually return an SMTP reply code.  For
+Some of the procedures described here return an SMTP reply code.  For
 details, see RFC~821.
 
-\defun{smtp-send-mail}{from to-list headers body [host]}{code list}
+\defun{smtp-send-mail}{from to-list headers body [host]}{undefined}
+\defunx{smtp-error?}{thing}{boolean}
+\defunx{smtp-recipients-rejected-error?}{thing}{boolean}
 \begin{desc}
-  This emails message \var{body} with hedaers \var{headers} to
+  This emails message \var{body} with headers \var{headers} to
   recipients in list \var{to-list}, using a sender address \var{from}.
   The email is handed off to the SMTP server running on \var{host};
   default is the local host.  \var{Body} is either a list of strings
@@ -19,14 +21,18 @@ details, see RFC~821.
   association lists, mapping symbols representing RFC~822 field names
   to strings representing field bodies.
   
-  This returns two values: \var{code} and \var{list}, the code
+  If some transaction-related error happens, \ex{smtp-send-mail}
-  returned by the server and the text message, represented as a list
+  signals an \ex{smtp-error} condition with predicate
-  lines.  If some recipients were rejected, \ex{smtp-send-mail} sends
+  \ex{smtp-error?}.  More specifically, it raises an
-  to the rest of the recipients, and returns code 700 and an
+  \ex{smtp-recipients-rejected-error} (a subtype of \ex{smtp-error})
-  association list whose elements are of the form
+  if some recipients were rejected.  For \ex{smtp-error}, the
-  \ex{(\var{loser-recipient} \var{code} .  \var{text})}---that is,
+  arguments to the \ex{signal} call are the error code and the error
-  for each recipient refused by the server, you get the error data
+  message, represented as a list of lines.  For
-  sent back for that guy.  The success check is \ex{(< code 400)}.
+  \ex{smtp-recipients-rejected-error}, the arguments are reply code
+  700 and an association list whose elements are of the form
+  \ex{(\var{loser-recipient} \var{code} .  \var{text})}---that is, for
+  each recipient refused by the server, you get the error data sent
+  back for that guy.  The success check is \ex{(< code 400)}.
 \end{desc}
 
 \defun{smtp-expand}{name host}{code text}

scheme/lib/smtp.scm

@@ -29,40 +29,47 @@
 ;;; of addresses.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (smtp-send-mail from to-list headers body . maybe-host)
+(define-condition-type 'smtp-error '(error))
-  (call-with-current-continuation
+(define smtp-error? (condition-predicate 'smtp-error))
-   (lambda (bailout)
-     (let* ((host (:optional maybe-host "localhost"))
-	    (local (if (string=? host "localhost")
-		       (system-name) ; we don't need any DNS for that
-		       (system-fqdn)))
-	    (connection (smtp-connect host)))
-       (receive (code text)
-	   (smtp-transactions/no-close connection ; Do prologue.
-				       (smtp-helo local)
-				       (smtp-mail from))
-	 (if (>= code 400)
-	     (values code text)		; error
-	     ;; Send over recipients and collect the losers.
-	     (let ((losers (filter-map
-			    (lambda (to)
-			      (receive (code text)
-				  ((smtp-rcpt to) (smtp-connection-socket connection))
-				(and (>= code 400) ; Error
-				     (cond ((>= code 600)
-					    (smtp-quit
-					     (smtp-connection-socket connection))
-					    (bailout code text))
-					   (else `(,to ,code ,@text))))))
-			    to-list)))
 
-	       ;; Send the message body and wrap things up.
+(define-condition-type 'smtp-recipients-rejected-error '(smtp-error))
-	       (receive (code text)
+(define smtp-recipients-rejected-error?
-		   (smtp-transactions connection
+  (condition-predicate 'smtp-recipients-rejected-error?))
-				      (smtp-data (normalize-headers headers) body))
+
-		 (if (and (< code 400) (null? losers))
+(define (smtp-send-mail from to-list headers body . maybe-host)
-		     (values code text)
+  (let* ((host (:optional maybe-host "localhost"))
-		     (values 700 losers))))))))))
+	 (local (if (string=? host "localhost")
+		    (system-name)	; we don't need any DNS for that
+		    (system-fqdn)))
+	 (connection (smtp-connect host)))
+    (receive (code text)
+	(smtp-transactions/no-close connection ; Do prologue.
+				    (smtp-helo local)
+				    (smtp-mail from))
+      (if (>= code 400)
+	  (begin
+	    (smtp-quit (smtp-connection-socket connection))
+	    (signal 'smtp-error code text))
+	  ;; Send over recipients and collect the losers.
+	  (let ((losers (filter-map
+			 (lambda (to)
+			   (receive (code text)
+			       ((smtp-rcpt to) (smtp-connection-socket connection))
+			     (and (>= code 400) ; Error
+				  (cond ((>= code 600)
+					 (smtp-quit
+					  (smtp-connection-socket connection))
+					 (signal 'smtp-error code text))
+					(else `(,to ,code ,@text))))))
+			 to-list)))
+
+	    ;; Send the message body and wrap things up.
+	    (receive (code text)
+		(smtp-transactions connection
+				   (smtp-data (normalize-headers headers) body))
+	      (if (or (>= code 400)
+		      (not (null? losers)))
+		  (signal 'smtp-recipients-rejected-error 700 losers))))))))
 
 (define (normalize-headers headers)
   (if (assq 'date headers)

scheme/packages.scm

@@ -369,9 +369,8 @@
   (files (lib htmlout)))
 
 (define-structure smtp smtp-interface
-				
   (open scheme-with-scsh
-					; user-login-name and sockets
+	signals conditions
 	define-record-types
 	(subset srfi-1 (filter-map))
 	(subset srfi-13 (string-tokenize string-join))