- (text-loop (read-line in-port)
- (conc text text-line))))
- (deliver-message msg)
- (smtp-ok out-port)
- (loop (make-empty-message)
- (read-line in-port)))
- ((string-prefix? "quit" line)
- (smtp-close out-port)
- 'done)
- ((string=? "" line)
- (loop msg (read-line in-port)))
- (else
- (smtp-no out-port)
- (print "got " line)
- (loop msg (read-line in-port)))))
- 'done)))
-
-(define (deliver-message msg)
- (print "Message delivered:")
+ (text-loop (conc text text-line "\n")))))
+ (message-user-set! msg (smtp-session 'user))
+ (message-password-set! msg (smtp-session 'password))
+ (smtp-session 'send-line "250 ok")
+ (loop (make-empty-message) (cons msg received-messages)))
+ ((smtp-command? "quit" line)
+ (smtp-session 'send-line "221 closing transmission channel")
+ received-messages)
+ ((string=? "" (string-trim line))
+ (loop msg received-messages))
+ (else
+ (smtp-session 'send-line "502 command not implemented")
+ (loop msg received-messages)))))))
+
+
+;;; Sending/Delivering messages
+;;
+
+(define (deliver-messages config messages)
+ (print "Attempting delivery of " (length messages) " mail items.")
+ (filter (lambda (msg) (not (deliver-message msg config)))
+ messages))
+
+(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)))))
+
+(define (deliver-message-remote msg)
+ (print "TODO"))
+
+(define (deliver-message msg config)
+ (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)
+ (print "Message DELIVERED (remote):"))
+ (print "Message DELIVERY REJECTED (auth failure):"))))
+ (else
+ (print "Message DELIVERY REJECTED (relay forbidden):"))))