+ (condition-case
+ (begin
+ (let* ((local-addresses (get-local-addresses config))
+ (dest (assoc (message-to msg) local-addresses))
+ (orig (assoc (message-from msg) local-addresses)))
+ (cond
+ (dest
+ (let ((dest-dir (cadr dest)))
+ (deliver-message-local msg dest-file))
+ (print "Message DELIVERED (local):"))
+ (orig
+ (let ((password (caddr orig)))
+ (if (and
+ (string=? (conc "<" (message-user msg) "@" (config-host config) ">")
+ (message-from msg))
+ password
+ (string=? (message-password msg) password))
+ (begin
+ (deliver-message-remote msg config)
+ (print "Message DELIVERED (remote):"))
+ (print "Message REMOTE DELIVERY REJECTED (auth failure):"))))
+ (else
+ (print "Message REMOTE DELIVERY REJECTED (relay forbidden):"))))
+ (print " * From: " (message-from msg))
+ (print " * To: " (message-to msg))
+ #t)
+ (o (exn)
+ (print "Message delivery failed.")
+ (print-error-message o))))
+
+;; Local delivery
+
+(define (get-local-addresses config)
+ (map (lambda (p) (cons
+ (conc "<" (car p) "@" (config-host config) ">")
+ (cdr p)))
+ (map (lambda (file)
+ (list (pathname-file file) file
+ (let ((password-file (conc file ".auth")))
+ (if (file-exists? password-file)
+ (with-input-from-file password-file read-line)
+ #f))))
+ (filter directory-exists?
+ (glob (conc (config-spool-dir config) "/*"))))))
+
+(define (deliver-message-local msg dest-dir)
+ (with-output-to-file (conc dest-dir "/" (current-seconds))
+ (lambda ()
+ (print (message-text msg)))))
+
+
+;; Remote delivery
+
+(define (get-host-from-email email-string)
+ (car (string-split (cadr (string-split email-string "@")) ">")))
+
+(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 ((smtp-session (make-outgoing-smtp-session tcp-in tcp-out)))
+ (let ((result (and
+ (smtp-session 'expect "220")
+ (smtp-session 'send "helo " (config-host config))
+ (smtp-session 'expect "250")
+ (smtp-session 'send "mail from:" (message-from msg))
+ (smtp-session 'expect "250")
+ (smtp-session 'send "rcpt to:" (message-to msg))
+ (smtp-session 'expect "250")
+ (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)))))