jMailRPC : email-based remote procedure executor -- or-- email-based FTP

@rem = '
@perl -S "%0" %1 %2 %3 %4 %5
@goto _perldone
@rem ';
#!perl -w

use jMailRPC;

my %cfg = {};

$cfg{MailHost} = 'mail.your.server.com';       #email server ip address
$cfg{MailAddress} = 'your_email@account.com';  #email account
$cfg{MailPassword} = 'your_password';          #password to email account
$cfg{ReplyAddress} = 'unknown@unknown.com';    #reply email address

$cfg{cShortDelay} = 60;            # number of seconds between polls when in short delay (default: 60)
$cfg{cLongDelay} = 60*10;          # number of seconds between polls when in long delay (default: 600)
$cfg{cCountToLongDelay} = 10;      # number of minutes until we go to longdelay (default: 10)
$cfg{Logname} = 'logs/mail.log';   #log file path (default: logs/mail.log)
$cfg{Tempdir} = 'c:/temp';         #directory to create zips, etc. in  (default: c:/temp)
$cfg{ZipPassword} = 'jzipper';     #password to the zip file (default: jzipper)

jMailRPC::main(\%cfg);
__END__
:_perldone

#!perl -w
use strict;

package jMailRPC;

#todo: what about multiple commands in a single message?

#---------------------------
use Win32::OLE;
use jMailSession;
use jMailMessage;
use File::Find;
use jZipper;

#---------------------------
#-- CONFIGURATION
my $cShortDelay = 0;        # number of seconds between polls when in short delay
my $cLongDelay = 0;         # number of seconds between polls when in long delay
my $cCountToLongDelay = 0;  # number of minutes until we go to longdelay
my $gMailHost = '';         # email server
my $gMailAddress = '';      # email account
my $gMailPassword = '';     # password to email account
my $gReplyMailAddress = ''; # email address to reply with
my $gLogname = '';          # log file path
my $gTempdir = '';          # directory to create zips, etc. in 
my $gZipPassword = '';      # the password used to protect the zip file

#---------------------------
#-- GLOBALS
my $gHaltCalled = 0;
my $gStartingDir = '';
my $gZipCount = 1;
my $gDelayCount = 0;
my $gPollDelay = 0;   # number of seconds between polls; calculated
my %gCommandMap = ();

#---------------------------
sub logit(@)
  {
  print @_;
  open (LOG, ">> $gStartingDir\\$gLogname");
  print LOG @_;
  close(LOG);
  }

#---------------------------
sub SendIt
  {
  my ($replyaddr, $thecmd, $zip, $body) = @_;

  logit $body, "\n";
  $! = 0;
	
	my $smtp = Win32::OLE->new("CDONTS.NewMail");
	logit "smtp 'new' result: $Win32::OLE::LastError\n";
	if (defined $zip)
	  {
    my $tempzip = $zip->Save();
	  $smtp->AttachFile($tempzip);
	  }
  $smtp->Send($gReplyMailAddress, $replyaddr, "Result of command: $thecmd", $body, 1);
  logit "Sent response: '$!' '$Win32::OLE::LastError' \n";
  undef $smtp;
  }

#---------------------------
sub SendReply($$@)
  {
  my $replyaddr = shift;
  my $thecmd = shift;
  my @reply = @_;

  my $body = join '', @reply;
  SendIt($replyaddr, $thecmd, undef, $body);
  }

#---------------------------
sub SendFile($$$)
  {
  my ($replyaddr, $thecmd, $file) = @_;

  $file =~ s/^\s*//;
  $file =~ s/\s*$//;
  logit "file: '$file'\n";
  $file =~ s/\//\\/g;
  my ($dir, $filename) = $file =~ /(.*)\\([^\\]+)$/;

  my $body = '';
  my $tempzip = "$gTempdir/mail" . $gZipCount . ".zip";
  unlink $tempzip;
  logit "zip : $tempzip\n";
  $gZipCount++;

  my $zip = new jZipper($tempzip, $gZipPassword);
  my $filecount = (-d $file) ? 
             $zip->AddDirectory(\$body, $file, $filename) :  
             $zip->AddFiles(\$body, $dir, $filename);

  SendIt($replyaddr, $thecmd, $filecount == 0 ? undef : $zip, $body);
  }

