if 0 { My (EMJ) incoming mail is stored in Maildirs [L1 ], which are presented to various mail clients using the IMAP protocol using the Dovecot [L2 ] IMAP server. The following code is one of the ways in which I intercept mail between the SMTP mail server and the Maildirs in order to do something with it.
The program is invoked by using a .forward file to have each email piped to it.
Starting with the obvious:
}
#! /bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" ${1+"$@"}
package require mimeif 0 { If the program exits with an error, the MTA will send an error message to the sender of the email. This is probably not a good idea, so all errors will be caught.
}
if {[catch {if 0 { Getting a unique filename is a requirement for the Maildir format.
}
set filename [string range [mime::uniqueID] 1 end-1]
set tempfile [file join "~/Maildir" tmp $filename]if 0 { Rather than doing
set token [mime::initialize -string [read stdin]]
which could be rather slow for a large email, and since we will have to write the file to disk anyway, we just do it! Some messages will be written twice this way, but the majority will not, so it seems acceptable.
}
set tfile [open $tempfile w]
fconfigure $tfile -translation binary -encoding binary
fconfigure stdin -translation binary -encoding binary
fcopy stdin $tfile
close $tfile
set token [mime::initialize -file $tempfile]if 0 { Now for the actual processing - if the subject indicates that the message is from a particular Yahoo group, strip the bracketed group name out of the subject, and write the email to a different Maildir location. Actually, I do other things as well
}
set matchrules [list \
Subject {^(.*)\[TclersWiki\][ _]*(.*)} .Lists.TclersWiki \
]
set changed 0
set fdest ""
foreach {hdr exp dest} $matchrules {
set subj [list]
set hval ""
catch {set hval [mime::getheader $token $hdr]}
foreach chunk [split [join $hval ""] "\n"] {
lappend subj [string trim $chunk]
}
set subj [join $subj " "]
if {[regexp $exp $subj -> part1 part2]} {
set subj "$part1$part2"
mime::setheader $token $hdr $subj
set changed 1
set fdest $dest
}
}if 0 { Now get the file in the right place as required by Maildir format. If we've changed the message we need to write out the new version and discard the old file.
}
set target [file join "~/Maildir" $fdest]
set firstfile [file join $target tmp $filename]
set secondfile [file join $target new $filename]
if $changed {
set ff [open $firstfile w]
fconfigure $ff -translation binary -encoding binary
mime::copymessage $token $ff
close $ff
mime::finalize $token
file delete $tempfile
file rename $firstfile $secondfile
} else {
mime::finalize $token
if {![string equal $firstfile $tempfile]} {
file rename $tempfile $firstfile
}
file rename $firstfile $secondfile
}if 0 { And finally, if there was an error to be caught, log it somewhere and leave the message on the MTA's queue for the administrator's attention.
}
} result ] } {
# log the error
# let the MTA hold onto the message
exit 75}