In SMTP-SEND-MAIL, signal a condition instead of returning funny reply
codes upon failure.
This commit is contained in:
parent
e51180ffdf
commit
565376310b
|
@ -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}
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue