X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lambdamail.git;a=blobdiff_plain;f=lambdamail.scm;h=eb5943c487f18e1cf3321a26b49239e35814214a;hp=9bc71978f250939d4f9c0f03bbacb48dd82f9a33;hb=e46944f2bb36d332fce40ec6c6f83bbe367ac71b;hpb=461a9b6eb88c9ec7e4b5c978f8bd59c47d4584ee diff --git a/lambdamail.scm b/lambdamail.scm index 9bc7197..eb5943c 100644 --- a/lambdamail.scm +++ b/lambdamail.scm @@ -17,7 +17,7 @@ (chicken sort) srfi-1 srfi-13 matchable base64) -(define lambdamail-version "LambdaMail v1.0.0") +(define lambdamail-version "LambdaMail v1.1.0") (define-record config host port spool-dir user group) (define-record message to from text user password) @@ -103,63 +103,63 @@ (let loop ((msg (make-empty-message)) (received-messages '())) (let ((line (smtp-session 'get-line))) - (when (string? line) - (print "got " line) - (cond - ((smtp-command? "helo" line) - (smtp-session 'set-helo! (smtp-command-args "helo" line)) - (smtp-session 'send "250 ok") - (loop msg received-messages)) - ((smtp-command? "ehlo" line) - (smtp-session 'set-helo! (smtp-command-args "helo" line)) - (smtp-session 'send - "250-" (config-host config) - " Hello " (smtp-command-args "ehlo" line)) - (smtp-session 'send "250 AUTH PLAIN") - ;; (smtp-session 'send "250 STARTTLS") - (loop msg received-messages)) - ((smtp-command? "auth plain" line) - (let* ((auth-string (smtp-command-args "auth plain" line)) - (auth-decoded (base64-decode auth-string)) - (auth-list (string-split auth-decoded "\x00")) - (user (car auth-list)) - (password (cadr auth-list))) - (smtp-session 'set-user! user) - (smtp-session 'set-password! password) - (print "Attempted login, user: " user ", password: " password) - (smtp-session 'send "235 authentication successful") - (loop msg received-messages))) - ((smtp-command? "mail from:" line) - (message-from-set! msg (smtp-command-args "mail from:" line)) - (smtp-session 'send "250 ok") - (loop msg received-messages)) - ((smtp-command? "rcpt to:" line) - (message-to-set! msg (smtp-command-args "rcpt to:" line)) - (smtp-session 'send "250 ok") - (loop msg received-messages)) - ((smtp-command? "data" line) - (smtp-session 'send "354 intermediate") - (let text-loop ((text (conc "Received: from " (smtp-session 'helo) "\n" - "\tby " (config-host config) "\n" - "\tfor " (message-to msg) ";\n" - "\t" (time-stamp) "\n"))) - (let ((text-line (smtp-session 'get-line))) - (if (string=? "." text-line) - (message-text-set! msg text) - (text-loop (conc text text-line "\n"))))) - (message-user-set! msg (smtp-session 'user)) - (message-password-set! msg (smtp-session 'password)) - (smtp-session 'send "250 ok") - (loop (make-empty-message) (cons msg received-messages))) - ((smtp-command? "quit" line) - (smtp-session 'send "221 closing transmission channel") - received-messages) - ((string=? "" (string-trim line)) - (loop msg received-messages)) - (else - (smtp-session 'send "502 command not implemented") - (loop msg received-messages)))))) - '()) + (print "got " line) + (if (not (string? line)) + '() ; Don't keep anything on unexpected termination. + (cond + ((smtp-command? "helo" line) + (smtp-session 'set-helo! (smtp-command-args "helo" line)) + (smtp-session 'send "250 ok") + (loop msg received-messages)) + ((smtp-command? "ehlo" line) + (smtp-session 'set-helo! (smtp-command-args "helo" line)) + (smtp-session 'send + "250-" (config-host config) + " Hello " (smtp-command-args "ehlo" line)) + (smtp-session 'send "250 AUTH PLAIN") + ;; (smtp-session 'send "250 STARTTLS") + (loop msg received-messages)) + ((smtp-command? "auth plain" line) + (let* ((auth-string (smtp-command-args "auth plain" line)) + (auth-decoded (base64-decode auth-string)) + (auth-list (string-split auth-decoded "\x00")) + (user (car auth-list)) + (password (cadr auth-list))) + (smtp-session 'set-user! user) + (smtp-session 'set-password! password) + (print "Attempted login, user: " user ", password: " password) + (smtp-session 'send "235 authentication successful") + (loop msg received-messages))) + ((smtp-command? "mail from:" line) + (message-from-set! msg (smtp-command-args "mail from:" line)) + (smtp-session 'send "250 ok") + (loop msg received-messages)) + ((smtp-command? "rcpt to:" line) + (message-to-set! msg (smtp-command-args "rcpt to:" line)) + (smtp-session 'send "250 ok") + (loop msg received-messages)) + ((smtp-command? "data" line) + (smtp-session 'send "354 intermediate") + (let text-loop ((text (conc "Received: from " (smtp-session 'helo) "\n" + "\tby " (config-host config) "\n" + "\tfor " (message-to msg) ";\n" + "\t" (time-stamp) "\n"))) + (let ((text-line (smtp-session 'get-line))) + (if (string=? "." text-line) + (message-text-set! msg text) + (text-loop (conc text text-line "\n"))))) + (message-user-set! msg (smtp-session 'user)) + (message-password-set! msg (smtp-session 'password)) + (smtp-session 'send "250 ok") + (loop (make-empty-message) (cons msg received-messages))) + ((smtp-command? "quit" line) + (smtp-session 'send "221 closing transmission channel") + received-messages) + ((string=? "" (string-trim line)) + (loop msg received-messages)) + (else + (smtp-session 'send "502 command not implemented") + (loop msg received-messages))))))) ;;; Sending/Delivering messages @@ -293,11 +293,15 @@ (define (print-usage progname) (print "Usage:\n" progname " -h/--help\n" + progname " -v/--version\n" progname " [-u/--user UID] [-g/--group GID] hostname [[port [spooldir]]\n" "\n" "The -u and -g options can be used to set the UID and GID of the process\n" "following the creation of the TCP port listener (which often requires root).")) +(define (print-version) + (print lambdamail-version)) + (define (main) (let ((progname (pathname-file (car (argv)))) (config (make-config "" 25 "/var/spool/mail" '() '()))) @@ -319,6 +323,9 @@ ((or (equal? this-arg "-h") (equal? this-arg "--help")) (print-usage progname)) + ((or (equal? this-arg "-v") + (equal? this-arg "--version")) + (print-version)) (else (print "Unknown option " this-arg "\n") (print-usage progname)))