# 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);
            }
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.