#!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 the 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 num $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 ($verbose);
			}
		}
		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 subscribed 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 ($verbose);
		}

	}
}


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

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 those 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;
}

#####