mhonarc-users

Re: Mailboxes on servers different from MHonArc

1999-11-11 17:05:36
On November 11, 1999 at 02:08, Gunnar Hjalmarsson wrote:

2. that are stored on other servers to which I have POP3 access.

Regarding 2., I have been recommended to use Net::POP3, but I'm not able
to find out how to use that protocol together with MHonArc.

Attached is a sample Perl program that archives mail using POP.
The program has been edited from a real program I wrote inorder
to protect the guilty.  Use at your own risk.

        --ewh

#!/usr/local/bin/perl
##############################################################################
##  File:
##      archive.pl
##  Author(s):
##      Earl Hood
##  Description:
##      Sample archiving of mail with MHonArc using POP.  Mail is
##      read from a POP server a filter to different archives based
##      on which list the mail is addressed to.  Original messages
##      are stored in MMDF format broken up by month.
##
##      This script is designed to be invoked from cron.
##  Dependencies:
##      FileHandle module
##      Net::POP3 module
##      MHonArc, <http://www.pobox.com/~ehood/mhonarc.html>
##############################################################################

package POPArchive;

##############################################################################
##      BEGIN CONFIGURATION SECTION
##############################################################################

my $debug       = 0;

## POP3 connection parameters
my $pophost     = 'pop.somedomain.com';
my $user        = 'archiveuser';
my $pass        = 'somepassword';
my $timeout     = 180;

## Root location for mailbox files and html archives
my $root        = '/www/archives';
my $index       = "$root/index.html";   # Master index of all archives
my $dirmbox     = "$root/mbox";         # Location to place raw messages
my $dirhtml     = "$root/html";         # Location to place list archives
my $mharc       = "$root/html/archive.mrc";

## How long to keep messages in html archive
#my $expireage  = 2635200;  # month
my $expireage   = 1317600;  # half a month

##############################################################################
##      END CONFIGURATION SECTION
##############################################################################

use Net::POP3;
use FileHandle;

sub L_TITLE ()  { 0; };
sub L_MBOX ()   { 1; };
sub L_HTML ()   { 2; };
sub L_MBOXFH () { 3; };

umask 002;

print STDERR "Initializing MHonArc ...\n"  if $debug;
require 'mhamain.pl' or die qq/Unable to require mhamain.pl: $!\n/;
mhonarc::initialize();
print STDERR "MHonArc initialized\n"  if $debug;

my $msgsep      = "\001\001\001\001";
my $time        = time;
my($mon, $year) = (localtime($time))[4,5];  ++$mon;  $year += 1900;
my $mboxdate    = sprintf("%4d%02d", $year, $mon);

my %lists       = (
    'list1'     => [
        'List 1 Title',
        join('/', $dirmbox, 'list1'),
        join('/', $dirhtml, 'list1'),
        undef,
    ],
    'list2'     => [
        'List 2 Title',
        join('/', $dirmbox, 'list2'),
        join('/', $dirhtml, 'list2'),
        undef,
    ],
);

my @args        = ($pophost, 'Timeout', $timeout);
push(@args, 'Debug' => 9)  if $debug;

print STDERR "Attempting to instanstiate Net::POP3(@args) ...\n" if $debug;
my $pop         = Net::POP3->new(@args);
   die qq/Unable to instantiate Net::POP3 object/  if !defined($pop);
my $retcode     = -1;

