1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
# 20may11abu
# (c) Software Lab. Alexander Burger
# Configuration
(setq
*MailingList "picolisp@software-lab.de"
*SpoolFile "/var/mail/picolisp"
*MailingDomain "software-lab.de"
*Mailings (make (in "Mailings" (while (line T) (link @))))
*SmtpHost "localhost"
*SmtpPort 25 )
# Process mails
(loop
(when (gt0 (car (info *SpoolFile)))
(protect
(in *SpoolFile
(unless (= "From" (till " " T))
(quit "Bad mbox file") )
(char)
(while (setq *From (lowc (till " " T)))
(off
*Name *Subject *Date *MessageID *InReplyTo *MimeVersion
*ContentType *ContentTransferEncoding *ContentDisposition *UserAgent )
(while (split (line) " ")
(setq *Line (glue " " (cdr @)))
(case (pack (car @))
("From:" (setq *Name *Line))
("Subject:" (setq *Subject *Line))
("Date:" (setq *Date *Line))
("Message-ID:" (setq *MessageID *Line))
("In-Reply-To:" (setq *InReplyTo *Line))
("MIME-Version:" (setq *MimeVersion *Line))
("Content-Type:" (setq *ContentType *Line))
("Content-Transfer-Encoding:" (setq *ContentTransferEncoding *Line))
("Content-Disposition:" (setq *ContentDisposition *Line))
("User-Agent:" (setq *UserAgent *Line)) ) )
(if (nor (member *From *Mailings) (= "subscribe" (lowc *Subject)))
(out "/dev/null" (echo "^JFrom ") (msg *From " discarded"))
(unless (setq *Sock (connect *SmtpHost *SmtpPort))
(quit "Can't connect to SMTP server") )
(unless
(and
(pre? "220 " (in *Sock (line T)))
(out *Sock (prinl "HELO " *MailingDomain "^M"))
(pre? "250 " (in *Sock (line T)))
(out *Sock (prinl "MAIL FROM:" *MailingList "^M"))
(pre? "250 " (in *Sock (line T))) )
(quit "Can't HELO") )
(when (= "subscribe" (lowc *Subject))
(push1 '*Mailings *From)
(out "Mailings" (mapc prinl *Mailings)) )
(for To *Mailings
(out *Sock (prinl "RCPT TO:" To "^M"))
(unless (pre? "250 " (in *Sock (line T)))
(msg T " can't mail") ) )
(when (and (out *Sock (prinl "DATA^M")) (pre? "354 " (in *Sock (line T))))
(out *Sock
(prinl "From: " (or *Name *From) "^M")
(prinl "Sender: " *MailingList "^M")
(prinl "Reply-To: " *MailingList "^M")
(prinl "To: " *MailingList "^M")
(prinl "Subject: " *Subject "^M")
(and *Date (prinl "Date: " @ "^M"))
(and *MessageID (prinl "Message-ID: " @ "^M"))
(and *InReplyTo (prinl "In-Reply-To: " @ "^M"))
(and *MimeVersion (prinl "MIME-Version: " @ "^M"))
(and *ContentType (prinl "Content-Type: " @ "^M"))
(and *ContentTransferEncoding (prinl "Content-Transfer-Encoding: " @ "^M"))
(and *ContentDisposition (prinl "Content-Disposition: " @ "^M"))
(and *UserAgent (prinl "User-Agent: " @ "^M"))
(prinl "^M")
(cond
((= "subscribe" (lowc *Subject))
(prinl "Hello " (or *Name *From) " :-)^M")
(prinl "You are now subscribed^M")
(prinl "****^M^J^M") )
((= "unsubscribe" (lowc *Subject))
(out "Mailings"
(mapc prinl (del *From '*Mailings)) )
(prinl "Good bye " (or *Name *From) " :-(^M")
(prinl "You are now unsubscribed^M")
(prinl "****^M^J^M") ) )
(echo "^JFrom ")
(prinl "-- ^M")
(prinl "UNSUBSCRIBE: mailto:" *MailingList "?subject=Unsubscribe^M")
(prinl ".^M")
(prinl "QUIT^M") ) )
(close *Sock) ) ) )
(out *SpoolFile (rewind)) ) )
(call "fetchmail" "-as")
(wait `(* 4 60 1000)) )
# vi:et:ts=3:sw=3
|