#---------------------------
#-- cmd_xx : these are incoming message handlers
#-- in general, you can send a reply or send a file
#-- sending a file is just like sending a reply but it also has a zip file attached
#---------------------------

#---------------------------
# command to halt the service remotely
sub cmd_halt
  {
  my ($replyaddr, $cmd, $parms) = @_;
  SendReply($replyaddr, $cmd, ("Halt called...halting."));
  $gHaltCalled = 1;
  }

#---------------------------
# get directory information
sub cmd_dir()
  {
  my ($replyaddr, $cmd, $parms) = @_;    
  my @reply = `$cmd $parms`;
  SendReply($replyaddr, $cmd, @reply);
  }

#---------------------------
# get some file(s)
sub cmd_get()
  {
  my ($replyaddr, $cmd, $parms) = @_;    
  SendFile($replyaddr, $cmd, $parms);
  }

#---------------------------
# get the log
sub cmd_log()
  {
  my ($replyaddr, $cmd, $parms) = @_;    
  open(FH, "< $gStartingDir\\$gLogname");
  my @reply = <FH>;
  close(FH);
  SendReply($replyaddr, $cmd, @reply);
  }

#---------------------------
sub HandleMessage($$)
  {
  my ($msgnum, $rmsg) = @_;
  logit "\nProcessing message: ", $msgnum, "\n";
  my $msg = jMailMessage->new($rmsg);
  $msg->Parse();
  my $replyaddr = $msg->ReplyAddress();
  my $cmd = $msg->Command();
  my $parms = $msg->Parameters();
  
  return if $cmd eq '';
  return if $replyaddr eq '';

  $cmd = lc $cmd;
  logit "cmd  : '$cmd'\n";
  logit "parms: '$parms'\n";
  logit "addr : '$replyaddr'\n";

  my $rcmd = $gCommandMap{$cmd};
  if (defined $rcmd)
    {
    &$rcmd($msg->ReplyAddress(), $cmd, $msg->Parameters());
    }
  else
    {
    SendReply($replyaddr, $cmd, ('Nice try! Only dir and log are supported.'));
    }

  logit "----> Done\n\n";
  }

#---------------------------
#put dynamic polling delay: 
#     starts off at default of cShortDelay seconds
#     if no messages for cCountToLongDelay tries, goes to cLongDelay seconds
#     if message comes in, goes to cShortDelay
sub delay()
  {
  $gDelayCount++;
  $gPollDelay = $cLongDelay if ($gDelayCount >= $cCountToLongDelay);
  logit($gPollDelay == $cShortDelay ? 'S' : 'L');
  sleep($gPollDelay);
  }

#---------------------------
# we've had in incoming message, switch to short delay mode
sub delay_HandleMessage()
  {
  $gPollDelay = $cShortDelay;
  $gDelayCount = 0;
  }

