Added maildir delivery support.

diff --git a/lambdamail.scm b/lambdamail.scm
index 1cfe6a0..f1d8c46 100644 (file)
--- 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))