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

codes upon failure.
This commit is contained in:
sperber 2003-01-22 09:29:55 +00:00
parent e51180ffdf
commit 565376310b
3 changed files with 58 additions and 46 deletions

View File

@ -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
returned by the server and the text message, represented as a list
lines. If some recipients were rejected, \ex{smtp-send-mail} sends
to the rest of the recipients, and returns 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)}.
If some transaction-related error happens, \ex{smtp-send-mail}
signals an \ex{smtp-error} condition with predicate
\ex{smtp-error?}. More specifically, it raises an
\ex{smtp-recipients-rejected-error} (a subtype of \ex{smtp-error})
if some recipients were rejected. For \ex{smtp-error}, the
arguments to the \ex{signal} call are the error code and the error
message, represented as a list of lines. For
\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}

View File

@ -29,9 +29,14 @@
;;; of addresses.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-condition-type 'smtp-error '(error))
(define smtp-error? (condition-predicate 'smtp-error))
(define-condition-type 'smtp-recipients-rejected-error '(smtp-error))
(define smtp-recipients-rejected-error?
(condition-predicate 'smtp-recipients-rejected-error?))
(define (smtp-send-mail from to-list headers body . maybe-host)
(call-with-current-continuation
(lambda (bailout)
(let* ((host (:optional maybe-host "localhost"))
(local (if (string=? host "localhost")
(system-name) ; we don't need any DNS for that
@ -42,7 +47,9 @@
(smtp-helo local)
(smtp-mail from))
(if (>= code 400)
(values code text) ; error
(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)
@ -52,7 +59,7 @@
(cond ((>= code 600)
(smtp-quit
(smtp-connection-socket connection))
(bailout code text))
(signal 'smtp-error code text))
(else `(,to ,code ,@text))))))
to-list)))
@ -60,9 +67,9 @@
(receive (code text)
(smtp-transactions connection
(smtp-data (normalize-headers headers) body))
(if (and (< code 400) (null? losers))
(values code text)
(values 700 losers))))))))))
(if (or (>= code 400)
(not (null? losers)))
(signal 'smtp-recipients-rejected-error 700 losers))))))))
(define (normalize-headers headers)
(if (assq 'date headers)

View File

@ -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))