#---------------------------
sub main($)
  {
  my ($rcfg) = @_;

  #mandatory  
  $gMailHost = $$rcfg{MailHost} || die('you must provide an ip addressto your mail server');
  $gMailAddress = $$rcfg{MailAddress} || die('you must provide an email account name (usually the email address)');
  $gMailPassword = $$rcfg{MailPassword} || die('you must provide a password for the email account');
  $gReplyMailAddress = $$rcfg{ReplyAddress} || die('you must provide a reply email address');

  #optional: defaults shown below
  $cShortDelay = $$rcfg{cShortDelay} || 60;
  $cLongDelay = $$rcfg{cLongDelay} || 60*10;
  $cCountToLongDelay = $$rcfg{cCountToLongDelay} || 10;
  $gPollDelay = $cShortDelay;
  $gLogname = $$rcfg{LogName} || 'logs/mail.log'; 
  $gTempdir = $$rcfg{Tempdir} || 'c:/temp'; 
  $gZipPassword = $$rcfg{ZipPassword} || "jzipper";

  #globals: 
  $gHaltCalled = 0;
  $gStartingDir = '';
  $gZipCount = 1;
  $gDelayCount = 0;
  
  #load the command map
  #to add a new command:
  #  1) create a subroutine with 3 input parms ($replyaddr, $cmd, $parms)
  #  2) add a reference to the subroutine in the map
  $gCommandMap{'halt'} = \&cmd_halt;
  $gCommandMap{'get'} = \&cmd_get;
  $gCommandMap{'dir'} = \&cmd_dir;
  $gCommandMap{'log'} = \&cmd_log;

  #create the temp directory if it doesn't exist  
  mkdir $gTempdir if ! -e $gTempdir;

  #remember where we started from
  $gStartingDir = `cd`;
  chomp $gStartingDir;
  
  #define a handler. This will be called 
  #for each incoming message
  my $handler = sub 
    {
    my ($pop3) = @_;
    
    #reset the delay counter so we don't go to long mode yet
    delay_HandleMessage();
    
    #handle the incoming message
    HandleMessage($pop3->Msgnum(), $pop3->Get());
    $pop3->Stop() if $gHaltCalled;
    } ;

  #loop until halt: handle all incoming messages and delay
  while(1)
    {
    jMailMessage::HandleAll($handler, $gMailHost, $gMailAddress, $gMailPassword);
    if ($gHaltCalled)
      {
      logit("Halt called\n");
      exit(1);
      }
    delay();
    }
  }

1;

#!perl -w
use strict;

package jMailMessage;
use jReplyAddress;

#---------------------------
#-- main routine, 
#-- connects to POP3 email server and runs until all message are done
#-- the handler is passed in by the user
sub HandleAll($$$$)
{
  my ($rhandler, $mailhost, $mailaddress, $mailpassword) = @_;
  my $pop3 = jMailSession->new();
  $pop3->Init($mailhost, $mailaddress, $mailpassword);
  while($pop3->IsMore())
    {
    &$rhandler($pop3);  
    }
  $pop3->Term();
}

#---------------------------
#-- ctor: 
sub new
  {
  my ($class, $rmsg) = @_;
  my $self = {};
  bless($self, $class);
  $self->{msg} = $rmsg;
  $self->{cmd} = '';
  $self->{parms} = '';
  $self->{replyaddr} = jReplyAddress->new();
  return $self;
  }

#---------------------------
#-- parses an incoming message
sub Parse
  {
  my $self = shift;
  return if (! defined $self->{msg});
  $self->_ParseMessage(@{$self->{msg}});
  }

#---------------------------
#-- gets the best reply address it can find
sub ReplyAddress
  {
  my $self = shift;
  return $self->{replyaddr}->GetBestAddress();
  }

#---------------------------
#-- this is the command found in the message
sub Command
  {
  my $self = shift;
  return $self->{cmd};
  }

#---------------------------
#-- these are any parameters found in the message
sub Parameters
  {
  my $self = shift;
  return $self->{parms};
  }

