scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Rename (misnomed) SENDMAIL to SEND-MAIL-VIA-SMTP and make it accept a 

FROM argument.
Fix some transaction bugs in its implementation.
Remove %SENDMAIL, now superfluous.
This commit is contained in:
sperber 2002-09-02 08:35:09 +00:00
parent 7a54991212
commit e6009cad13
2 changed files with 5 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scheme/lib/smtp.scm
View File

@ -34,7 +34,7 @@
;;; [Andreas:] I've inserted a way to do this. It works fine on my ;;; [Andreas:] I've inserted a way to do this. It works fine on my
;;; system. Does it work on your, too? ;;; system. Does it work on your, too?
;;; (sendmail to-list body [host]) ;;; (send-mail-via-smtp from to-list body [host])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Mail message to recipients in list TO-LIST. Message handed off to server ;;; Mail message to recipients in list TO-LIST. Message handed off to server
;;; running on HOST; default is the local host. Returns two values: code and ;;; running on HOST; default is the local host. Returns two values: code and
@ -47,7 +47,7 @@
;;; ;;;
;;; BODY is a string or an input port. ;;; BODY is a string or an input port.
(define (sendmail to-list body . maybe-host) (define (send-mail-via-smtp from to-list body . maybe-host)
(call-with-current-continuation (call-with-current-continuation
(lambda (bailout) (lambda (bailout)
(let ((local (host-info:name (host-info (system-name)))) (let ((local (host-info:name (host-info (system-name))))
@ -55,14 +55,13 @@
(receive (code text) (receive (code text)
(smtp-transactions/no-close socket ; Do prologue. (smtp-transactions/no-close socket ; Do prologue.
(smtp/helo local) (smtp/helo local)
(smtp/mail (string-append (user-login-name) (smtp/mail from))
"@" local)))
(if (>= code 400) (if (>= code 400)
(values code text) ; error (values code text) ; error
;; Send over recipients and collect the losers. ;; Send over recipients and collect the losers.
(let ((losers (filter-map (let ((losers (filter-map
(lambda (to) (lambda (to)
(receive (code text) (smtp/rcpt socket to) (receive (code text) ((smtp/rcpt to) socket)
(and (>= code 400) ; Error (and (>= code 400) ; Error
(cond ((>= code 600) (cond ((>= code 600)
(smtp/quit socket) (smtp/quit socket)
@ -87,15 +86,6 @@
(cdr lis)) (cdr lis))
(reverse ans)))) (reverse ans))))
(define (%sendmail from local-host to dest-host message)
(let ((socket (smtp/open dest-host)))
(smtp-transactions socket
(smtp/helo local-host)
(smtp/mail from)
(smtp/rcpt to)
(smtp/data message))))
;;; EXPN, VRFY, MAIL-HELP ;;; EXPN, VRFY, MAIL-HELP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; These three are simple queries of the server. ;;; These three are simple queries of the server.

2
scheme/packages.scm
View File

@ -32,7 +32,7 @@
emit-text)) emit-text))
(define-interface smtp-interface (define-interface smtp-interface
(export sendmail %sendmail (export send-mail-via-smtp
expn vrfy mail-help expn vrfy mail-help
smtp-transactions smtp-transactions
smtp-transactions/no-close smtp-transactions/no-close