Category: E-mail
Author/Contact Info G. van Bavel admin@slashdot.demon.nl
Description: Okay, I'm a 4-week-old Perl newbie, and this is my first stab at a mail forwarding script. It's meant to forward mail to an external account - hence the 100 kB message limit. It isn't beautiful, elegant or whatever, but it works. Feel free to comment on it or use parts of it for your own. Any onther advice is welcome too; I want to learn more ! 
# This script checks a certain account and forwards all new mail
# to a specific address, based on the size of it.
# (< 100 kb = OK)
#
# v0.0 - 04/04/2001 First functional version
# v0.1 - 04/04/2001 Logging function added
# v1.0 - 04/04/2001 Small correction regarding headers 
# v1.1 - 05/04/2001 Cleaned up script and removed various trappings
#                   Programm doesn't have any output anymore, save
#                   for the logfiles.

# The script is designed to run with Exchange 5.5 from a Win9x client.
# I have no other way of testing it.

use Mail::POP3Client;
use Mail::Sender;

logit ("Session start.");

$pop = Mail::POP3Client->new("username",
                             "password",
                             "mail.server.com",
                             110, );

$d = $pop->Alive();
if ($d != 1) {
    logit ("Connection failed - End script.");
    exit 0;
    }

logit ("Retrieving mailbox data.");

$number = $pop->Count;
@msglst = $pop->List();

logit ("Messages: $number .");

foreach $element(@msglst) {
        $dummy = $element;
        $sp    = index $element," ";
        $left  = substr $element, 0, $sp;
        $right = substr $element, $sp;
        $left  = $left+0;
        $newlist[$left] = $right;
        }

# If an older file exists, open it and get the number of mails present
# last time.

$lasttime = 0;
if (fexist ("LASTTIME.DAT")) {
   open(DATA,"LASTTIME.DAT");
   $lasttime = <DATA>;
   chomp $lasttime;
   close(DATA);
   logit ("Last time: $lasttime messages.");
   } else {
   logit ("No DAT-file present.");
   logit ("All messages marked as new.");
   }

# Save current number of messages...

open(DATA,">LASTTIME.DAT");
print DATA "$number";
close(DATA);

# Retrieve the previous message numbers and sizes
# (Assumption is message numbers don't change if nothing is ever alter
+ed)

$i = 0;
if (fexist ("LASTTIME.HSH")) {
   open(DATA, "LASTTIME.HSH");
   while ($size = <DATA>) {
          $i++;
          chop $size;
          $oldlist[$i] = $size;
          }
   close(DATA);
   } 

# Now compare the two arrays element-for-element.

$d = 0;
$hit = 0;

for ($d ; $d <= $number; $d++) {

    # Compare the size of two messages
    if ($newlist[$d] != $oldlist[$d]) {
       # If sizes are different, and new message < 100 kB, then
       # forward it to the other account.

       $hit++;
       #print "Message number $d is new.";
       $msgnum = $d;

       $myheaders = $pop->Head($msgnum);
       $mymessage = $pop->Body($msgnum);

       # Remove original To: and Cc:-tags (KLUDGE ALERT!)

       $myheaders =~ s/To:(.*)\n//m;
       $myheaders =~ s/Cc:(.*)\n//m;
       
       if (length $mymessage <= 102400) {

           $sender = new Mail::Sender {smtp => 'mail.server.com', from
+ => 'administrator@mail.server.com'};

           $sender->MailMsg({to  => 'otheraccount@mail.server.com', he
+aders => "$myheaders",
                             from =>'administrator@mail.server.com',
                             msg => "$mymessage",
                             });

           $sender->Close;

           logit ("Message $msgnum sent.");

           # Yeah, I know, there should be some error trapping here [s
+hrugs]

          } else {
            logit ("Message $msgnum too large");
          }

       }
    }

if ($hit > 0) {
   # No hits on differences, so nop
   } else {
   logit ("No new messages.");
   }

# Save new list of messages to file.

open(DATA, ">LASTTIME.HSH");
foreach $element (@newlist) {
        if (length $element > 0) {
           $dummy = substr $element,1;
           print DATA "$dummy\n";
           }
        }
close(DATA);