#---------------------------
#-- does the actual parsing
#-- format is:
#--     cmd
#--     parameters
#--     .
#-- the command is on the first line of incoming message at position 0
#-- the parameters are free form and are parsed in as an entire line
#-- multiple lines of parameters are concatenated together
#-- the dot is optional but can be used to ensure that virus checkers
#-- don't interfere with the parsing
sub _ParseMessage
  {
  my ($self, @msg) = @_;

  $self->{cmd} = '';
  $self->{parms} = '';
  my $state = 0;
  foreach my $line (@msg)
    {
    chomp $line;
    
    if ($state == 0)
      {
      # we're parsing headers until an empty line is found
      $state = 1 if ($line eq "");
      &jMailRPC::logit (" hdr: $line\n");
      $self->{replyaddr}->ParseHeaderLine($line);
      }
    elsif ($state == 1)
      {
      # found the command
      &jMailRPC::logit("bdy1: $line\n");
      $self->{cmd} = $line;
      $self->{cmd} =~ s/^\s*//;
      $self->{cmd} =~ s/\s*$//;
      $state = 2;
      }
    elsif ($state == 2)
      {
      # getting the parameters
      &jMailRPC::logit("bdy2: $line\n");
      last if ($line eq ".");
      $self->{parms} .= $line . ' ';
      }
    }
  }

1;

#!perl -w
use strict;

package jMailSession;

use Net::POP3;

#---------------------------
sub new
  {
  my ($class) = @_;
  my $self = {};
  bless($self, $class);
  $self->{pop3} = 0;
  $self->{curmsg} = 0;
  $self->{msgcount} = 0;
  $self->{initdone} = 0;
  $self->{stop} = 0;
  return $self;
  }

#---------------------------
sub DESTROY
  {
  my $self = shift;
  Term();
  }

#---------------------------
sub Init
  {
  my ($self, $mailhost, $mailaccount, $mailpassword) = @_;
  $self->{pop3} = Net::POP3->new($mailhost, Timeout => 20);
  if (!defined $self->{pop3})
    {
    &jMailRPC::logit("Net::Pop3 new failed: $@ $!\n");
    return;
    }
  $self->{msgcount} = $self->{pop3}->login($mailaccount, $mailpassword);
  $self->{curmsg} = 1;
  $self->{initdone} = 1;
  }

#---------------------------
sub Stop
  {
  my $self = shift;
  $self->{stop} = 1;
  }

#---------------------------
sub Term
  {
  my $self = shift;
  $self->{pop3}->quit if $self->{initdone};
  $self->{initdone} = 0;
  }

#---------------------------
sub IsMore
  {
  my $self = shift;
  return 0 if $self->{stop};
  return 0 if !$self->{initdone};
  return 0 if !defined $self->{msgcount};
  return 0 if $self->{msgcount} == 0;
  return $self->{curmsg} <= $self->{msgcount};
  }

#---------------------------
sub Msgnum
  {
  my $self = shift;
  return $self->{curmsg};
  }

#---------------------------
sub Get
  {
  my $self = shift;
  return 0 if !$self->{initdone};
  my $m = $self->{pop3}->get($self->{curmsg});
  $self->{pop3}->delete($self->{curmsg});
  $self->{curmsg}++;
  return $m;
  }

1;

#!perl -w
use strict;
package jReplyAddress;

#---------------------------
sub new
  {
  my ($class) = @_;
  my $self = {};
  bless($self, $class);
  $self->{replyto} = '';
  $self->{returnpath} = '';
  $self->{from} = '';
  return $self;
  }

#---------------------------
sub DESTROY
  {
  my $self = shift;
  }

#---------------------------
sub ParseHeaderLine
  {
  my ($self, $line) = @_;
  $self->{line} = $line;
  #print "checking hdr line: '$self->{line}'\n";
  $self->_CheckReplyToAddress();
  $self->_CheckReturnPathAddress();
  $self->_CheckFromAddress();
  }

#---------------------------
sub GetBestAddress
  {
  my ($self) = @_;
  #print "best:replyto   : '$self->{replyto}'\n";
  #print "best:returnpath: '$self->{returnpath}'\n";
  #print "best:from      : '$self->{from}'\n";
  return $self->{replyto}    if $self->{replyto} ne '';
  return $self->{returnpath} if $self->{returnpath} ne '';
  return $self->{from}       if $self->{from} ne '';
  return '';
  }

