#!f:/program/perl/bin/perl -w
#/usr/bin/perl -w
#
################
use strict;
use Mail::Pop3client;
use Mail::Sendmail;
#use Data::Dumper;

# SMTP server
##########################
#my $smtp = 'mail';
my $smtp = "24.0.95.87";

# set $save to 0 to disable saving copies of email to $savedir
##########################
my $save = 1;

# this is the directory to save copies of the forwarded email into
# the save format is YYYY-MM-DD-HH-MM-SS.txt
##########################
#my $savedir = "/usr/home/somewhere";
my $savedir = "f:/project/mailfwd/mail";

# turn on verbose.  Default 0.
##########################
my $verbose = 1;


#################################
#################################
# no need to chang anything below
#  unless you want to. :-)
#################################

#########
# checks the args - if it fails, it calls usage and exits
#########
my ($username, $host, $pass, $list) = &check_args();

print "Verbose ON\n" if ($verbose);

my $version = "Dystrophy Mail Forward v1.03b";
print "$version\n" if ($verbose);

&check_mail();

#################

sub check_mail {

    my $pop = new Mail::POP3Client( USER     => "$username",
                    PASSWORD => "$pass",
                           HOST     => "$host" );
    print "user: $username, pass: $pass, host: $host\n" if ($verbose);

    my $num_email = $pop->Count();

    my @emails = ();

    if ( $num_email > 0 ) { 
        @emails = &read_list($list); 
    }
    else {
        return;
    }

    my ($i, @tank, $OK_sender, $body, @head);


    for ($i = 1; $i <= $num_email; $i++) {
        $tank[$i]{'smtp'} = $smtp;  #set the smtp server
        $tank[$i]{'X-Mailer'} = $version;

        my @head = $pop->Head( $i ) ;

        $tank[$i]{'To'} = ();
        
        ($tank[$i]{'From'}, $tank[$i]{'Subject'}) = &parse_head(@head)
+;

        $tank[$i]{'Body'} = $pop->Body( $i ) ;

        if ($save) {
            if (-d $savedir && -r $savedir && -w $savedir) {
                my $path = $savedir."/".&getDate.".txt";
                open (FH, ">$path") or print "Could not open $path to 
+save copies of email: $!\n";  

                # change normal array separator
                my $foo = $";
                $" = "\n";
                print FH "@head";
                $" = $foo;  # change back

                print FH $tank[$i]->{'Body'};
                close (FH);
            }
            else {
                print "$savedir is not a directory or does not have th
+e correct permissions.\nCould not save email $i";
            }
        }
#################
# this delete is commented out to make it easier to test the app
#################
        #$pop->Delete($i) || print STDERR "Could not Delete message nu
+m $i: $pop->Message()\n";
        #print "Deleted msg $i\n" if ($verbose);

    }

    #$pop->Close(); #pop3client complains about this!?!

    ###############

    $i = 1;

    while ( $i <= $num_email ) {
        #print "From: ".$tank[$i]->{'From'}."\n" if ($verbose);
        #print "Subject: ".$tank[$i]->{'Subject'}."\n" if ($verbose);

        my $OK_sender = &check_email($tank[$i]->{'From'}, @emails);

        if ($OK_sender) {
#print $tank[$i]{'From'}."\n";

            foreach my $line (@emails) {
                $tank[$i]{'To'} = "$line" ;
                my $mail = $tank[$i] ;
#print Dumper ($mail, $OK_sender);

                if ( sendmail $mail ) {}
                else{print $Mail::Sendmail::error;}
exit;
    
                  print "OK. Log says: $Mail::Sendmail::log \n" if ($v
+erbose);
            }
        }
        else {
            $tank[$i]{'To'} = $tank[$i]->{'From'};
            $tank[$i]{'From'} = "Mailer-Daemon <$username\@$host>";
            $tank[$i]{'Subject'} = "Returned: Sender Unknown";
            my $old_body = $tank[$i]->{'Body'};
            $tank[$i]->{'Body'} = "Your email was returned because you
+ were not found in the list email database.  You need to be subscribe
+d to send to the list.\n\n>>>> Original Message Attached Below: <<<<\
+n>$old_body";
    
            if ( sendmail $tank[$i] ){}
            else{print $Mail::Sendmail::error;}
            
              print "OK. Log says: $Mail::Sendmail::log \n" if ($verbo
+se);
        }

    }
}


#####################

sub check_email {
    my ($from, @emails) = @_;
    my $OK = 0;

    my $address = ();
    my @array = split (/\s/, $from);
    foreach my $line (@array) {
        if ($line =~ /@/) {
            $line =~ s/^<(.*)>$/$1/ ;
            foreach (@emails) {
                $OK = 1 if ($_ =~ /$line/);
            }
        }
    }

    return $OK;
}

############


sub parse_head {
    my (@head) = @_;
    my ($from, $subject);

    foreach (@head) {
        $from = $1 if (/^From: (.*)/);
        $subject = $1 if (/^Subject: (.*)/);
    }
    return ($from, $subject);
}

############


sub check_args {
    if ($#ARGV ne 3) {
        &usage;
    }
    else { 
        return ( $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3] );
    }
}


##########

sub getDate {

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) ; 
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(
+time);
    $mon++; # fixes Matt's Counter bug

    if ($min < 10)  { $min = "0$min";   }
    if ($hour < 10) { $hour = "0$hour"; }
    if ($mday < 10) { $mday = "0$mday"; }
    if ($mon < 10)  { $mon = "0$mon";  }
    if ($sec < 10)  { $sec = "0$sec"; }

    if ( $year < 1900 ) { $year = $year+1900;       }       #fix all t
+hose y2k bugs 

    return "$year-$mon-$mday-$hour-$min-$sec";

}

###############

sub read_list {
    my ($list) = @_;
    print "Opening $list\n" if ($verbose);
    open(LIST,"$list") || die "Can't Open Email List File $list: $!\n"
+;
    my @emails = <LIST>;
    close (LIST); 
    return @emails;      
}

#############

sub usage {

    print " mailfwd USERNAME HOST PASSWORD LIST\n\n";
    exit;
}

#####
[download]