From c834cd9a6b7e6c0e8737fecd1f5ccac8b3cc401d Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Fri, 23 Aug 2019 15:47:15 +0200 Subject: [PATCH] Added maildir delivery support. --- lambdamail.scm | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/lambdamail.scm b/lambdamail.scm index 1cfe6a0..f1d8c46 100644 --- a/lambdamail.scm +++ b/lambdamail.scm @@ -8,6 +8,7 @@ (chicken string) (chicken pathname) (chicken file) + (chicken time) (chicken time posix) (chicken process-context) (chicken condition) @@ -100,7 +101,7 @@ (message-text-set! msg text) (text-loop (smtp 'get-line) (conc text text-line "\n")))) - (deliver-message msg config) + (process-message msg config) (smtp 'ok) (loop (make-empty-message) (smtp 'get-line))) @@ -130,15 +131,27 @@ (right-idx (substring-index ">" addr))) (substring addr (+ left-idx 1) right-idx))) -(define (deliver-message msg config) +(define (deliver-message-mbox msg dest-file) + (print "Delivering to mbox " dest-file) + (with-output-to-file dest-file + (lambda () + (print "\nFrom " (remove-angle-brackets (message-from msg))) + (print (message-text msg))) + #:append)) + +(define (deliver-message-maildir msg dest-dir) + (print "Delivering to maildir " dest-dir) + (with-output-to-file (conc dest-dir "/" (current-seconds)) + (lambda () + (print (message-text msg))))) + +(define (process-message msg config) (let ((dest (assoc (message-to msg) (get-to-addresses config)))) (if dest - (begin - (with-output-to-file (cdr dest) - (lambda () - (print "\nFrom " (remove-angle-brackets (message-from msg))) - (print (message-text msg))) - #:append) + (let ((dest-file (cdr dest))) + (if (directory-exists? dest-file) + (deliver-message-maildir msg dest-file) + (deliver-message-mbox msg dest-file)) (print "Message DELIVERED:")) (print "Message REJECTED:")) (print " * From: " (message-from msg)) -- 2.20.1