#---------------------------
sub _CheckReplyToAddress
  {
  my ($self) = @_;
  return if $self->{replyto} ne '';  # already filled
  return if $self->{line} !~ /^Reply-To:/i;
  ($self->{replyto}) = $self->{line} =~ /^Reply-To:\s+<([^>]+)>/i;
  }

#---------------------------
sub _CheckReturnPathAddress($)
  {
  my ($self) = @_;
  return if $self->{returnpath} ne '';  # already filled
  return if $self->{line} !~ /^Return-Path:/i;
  ($self->{returnpath}) = $self->{line} =~ /^Return-Path:\s+<([^>]+)>/i;
  }

#---------------------------
sub _CheckFromAddress($)
  {
  my ($self) = @_;
  return if defined $self->{from} and $self->{from} ne '';  # already filled
  return if $self->{line} !~ /^From:/i;
  my $junk;
  ($junk, $self->{from} ) = $self->{line} =~ /^From:\s+("[^"]*")\s+<([^>]+)>/i;
  }

1;

#!perl -w
use strict;
package jZipper;

use Archive::Zip;
use File::Find;
use jMailRPC;

#---------------------------
sub new
  {
  my ($class, $fname, $zippassword, $basezip) = @_;
  my $self = {};
  $self->{mZipname} = $fname;
  $self->{mZipPassword} = $zippassword;
  $self->{mZip} = defined $basezip ? $basezip : new Archive::Zip;
  bless($self, $class);
  return $self;
  }

#---------------------------
sub Save
  {
  my ($self) = @_;
  $self->pWriteToFileNamed($self->{mZipname});
  return $self->{mZipname};
  }

#---------------------------
sub AddFiles
  {
  my ($self, $rbody, $dir, $filespec) = @_;

  jMailRPC::logit("adding files '$filespec' from dir '$dir' to zip...\n");

  $filespec =~ s/\\/\\\\/g;
  $filespec =~ s/\./\\\./g;
  $filespec =~ s/\*/\.\*/g;
  $filespec =~ s/-/\./g;

  #can't use find() here; it does a recursive search and
  #$File::Find::prune = 1 does not work

  #save where we are
  my $cwd = `cd`;
  chdir($dir);

  my $filecount = 0;
  foreach my $f (<*>)
    {
    next if $f eq '.' || $f eq '..';
    next unless ((-f $f));
    next unless $f =~ /^$filespec/xi;
    jMailRPC::logit ("file added: $f\n");
    $self->pAddFile($dir . '\\' . $f, $f);
    $filecount++;
    }
  #restore the curent directory
  chdir($cwd);
  $$rbody = "Found $filecount files that matched '$filespec' in '$dir'\n";
  return $filecount;
  }

#---------------------------
sub AddDirectory
  {
  my ($self, $rbody, $rootdir) = @_;
  jMailRPC::logit("adding directory '$rootdir' to zip...\n");
  
  my $filecount = 0;
  my $adder = sub {
    return if $_ eq '.' || $_ eq '..';
    #print "'$_' '$File::Find::dir' '$File::Find::name'\n";
    my $relname = '';
    if (length($File::Find::dir) > length($rootdir)+1)
      {
      $relname = substr($File::Find::dir, length($rootdir)+1);
      }
    #print "file: $relname - $_\n";
    my $fname = $relname eq '' ? $_ : $relname . '\\' . $_;
    $self->pAddFile($File::Find::name, $fname);
    $filecount++;
    } ;
  find ($adder, $rootdir);
  $$rbody = "Found $filecount files in $rootdir\n";
  return $filecount;
  }

#---------------------------
sub pAddFile($$$)
  {
  my ($self, $path, $newpath) = @_;
  #$self->{mZip}->addFile($path, $newpath);
  
  my $out = `7za.exe a -tzip -p$self->{mZipPassword} -bd $self->{mZipname} $path`;
  jMailRPC::logit ($out);
  }

#---------------------------
sub pWriteToFileNamed($$)
  {
  my ($self, $path) = @_;
  #do nothing for now.
  }
  
1;