(define-record config host port spool-dir user group)
(define-record message to from text user password)
-(define (make-empty-message) (make-message "" "" "" "" ""))
+(define (make-empty-message) (make-message '() "" "" "" ""))
(define (time-stamp)
(time->string (seconds->local-time) "%d %b %Y %T %z"))
(smtp-session 'send "250 ok")
(loop msg received-messages))
((smtp-command? "rcpt to:" line)
- (message-to-set! msg (smtp-command-args "rcpt to:" line))
+ (message-to-set! msg (cons (smtp-command-args "rcpt to:" line)
+ (message-to msg)))
(if (message-valid? msg config)
(smtp-session 'send "250 ok")
(smtp-session 'send "551 relay forbidden"))
(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-loop ((text '()))
(let ((text-line (smtp-session 'get-line)))
(if (string=? "." text-line)
(message-text-set! msg text)
(text-loop (conc text text-line "\n")))))
(smtp-session 'send "250 ok")
- (loop (make-empty-message) (cons msg received-messages)))
+ (loop (make-empty-message) (append (get-single-recipient-messages msg smtp-session)
+ received-messages)))
((smtp-command? "quit" line)
(smtp-session 'send "221 closing transmission channel")
received-messages)
(smtp-session 'send "502 command not implemented")
(loop msg received-messages)))))))
+(define (get-single-recipient-messages smtp-session msg)
+ (map
+ (lambda (to)
+ (make-message to (message-from msg)
+ (conc "Received: from " (smtp-session 'helo) "\n"
+ "\tby " (config-host config) "\n"
+ "\tfor " to ";\n"
+ "\t" (time-stamp) "\n"
+ (message-text msg))
+ (message-user msg)
+ (message-password msg)))
+ (message-to msg)))
+
;;; Message stamping and validation
;;