The Lambda Lab
/
projects
/
lambdamail.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
e46944f
)
Prevent retries on delivery rejections.
author
Tim Vaughan
<tgvaughan@gmail.com>
Fri, 13 Sep 2019 09:10:14 +0000
(11:10 +0200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Fri, 13 Sep 2019 09:10:14 +0000
(11:10 +0200)
lambdamail.scm
patch
|
blob
|
history
diff --git
a/lambdamail.scm
b/lambdamail.scm
index
eb5943c
..
c3a68c1
100644
(file)
--- a/
lambdamail.scm
+++ b/
lambdamail.scm
@@
-17,7
+17,7
@@
(chicken sort)
srfi-1 srfi-13 matchable base64)
(chicken sort)
srfi-1 srfi-13 matchable base64)
-(define lambdamail-version "LambdaMail v1.
1
.0")
+(define lambdamail-version "LambdaMail v1.
2
.0")
(define-record config host port spool-dir user group)
(define-record message to from text user password)
(define-record config host port spool-dir user group)
(define-record message to from text user password)
@@
-261,7
+261,7
@@
(smtp-session 'expect "354")
(smtp-session 'send (message-text msg))
(smtp-session 'send ".")
(smtp-session 'expect "354")
(smtp-session 'send (message-text msg))
(smtp-session 'send ".")
- (smtp-session 'expect "250"
)
+ (smtp-session 'expect "250"
"5") ;Do not try again on rejects.
(smtp-session 'send "quit"))))
(close-input-port tcp-in)
(close-output-port tcp-out)
(smtp-session 'send "quit"))))
(close-input-port tcp-in)
(close-output-port tcp-out)
@@
-271,12
+271,15
@@
(print "* REMOTE DELIVERY FAILED (unexpected server response)"))
result)))))
(print "* REMOTE DELIVERY FAILED (unexpected server response)"))
result)))))
+(define (or-list l)
+ (fold (lambda (a b) (or a b)) #f l))
+
(define ((make-outgoing-smtp-session tcp-in tcp-out) . command)
(match command
(define ((make-outgoing-smtp-session tcp-in tcp-out) . command)
(match command
- (('expect code)
+ (('expect code
s ...
)
(let ((result (read-line tcp-in)))
(let ((result (read-line tcp-in)))
- (print "Expecting
" code
" got " result)
- (
string-prefix? code result
)))
+ (print "Expecting
one of " codes
" got " result)
+ (
or-list (map (lambda (code) (string-prefix? code result)) codes)
)))
(('send strings ...)
(print "Sending " (if (> (string-length (car strings)) 30)
(string-take (car strings) 30)
(('send strings ...)
(print "Sending " (if (> (string-length (car strings)) 30)
(string-take (car strings) 30)
@@
-340,4
+343,4
@@
(main)
;; (define (test)
(main)
;; (define (test)
-
;;
(run-server (make-config "localhost" 2525 "spool" '() '())))
+
;;
(run-server (make-config "localhost" 2525 "spool" '() '())))