Sorting mail into Maildirs

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 mime

if 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