MAIN: {
    print STDERR "Open connection to $pophost\n"  if $debug;
    my $cnt = $pop->login($user, $pass);
    if (!defined($cnt)) {
        warn qq/Problem logining into $pophost/;
        last MAIN;
    }
    print STDERR "Connection established\n"  if $debug;

    my $msgs = $pop->list();
    if (!defined($cnt)) {
        warn qq/Problem getting message list from $pophost/;
        last MAIN;
    }
    print STDERR "Retrieved message list\n"  if $debug;

    last MAIN  unless $cnt > 0;

    my($msg, $msgnum, $line, $list, $to, $subject, $tmp, $key, $aref, $fh,
       $mboxpn);
    my(%header);

    ## Loop thru each message and append to appropriate mailbox
    print STDERR "Looping thru messages\n"  if $debug;
    foreach $msgnum (sort { $a <=> $b } keys %$msgs) {
        print STDERR "reading message $msgnum\n"  if $debug;
        $msg = $pop->get($msgnum);
        next  unless defined $msg;

        ## Grab message header
        %header = ( );  $aref = undef;
        foreach $line (@$msg) {
            last  if $line =~ /^$/;
            $tmp = $line;  chomp $tmp;
            if ($tmp =~ s/^\s//)  {
                next  unless defined $aref;
                $aref->[$#$aref] .= $tmp;
                next;
            }
            if ($tmp =~ s/^([^:]+):\s*//) {
                $key = lc $1;
                if (defined($header{$key})) { $aref = $header{$key}; }
                else                        { $aref = $header{$key} = [ ]; }
                push(@$aref, $tmp);
                next;
            }
        }
        print STDERR "$msgnum: read header\n"  if $debug;

        ## Determine which list
        $list = '';
        TO: foreach $key ('to', 'cc') {
            next  unless defined $header{$key};

            LINE: foreach $line (@{$header{$key}}) {
                print STDERR "$msgnum: $key: $line\n"  if $debug;
                if ($line =~ /\blist1@/i) {
                    $list = 'list1';    last TO; }
                if ($line =~ /\blist2@/i) {
                    $list = 'list2';    last TO; }
            } ## LINE: foreach
        } ## TO: foreach

        if (!$list) {
            ## Could not determine archive from address, so check subject
            print STDERR "$msgnum: Subject: ",
                         $header{'subject'}[0], "\n"  if $debug;
            if ($header{'subject'}[0] =~ /^\s*([^:]+):/) {
                $list = lc $1;
            }
            $list = 'list1'  unless defined $lists{$list};
        }
        print STDERR "$msgnum: list = $list\n"  if $debug;

        ## Open mailbox
        if (!defined($lists{$list}[L_MBOXFH])) {
            mkdir $lists{$list}[L_MBOX], 0777;
            $mboxpn = join("/", $lists{$list}[L_MBOX], $mboxdate);
            $fh = FileHandle->new(">>$mboxpn");
            if (!defined($fh)) {
                warn qq/Unable to append "$mboxpn": $!\n/;
                last MAIN;
            }
            $lists{$list}[L_MBOXFH] = $fh;
        } else {
            $fh = $lists{$list}[L_MBOXFH];
        }

        print STDERR "$msgnum: appending to", $lists{$list}[L_MBOX], "\n"
                     if $debug;
        print $fh "$msgsep\n", @$msg;

    } continue {
        $pop->delete($msgnum);
    }

    print STDERR "Closing connection\n"  if $debug;
    $pop->quit();
    undef $pop;
    print STDERR "Connection closed\n"  if $debug;

    ## Update HTML archives
    my $mhacode = 0;
    my @mhargs = ( );
    while (($list, $aref) = each(%lists)) {
        next  unless defined $aref->[L_MBOXFH];
        $aref->[L_MBOXFH]->close();
        print STDERR "Updating ", $aref->[L_HTML], "\n"  if $debug;

        mkdir $aref->[L_HTML], 0777;
        @mhargs = (
            '-add',
            '-outdir', $aref->[L_HTML],
            '-rcfile', $mharc,
            '-msgsep', "^$msgsep",
            '-expireage', $expireage,
            '-title', $aref->[L_TITLE],
            '-ttitle', ($aref->[L_TITLE] . " (thread)"),
            join("/", $aref->[L_MBOX], $mboxdate),
        );
        unshift(@mhargs, '-quiet')  unless $debug;
        if (!mhonarc::process_input(@mhargs)) {
            $mhacode = $mhonarc::CODE;
        }
    }

    ## Update master index.  The master index is treated as a template.
    ## Special comment declaractions are looked for to add in date
    ## information.
    print STDERR "Updating master index ...\n"  if $debug;
    my $tmpfile = $index . ".$$";
    local(*INFILE, *TMPFILE);
    if (!open(INFILE, $index)) {
        warn qq/Unable to open "$index": $!\n/;
        last MAIN;
    }
    if (!open(TMPFILE, ">$tmpfile")) {
        warn qq/Unable to create "$tmpfile": $!\n/;
        close INFILE;
        last MAIN;
    }
    local $_;
    my($com);
    IN: while (<INFILE>) {
        if (s/^<!--X-([^-]+)//) {
            $com = $1;
            chomp;
            if ($com eq 'Expires') {
                print STDERR "Found Expires tag: $_\n"  if $debug;
                print TMPFILE qq|<!--X-Expires-->|,
                              qq|<META HTTP-EQUIV="expires" CONTENT="|,
                              scalar(gmtime($time+3600)), qq| GMT">\n|;
                next IN;
            }
            if ($com eq 'Date') {
                print STDERR "Found Date tag: $_\n"  if $debug;
                ($list) = $_ =~ /^-([^-]+)/;
                if (defined($lists{$list}[L_MBOXFH])) {
                    print STDERR "Updating date for $list\n"  if $debug;
                    print TMPFILE qq|<!--X-Date-$list-->|,
                                  scalar(localtime($time)), qq|\n|;
                } else {
                    print TMPFILE "<!--X-$com$_\n";
                    next IN;
                }
                next IN;
            }
            print TMPFILE "<!--X-$com$_\n";
            next IN;
        }
        print TMPFILE $_;
    }
    close TMPFILE;
    close INFILE;
    if (!rename($tmpfile, $index)) {
        warn qq/Unable to rename "$tmpfile" to "$index": $!\n/;
        unlink $tmpfile;
        last MAIN;
    }

    $retcode = $mhacode;
}

$pop->quit()  if defined $pop;

print STDERR "Done\n"  if $debug;
exit($retcode);
<Prev in Thread] Current Thread [Next in Thread>