# Explicitly tell the swerver not to delete anything (with Exchange yo
+u
# never know). And it's by the rules, too.

$pop->Reset();

# Close the connection cleanly. 
$pop->Close;

logit("Session closed.");


# ====================================================================
+====
# Subroutine section
#

# This function figures out if a file exists. Returns 1 on success,
# 0 on failure.

sub fexist() {
              my ($test);
              $test = stat("$_[0]");
              if ($test ne "1") {
                                 return 0;
                                }
              else {
                    return 1;
                   }
              }

# Logging sub. Doesn't return anything. Simply logs array to file.

sub logit() {
             $now = localtime;
             ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = l
+ocaltime(time);
             # $year is no. of years since 1900. Correct it.
             $year += 1900;
             # Day is day number in month, base 0. Correct it.
             $day  += 1;
             # Month is number of month in year, base 0. Correct it.
             $mon  += 1;

             $myfilename = "USR"."$mday"."$mon"."$year".".LOG";

             open(LOG,">>$myfilename");
             print LOG $now."\t".$_[0]."\n";
             close(LOG);
            }
Replies are listed 'Best First'.
Re: Exchange E-mail forwarder
by oakley (Scribe) on Apr 06, 2001 at 16:59 UTC
    <Start Slight Rant>
    Things I think you need to do:
    • put your code in <code> tags!
    • insert "use strict;" and "-w" and retest

    I personally dont have a use for this script, but I know a few people who might. I would like to forward this on over to them, but I cant read it and I im not going to spend the time to clean up your code since you apparently didnt read the Perl Monks Site FAQ or most importantly, Writeup Formatting Tips

    <End Slight Rant>

    I am only "slightly ranting" at you for your own good. I have been "yelled" at before too because I didnt read the tips section prior to posting myself - it's just one of those HAVE TO DO style of things and it will save you lots of grief down the line

    -oakley
    Embracing insanity - one twitch at a time >:)
[reply]
      Sorry, but I can only say you're right. I'll read the sections you mention and clean it up. Please accept my apologies in the meantime. It seems I was a little to eager to put it here; let me assure you it won't happen again. Gertjan
[reply]
        You still didn't go for the 'use strict' requirement. Code should be posted that way (ahem), esp. code over 20 lines and that's going to do anything worthwhile. How 'bout
        # This script checks a certain account and forwards all new mail
# to a specific address, based on the size of it.
# (< 100 kb = OK)
#
# v0.0 - 04/04/2001 First functional version
# v0.1 - 04/04/2001 Logging function added
# v1.0 - 04/04/2001 Small correction regarding headers 
# v1.1 - 05/04/2001 Cleaned up script and removed various trappings
#                   Program doesn't have any output anymore, save
#                   for the logfiles.

# The script is designed to run with Exchange 5.5 from a Win9x client.
# I have no other way of testing it.

use strict;
use Mail::POP3Client;
use Mail::Sender;

use vars qw($pop $number @msglst @oldlist @newlist);

# odd storage file names
my $last_time_data = 'LASTTIME.DAT';
my $last_time_hash = 'LASTTIME.HSH';

my $debug = 3;

logit ("Session start.");

$pop = Mail::POP3Client->new("username",
                             "password",
                             "mail.server.com",
                             110, );

my $d = $pop->Alive();
if ($d != 1) {
    logit ("Connection failed - End script.");
    exit 0;
    }

logit ("Retrieving mailbox data.");

$number = $pop->Count;
@msglst = $pop->List();

logit ("Messages: $number .");

# not sure of the format, so split may need \s \s+ or / /
# if they are in order
# push @newlist, split(/ /,$element,2)[$[+1]
# might be better
# it seems like its a zero based number as that's how old list works.
foreach my $element(@msglst) {
        my ($left, $right) = split(" ", $element, 2);
        $left  = $left+0;
        $newlist[$left] = $right;
        }

# If an older file exists, open it and get the number of mails present
# last time.

if ( -e $last_time_data) {
   open(DATA,"$last_time_data")
     or die "can't re-open DATA: $last_time_data: $!";
   my $lasttime = <DATA>;
   chomp $lasttime;
   close(DATA);
   logit ("Last time: $lasttime messages.");
} else {
   logit ("No DAT-file present.\nAll messages marked as new.");
}    # if ( -e $last_time_data) 

