From 5c769132c51dbe2812d70db4566e5880f80a82e7 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Mon, 19 Aug 2019 18:56:44 +0200 Subject: [PATCH] Successfully accepted connection from other MTA. --- lambdamail.scm | 92 +++++++++++++++++++++++++++++--------------------- 1 file changed, 54 insertions(+), 38 deletions(-) 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)) -- 2.20.1