picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

mailing (4750B)

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