# Save current number of messages...

open(DATA,">$last_time_data") 
  or die "can't open DATA: $last_time_data: $!";
print DATA "$number";
close(DATA);

# Retrieve the previous message numbers and sizes
# (Assumption is message numbers don't change if nothing is ever alter
+ed)

if ( -e $last_time_hash) {
   open(DATA, "$last_time_hash")
     or die "can't re-open DATA: $last_time_hash: $!";
   while (my $size = <DATA>) {
          chomp $size;
          push @oldlist, $size;
          }
   close(DATA);
   } 

# Now compare the two arrays element-for-element.

my $hit = 0;

for (my $msgnum ; $msgnum <= $number; $msgnum++) {

    # Compare the size of two messages
    if ($newlist[$msgnum] != $oldlist[$msgnum]) {
       # If sizes are different, and new message < 100 kB, then
       # forward it to the other account.

       $hit++;
       print STDERR "Message number $d is new." if $debug > 3;

       my $myheaders = $pop->Head($msgnum);
       my $mymessage = $pop->Body($msgnum);

       # Remove original To: and Cc:-tags (KLUDGE ALERT!)

       $myheaders =~ s/To:(.*)\n//m;
       $myheaders =~ s/Cc:(.*)\n//m;
       
       if (length $mymessage <= 102400) {

           my $sender = new Mail::Sender {smtp => 'mail.server.com', f
+rom => 'administrator@mail.server.com'};

           $sender->MailMsg({to  => 'otheraccount@mail.server.com', he
+aders => "$myheaders",
                             from =>'administrator@mail.server.com',
                             msg => "$mymessage",
                             });

           $sender->Close;

           logit ("Message $msgnum sent.");

           # Yeah, I know, there should be some error trapping here [s
+hrugs]

          } else {
            logit ("Message $msgnum too large");
          }

   }    # if length mymessage <= 102400
}       # for ($d ; $d <= $number; $d++) 

   # No hits on differences, so nop
logit ("No new messages.") unless ($hit);

# Save new list of messages to file.

open(DATA, ">$last_time_hash")
     or die "can't open DATA: $last_time_hash: $!";
foreach my $element (@newlist) {
        if (length $element > 0) {
## this can't be right - is the size always 1 char????
           my $dummy = substr $element,1;
##         my ($dummy) =~ split(/ /, $element);
##         my ($dummy = $element) =~ s/^\s*(\d+)\s+.*/$1/;
##         my ($dummy) = $element =~ /^\s*(\d+)\s+/;
           print DATA "$dummy\n";
           }
        }    # foreach my $element (@newlist) {
close(DATA);

# Explicitly tell the swerver not to delete anything (with Exchange yo
+u
# never know). And it's by the rules, too.

$pop->Reset();

# Close the connection cleanly. 
$pop->Close;

logit("Session closed.");


# ====================================================================
+====
# Subroutine section
#


# Logging sub. Doesn't return anything. Simply logs array to file.

sub logit() {
             my $now = localtime;
             #($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
+localtime(time);
             my ($mday,$mon,$year,) = (localtime(time))[3,4,5];
             # $year is no. of years since 1900. Correct it.
             #my $year += 1900;
             # Day is day number in month, base 0. Correct it.
             #my $day  += 1;
             # Month is number of month in year, base 0. Correct it.
             #$mon = sprintf("%02d", $mon  += 1);
             #$mday = sprintf("%02d", $mday);

             # Month is number of month in year, base 0. 
             # $year is no. of years since 1900. 
             my $myfilename = sprintf("USR%02d%02d%4d.LOG", $mday, $mo
+n +1, $year + 1900);

             open(LOG,">>$myfilename")
               or die "can't open LOG $myfilename: $!";
             print LOG $now."\t".$_[0]."\n";
             close(LOG);
            }      #  sub logit

        [download]
        I'll admit I'm not really clear on the numbering scheme for msgs or the pop->List return values. but you seem to assume that oldlist will match up w/ newlist usefully, so its seems to be a reset to zero thing.

        a

[reply]
[d/l]

Back to Code Catacombs