The Lambda Lab
/
projects
/
lambdamail.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
d65171f
)
Working on multiple recipient (CC) support.
author
plugd
<plugd@thelambdalab.xyz>
Mon, 19 Jul 2021 22:03:41 +0000
(
00:03
+0200)
committer
plugd
<plugd@thelambdalab.xyz>
Mon, 19 Jul 2021 22:03:41 +0000
(
00:03
+0200)
lambdamail.scm
patch
|
blob
|
history
diff --git
a/lambdamail.scm
b/lambdamail.scm
index
a2fd01d
..
87dd145
100644
(file)
--- a/
lambdamail.scm
+++ b/
lambdamail.scm
@@
-21,7
+21,7
@@
(define-record config host port spool-dir user group)
(define-record message to from text user password)
(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"))
(define (time-stamp)
(time->string (seconds->local-time) "%d %b %Y %T %z"))
@@
-129,23
+129,22
@@
(smtp-session 'send "250 ok")
(loop msg received-messages))
((smtp-command? "rcpt to:" line)
(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")
(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")
(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-command? "quit" line)
(smtp-session 'send "221 closing transmission channel")
received-messages)
@@
-155,6
+154,19
@@
(smtp-session 'send "502 command not implemented")
(loop msg 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
;;
;;; Message stamping and validation
;;