X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lambdamail.git;a=blobdiff_plain;f=lambdamail.scm;h=49fbaec567299a75f807a219a48cf17f21e00840;hp=eb5943c487f18e1cf3321a26b49239e35814214a;hb=047b1aeff4dcdfbda20b3d063b4047dfed19b302;hpb=e46944f2bb36d332fce40ec6c6f83bbe367ac71b

diff --git a/lambdamail.scm b/lambdamail.scm
index eb5943c..49fbaec 100644
--- a/lambdamail.scm
+++ b/lambdamail.scm
@@ -17,7 +17,7 @@
         (chicken sort)
         srfi-1 srfi-13 matchable base64)
 
-(define lambdamail-version "LambdaMail v1.1.0")
+(define lambdamail-version "LambdaMail v1.3.0")
 
 (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 "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)
@@ -271,12 +271,21 @@
               (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
-    (('expect code)
-     (let ((result (read-line tcp-in)))
-       (print "Expecting " code " got " result)
-       (string-prefix? code result)))
+    (('expect codes ...)
+     (let loop ((result (read-line tcp-in)))
+       (if (and (> (string-length result) 3)
+                (eq? (string-ref result 3) #\-))
+           (loop (read-line tcp-in)) ;status continues on next line
+           (begin
+             (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)
@@ -340,4 +349,4 @@
 (main)
 
 ;; (define (test)
-;;   (run-server (make-config "localhost" 2525 "spool" '() '())))
+  ;; (run-server (make-config "localhost" 2525 "spool" '() '())))