diff --git a/doc/latex/smtp.tex b/doc/latex/smtp.tex index a5639ab..63fbd13 100644 --- a/doc/latex/smtp.tex +++ b/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 - 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} diff --git a/scheme/lib/smtp.scm b/scheme/lib/smtp.scm index 89d366f..0813528 100644 --- a/scheme/lib/smtp.scm +++ b/scheme/lib/smtp.scm @@ -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) diff --git a/scheme/packages.scm b/scheme/packages.scm index 91260ce..6487591 100644 --- a/scheme/packages.scm +++ b/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))