From: Tim Vaughan <tgvaughan@gmail.com>
Date: Mon, 19 Aug 2019 16:56:44 +0000 (+0200)
Subject: Successfully accepted connection from other MTA.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=5c769132c51dbe2812d70db4566e5880f80a82e7;p=lambdamail.git

Successfully accepted connection from other MTA.
---

diff --git a/lambdamail.scm b/lambdamail.scm
index cd501f1..e4956d8 100644
--- a/lambdamail.scm
+++ b/lambdamail.scm
@@ -9,6 +9,7 @@
         (chicken pathname)
         (chicken file)
         (chicken time posix)
+        (chicken process-context)
         srfi-1 srfi-13 matchable)
 
 (define lambdamail-version "0.0.1")
@@ -22,12 +23,12 @@
   (let ((listener (tcp-listen (config-port config) 10 "::")))
     (print "LambdaMail listening on port " (config-port config) " ...")
     (server-loop listener config)))
-                         
+
 (define (server-loop listener config)
   (let-values (((in-port out-port) (tcp-accept listener)))
     (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
       (print "Accepted connection from " remote-ip " on " (seconds->string)))
-    (write-line (conc "Welcome to lambamail v" lambdamail-version) out-port)
+    (smtp-greeting out-port)
     (process-smtp in-port out-port)
     (print "Connection terminated.")
     (close-input-port in-port)
@@ -35,11 +36,17 @@
   (server-loop listener config))
 
 (define (smtp-reply reply out-port)
-  (write-line (conc reply "\r\n") out-port))
+  (write-line reply out-port))
+
+(define (smtp-greeting out-port)
+  (smtp-reply (conc "220 thelambdalab.xyz LambdaMail v" lambdamail-version) out-port))
 
 (define (smtp-ok out-port)
   (smtp-reply "250 OK" out-port))
 
+(define (smtp-intermediate out-port)
+  (smtp-reply "354 Intermediate" out-port))
+
 (define (smtp-close out-port)
   (smtp-reply "221 Closing transmission channel" out-port))
 
@@ -48,37 +55,49 @@
 
 (define (process-smtp in-port out-port)
   (let loop ((msg (make-empty-message))
-             (line (string-downcase (read-line in-port))))
-    (cond
-     ((string-prefix? "helo" line)
-      (message-helo-set! msg (string-drop line (string-length "helo")))
-      (smtp-ok out-port)
-      (loop msg (string-downcase (read-line in-port))))
-     ((string-prefix? "mail from:" line)
-      (message-from-set! msg (string-drop line (string-length "mail from:")))
-      (smtp-ok out-port)
-      (loop msg (string-downcase (read-line in-port))))
-     ((string-prefix? "rcpt to:" line)
-      (message-to-set! msg (string-drop line (string-length "rcpt to:")))
-      (smtp-ok out-port)
-      (loop msg (string-downcase (read-line in-port))))
-     ((string-prefix? "data" line)
-      (let text-loop ((text-line (read-line in-port))
-                      (text ""))
-        (print "Received '" text-line "'")
-        (if (string=? "." text-line)
-            (message-text-set! msg text)
-            (text-loop (read-line in-port)
-                       (conc text text-line))))
-      (deliver-message msg)
-      (smtp-ok out-port)
-      (loop (make-empty-message)
-            (string-downcase (read-line in-port))))
-     ((string-prefix? "quit" line)
-      (smtp-close out-port)
-      'done)
-     (else
-      (smtp-no out-port)))))
+             (line-orig (read-line in-port)))
+    (if (string? line-orig)
+        (let ((line (string-downcase line-orig)))
+          (cond
+           ((string-prefix? "helo" line)
+            (message-helo-set! msg (string-drop line (string-length "helo")))
+            (print "got " line)
+            (smtp-ok out-port)
+            (loop msg (read-line in-port)))
+           ((string-prefix? "mail from:" line)
+            (print "got " line)
+            (message-from-set! msg (string-drop line (string-length "mail from:")))
+            (smtp-ok out-port)
+            (loop msg (read-line in-port)))
+           ((string-prefix? "rcpt to:" line)
+            (print "got " line)
+            (message-to-set! msg (string-drop line (string-length "rcpt to:")))
+            (smtp-ok out-port)
+            (loop msg (read-line in-port)))
+           ((string-prefix? "data" line)
+            (print "got " line)
+            (smtp-intermediate out-port)
+            (let text-loop ((text-line (read-line in-port))
+                            (text ""))
+              (print "Received '" text-line "'")
+              (if (string=? "." text-line)
+                  (message-text-set! msg text)
+                  (text-loop (read-line in-port)
+                             (conc text text-line))))
+            (deliver-message msg)
+            (smtp-ok out-port)
+            (loop (make-empty-message)
+                  (read-line in-port)))
+           ((string-prefix? "quit" line)
+            (smtp-close out-port)
+            'done)
+           ((string=? "" line)
+            (loop msg (read-line in-port)))
+           (else
+            (smtp-no out-port)
+            (print "got " line)
+            (loop msg (read-line in-port)))))
+        'done)))
  
 (define (deliver-message msg)
   (print "Message delivered:")
@@ -86,7 +105,4 @@
   (print " * To: " (message-to msg))
   (print " * Text: " (message-text msg)))
 
-(define (test)
-  (run-server (make-config 2525)))
-
-(test)
+(run-server (make-config 25))