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,40 +29,47 @@
;;; of addresses.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
(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)))
(define-condition-type 'smtp-error '(error))
(define smtp-error? (condition-predicate 'smtp-error))
;; Send the message body and wrap things up.
(receive (code text)
(smtp-transactions connection
(smtp-data (normalize-headers headers) body))
(if (and (< code 400) (null? losers))
(values code text)
(values 700 losers))))))))))
(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)
(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)
(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)

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