From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sat, 14 Sep 2019 20:52:43 +0000 (+0200)
Subject: Support for multi-line responses.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lambdamail.git;a=commitdiff_plain;h=047b1aeff4dcdfbda20b3d063b4047dfed19b302

Support for multi-line responses.
---

diff --git a/lambdamail.scm b/lambdamail.scm
index 7ec18d4..49fbaec 100644
--- a/lambdamail.scm
+++ b/lambdamail.scm
@@ -250,18 +250,18 @@
     (let-values (((tcp-in tcp-out) (tcp-connect mail-server 25)))
       (let ((smtp-session (make-outgoing-smtp-session tcp-in tcp-out)))
         (let ((result (and
-                       (smtp-session 'expect "2")
+                       (smtp-session 'expect "220")
                        (smtp-session 'send "helo " (config-host config))
-                       (smtp-session 'expect "2")
+                       (smtp-session 'expect "250")
                        (smtp-session 'send "mail from:" (message-from msg))
-                       (smtp-session 'expect "2")
+                       (smtp-session 'expect "250")
                        (smtp-session 'send "rcpt to:" (message-to msg))
-                       (smtp-session 'expect "2")
+                       (smtp-session 'expect "250")
                        (smtp-session 'send "data")
                        (smtp-session 'expect "354")
                        (smtp-session 'send (message-text msg))
                        (smtp-session 'send ".")
-                       (smtp-session 'expect "2" "5") ;Do not try again on rejects.
+                       (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)
@@ -277,9 +277,15 @@
 (define ((make-outgoing-smtp-session tcp-in tcp-out) . command)
   (match command
     (('expect codes ...)
-     (let ((result (read-line tcp-in)))
-       (print "Expecting one of " codes " got " result)
-       (or-list (map (lambda (code) (string-prefix? code result)) 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)