From: Tim Vaughan Date: Wed, 4 Sep 2019 17:01:16 +0000 (+0200) Subject: First successful remote delivery. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=2d92632d54049b81988e5eabb849eaa4b2248830;p=lambdamail.git First successful remote delivery. --- diff --git a/lambdamail.scm b/lambdamail.scm index e66e4de..683781e 100644 --- a/lambdamail.scm +++ b/lambdamail.scm @@ -22,6 +22,9 @@ (define-record message to from text user password) (define (make-empty-message) (make-message "" "" "" "" "")) +(define (time-stamp) + (time->string (seconds->local-time "%d %b %Y %T %z"))) + ;;; Server initialization ;; @@ -60,7 +63,7 @@ (let ((messages '())) (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))) + (print "Accepted connection from " remote-ip " on " (time-stamp))) (condition-case (set! messages (process-smtp (make-smtp-session in-port out-port config) config)) (o (exn) @@ -129,7 +132,10 @@ (loop msg received-messages)) ((smtp-command? "data" line) (smtp-session 'send "354 intermediate") - (let text-loop ((text "")) + (let text-loop ((text (conc "Received: from " (smtp-session 'helo) + " by " (config-host) + " for " (message-from msg) + "; " (time-stamp)))) (let ((text-line (smtp-session 'get-line))) (if (string=? "." text-line) (message-text-set! msg text) @@ -216,7 +222,7 @@ (define (deliver-message-remote msg config) (let ((host (get-host-from-email (message-to msg)))) (print "Attempting delivery to host " host) - (let-values (((tcp-in tcp-out) (tcp-connect host 25))) + (let-values (((tcp-in tcp-out) (tcp-connect host 2525))) (let ((smtp-session (make-outgoing-smtp-session tcp-in tcp-out))) (let ((result (and (smtp-session 'expect "220") @@ -229,19 +235,25 @@ (smtp-session 'send "data") (smtp-session 'expect "354") (smtp-session 'send (message-text msg)) + (smtp-session 'send ".") (smtp-session 'expect "250") (smtp-session 'send "quit")))) (close-input-port tcp-in) (close-output-port tcp-out) result))))) -(define ((make-outgoing-smtp-session tcp-in tcp-out) command) +(define ((make-outgoing-smtp-session tcp-in tcp-out) . command) (match command (('expect code) - (string-prefix? "220" (read-line tcp-in))) + (let ((result (read-line tcp-in))) + (print "Expecting " code " got " result) + (string-prefix? code result))) (('send strings ...) - (write-string (string-translate (conc (apply conc strings) "\n") "\n" "\r\n") - out-port)))) + (print "Sending " (car strings) (if (> (length strings) 1) " ... (truncated)" "")) + (let ((processed-string + (string-translate* (conc (apply conc strings) "\n") + '(("\n" . "\r\n"))))) + (write-string processed-string #f tcp-out))))) ;;; Command line argument parsing ;;