#!/usr/bin/perl -w
#
# $Id: quarantine.pl,v 1.2 2004/04/06 09:17:37 root Exp root $
# Version:      $Revision: 1.2 $
# Date:         $Date: 2004/04/06 09:17:37 $
# Author:       Paul Murphy, Ionix Pharmaceuticals - pmurphy@ionixpharma.com
# Copyright 2004 - permission granted for non-profit use.
# ----------------------------------------------------------------


use MIME::Lite;
use Net::SMTP;
use CGI qw/:standard/;
use CGI::Carp 'fatalsToBrowser';
$CGI::POST_MAX=1024 * 100;  # max 100K posts
$CGI::DISABLE_UPLOADS = 1;  # no uploads

my ( $count, @file_names, $dir, $DONE, @delnames, $delfile);
my ( @envsender, @envrecipients, $subject, @headers );
my ( $sender, @recipients,$recip );
my ( @hdrfrom, @hdrtorecip, $hdrccrecip );
my ( $date, $size, $att_count, $msg, $msg1 );
my ( $SENDERFILE, $RECIPIENTFILE, $HEADERFILE, $MSGFILE, $ATTFILE, $ATTHDRFILE);
my ( $ENTIRE_MSG );
my ( $file, $type, @msgbits, $buffer );
my ( $hdrline, $q, $check );
my ( $uid, $username,%resendto,@resendaddresses,$resenddest,$resendname );
my ( $refreshtime, $autorefresh, $fontsize );
  
# CONFIG SECTION - may be changed
$dir = "/var/spool/MD-Quarantine";
$scriptname= '/cgi-bin/quarantine.pl';
$localsmtp='exchange1';	# internal mail server
$remotesmtp='adelie';	# smart host for outgoing mail, or localhost
$mydomain='ionixpharma.com';	# used to determine mailhost to use
$refreshtime=15;	# seconds before going back to list
$autorefresh=0;		# set to zero to prevent refresh back to list
%resendto = ( 	'none' => '',
		'support' => 'support@ionixpharma.com',
		'pmurphy' => 'pmurphy@ionixpharma.com');
@resendaddresses = ['','support','pmurphy'];
$fontsize= -1;	# absolute or relative size
# END OF CONFIG - no edits below unless you understand the code!

$uid = getlogin || getpwuid($<);
$group = "$(";

$q = new CGI;
chdir $dir;
if (! $q->param())    #send the form
  {
  # send HTML headers and page heading
  print $q->header;
  print $q->start_html('E-mail Quarantine Moderation'),
        $q->h1('Quarantine Moderation');

  # Javascript to enable set/unset of all accept/delete boxes
  print <<EOF;
<script language=javascript>
function AcceptAll()
{
  var boxname;
  var tickcount=1;
  for (var i = 0; i < mainform.elements.length; i++)
  {
    boxname="approve"+tickcount;
    if (mainform.elements[i].name == boxname)
    {
      mainform.elements[i].checked = 1-mainform.elements[i].checked;
      tickcount++;
    }
  }
}
function DeleteAll()
{
  var boxname;
  var tickcount=1;
  for (var i = 0; i < mainform.elements.length; i++)
  {
    boxname="delete"+tickcount;
    if (mainform.elements[i].name == boxname)
    {
      mainform.elements[i].checked = 1-mainform.elements[i].checked;
      tickcount++;
    }
  }
}
</script>
EOF
  # begin the form
  print $q->start_form(-name=>'mainform',-method=>'POST',-action=>$scriptname);
  print "<p>Note: the form will be processed top-to-bottom, and left to right - if you choose to approve and delete a message, both actions will occur in that order.</p>";
  print "<p>Resending a message will <u>not</u> send it to the original recipient.</p>";
  # start with the header row of a table
  print $q->table({-border=>1});
  print $q->Tr( $q->th(['Folder<br>','Approve <br><input type=button value="Toggle All" onClick=\'AcceptAll()\'','Ref<br>','Sender<br>','Recipients<br>','Resend To','Subject<br>','Filename<br>','Reason<br>','Delete<br><input type=button value="Toggle All" onClick=\'DeleteAll()\''])); 
  # get list of quarantined e-mail messages
  $msgcount =0;
  @file_names= &myreaddir($dir);
  
  # process each entry in the quarantine list
  foreach $folder ( @file_names )
    {
    $msgcount++;
    # get the sender details
    print "<tr>";
    print "<td>";
    # start by setting the font
    print "<font size=$fontsize>";
    print "<a href=\"/cgi-bin/quar_display.pl?qdir=$folder\">$folder</a></font></td>";
    print "<td><input type=checkbox name=approve$msgcount>";
    print "<input type=hidden name=folder$msgcount value=\"$folder\"></td>";
    print "<td>$msgcount</td>";
    $file = $folder."/SENDER";
    open(SENDERFILE, $file);
    $sender = <SENDERFILE>;
    $sender =~ s/<//g;
    $sender =~ s/>//g;
    chomp($sender);
    if ( defined ($sender) )
      {
      print "<td><font size=$fontsize>$sender</font>";
      print "<input type=hidden name=\"sender$msgcount\" value=\"$sender\"></td>";
      }
    else
      {
      print "<td><font color=red><font size=$fontsize>Permission denied - check ownership of quarantine folder</font></font></td>";
      }
    close(SENDERFILE);
  
    # get recipient details
    $file = $folder."/RECIPIENTS";
    open(RECIPIENTFILE, $file);
    @recipients = <RECIPIENTFILE>;
    chomp(@recipients);
    print "<td><font size=$fontsize>";
    @reciplist = "";
    foreach $recip ( @recipients )
      {
      $recip =~ s/<//g;
      $recip =~ s/>//g;
      print "$recip ";
      push(@reciplist, $recip);
      }
    print "</font><input type=hidden name=\"recip$msgcount\" value=\"@reciplist\">";
    print "</td>";
    close(RECIPIENTFILE);
  
    # also provide a way to resend to alternative locations
    $resendname='resend'.$msgcount;
    print "<td><font size=$fontsize>";
    print $q->popup_menu($resendname,@resendaddresses,,\%resendto);
    print "</font></td>";

    #  Get the message header details we need - date, subject
    $subject='';
    $file = $folder."/HEADERS";
    open(HEADERFILE, $file);
    @headers = <HEADERFILE>;
    $count =1;
    foreach $hdrline ( @headers )
      {
      #print "Header line $count:  $hdrline\n";
      $count++;
      if ( $hdrline =~ /^Subject:/ )
        {
        $subject = $hdrline;
        $subject =~ s/Subject://i;
        }
      elsif ( $hdrline =~ /^Date:/i )
        {
        $date = $hdrline;
        $date =~ s/Date://i;
        #print "	Date: $date";
        }
      elsif ( $hdrline =~ /^To:/i)
        {
        $hdrtorecip = $hdrline;
        $hdrtorecip =~ s/To://i;
        #print "	To: $hdrtorecip";
        }
      elsif ( $hdrline =~ /^Cc:/i )
        {
        $hdrccrecip = $hdrline;
        $hdrccrecip =~ s/Cc://i;
        #print "	Cc: $hdrccrecip";
        }
      elsif ( $hdrline =~ /^From:/ )
        {
        $hdrfrom = $hdrline;
        $hdrfrom =~ s/From://i;
        #print "	From: $hdrfrom";
        }
      }
    close(HEADERFILE);
  
    # we have to url encode the subject - could contain nasty characters like
    # double-quote or angle brackets
    print "<td><font size=$fontsize>$subject</font><input type=hidden name=\"subject$msgcount\" value=\"".url_encode($subject)."\"></td>";
  # Now check the msg file to see why it was quarantined...
    $DONE=0;
    $count=1;
    print "<td>";
    while ( ! $DONE )
      {
      $file = $folder."/PART.$count.HEADERS";
      open(MSGFILE, $file) or $DONE=1;
      if ( ! $DONE )
        {
        @msg = <MSGFILE>;
	foreach $bit ( @msg )
          {
 	  if ( $bit =~ /Content-type/i )
            {
	    # need to record this for later attachment use
	    #$start= index($bit,'"');
	    $end= rindex($bit,';');
	    $att_type=substr($bit,0, $end);
	    $att_type=~ s/Content-type://i;
	    $att_type=~ s/'//;
	    $att_type=~ s/"//;
	    $att_type=~ s/ //;
	    print "<input type=hidden name=\"att_type".$msgcount."_".$count."\" value=\"$att_type\">";
	    }
	  if ( ( $bit =~ /name=/i) && !( $bit =~ /filename=/i ) )
	    {
            # we're on the right line - now home in on the filename
	    # it probably has quotes around the name, so find the start
            $start= index($bit,'"');
	    # find the end
            $end= rindex($bit,'"');
	    # chop out this bit for more work - if no quotes, we get all of it
            $file = (substr($bit, $start + 1, $end-$start - 1));
	    # if there are no quotes, it still has "name=" at the start
	    $file =~ s/name=//i;
	    # now the only problem is leading whitespace
	    #while ( ( $file =~ /^ / ) || ( $file =~ /^	/ ) ) 
              #{
	      $file =~ s/^\s*//;
	      #$file =~ s/^	//;
              #}
	    print "<font size=$fontsize>$file</font><input type=hidden name=\"file".$msgcount."_".$count."\" value=\"$file\"><br>";

            $att_count = $count;
	    }
	  }
        $count++;
        close(MSGFILE);
        }
      }
    $file = $folder."/MSG.0";
    open(MSGFILE, $file);
    @msg = <MSGFILE>;
    $file = $folder."/MSG.1";
    open(MSGFILE, $file);
    @msg1 = <MSGFILE>;
    print "</td><td><font size=$fontsize>";
    foreach $bit ( @msg )
      {
      print "$bit ";
      }
    foreach $bit ( @msg1 )
      {
      print "$bit ";
      }
    print "</font></td>";
    print "<td><input type=checkbox name=delete$msgcount></td></tr>";
    }
  print $q->Tr( $q->submit(-name=>'Process'), $q->reset);
  print "<tr><td><input type=hidden name=count value=$msgcount></td></tr>";
  print $q->end_form;
  print $q->end_table;
  print $q->end_html;
  print "\n\n";
  }
else
  {
  #process the form
  $dir = "/var/spool/MD-Quarantine";
  chdir $dir;
  # start by getting the count of messages
  $msgcount= $q->param("count");
  
  # start the output
  print $q->header;
  if ( $autorefresh )
    {
    print $q->start_html(-title=>'Moderation results', 
       		-head=>meta({-http_equiv=>'Refresh',
		-content=> $refreshtime."; URL=$scriptname"}));
    }
  else
    {
    print $q->start_html(-title=>'Moderation results'); 
    }

  print $q->h3('<font color=red>Approved messages must be deleted manually!</font>');
  print $q->start_table;

  # now for each potential message, work out if an action has been selected
  $count=0;
  while ( $count < $msgcount )
    {
    $count++;

#######################
# Approve
#######################
    if ( $q->param("approve$count") )	# message approved
      {
      # if the entire message was quarantined, send the whole thing from the
      # saved ENTIRE_MESSAGE file
      $buffer="folder".$count;
      $folder=$q->param($buffer);
      $file = $folder."/ENTIRE_MESSAGE";
      open(ENTIRE_MSG, $file);
      @msg = <ENTIRE_MSG>;
      if ( defined(@msg))	# send whole message
        {
        print "<p>Whole message was quarantined - sending complete.</p>";
        $sender=$q->param("sender$count");
        $recip=$q->param("recip$count");
	send_entire($sender,$recip,$mydomain,$localsmtp,$remotesmtp,@msg);
        }
      else	# only a part was quarantined
        {
        # create the mail message
        # Create a new multipart message:
	# remember the subject is URL encoded!
        $subject='[Quarantined attachments] - '.url_decode($q->param("subject$count"));
        $sender=$q->param("sender$count");
        $recip=$q->param("recip$count");

        print "<p>Partial message was quarantined - reconstructing</p>";
	$att_count=1;
	$DONE=0;
	while ( !$DONE )	# build attachment details
	  {
          $buffer="att_type".$count."_".$att_count;
          $type=$q->param($buffer);
          if (defined($type))
            {
            print "<br>	Attachment $count/$att_count type:".$type.'<br>';
            $buffer="file".$count."_".$att_count;
            $file=$q->param($buffer);
            $buffer="folder".$count;
            $folder=$q->param($buffer);
            push @atts, $type;
	    push @atts, $folder."/PART.".$att_count.".BODY";
	    push @atts, $file;
	    $att_count++;
	    }
          else
            {
            $DONE=1;
            }
	  }
	send_partial($sender,$recip,$subject,$localsmtp,$remotesmtp,$mydomain,@atts);
        }
      print "<p>Message $count approved:";
      print "<br><dd>From:	".$sender;
      print "<br><dd>To:	".$recip;
      print "<br><dd>Subject:	".$subject;
      }

#######################
# Delete
#######################
    if ( $q->param("delete$count") )	# message to be deleted
      {
      $olddir="/var/spool/MD-Quarantine/".$q->param("folder$count");
      print "<p>Message $count marked for deletion:";
      print "<br><dd>From:	".$q->param("sender$count");
      print "<br><dd>To:	".$q->param("recip$count");
	# remember the subject is URL encoded!
      print "<br><dd>Subject:	".url_decode($q->param("subject$count"));
      print "<br>";
      @delnames= &myreaddir($olddir);
      foreach $delfile ( @delnames )
        {
        unlink "$olddir/$delfile"||print "<font color=red>Cannot delete $delfile!</font>";
        }
      (rmdir "$olddir" && print "<font color=blue> Deleted OK. </font>") ||print "<font color=red>Cannot rmdir $olddir!</font>";
      }		# end delete


#######################
# Resend
#######################
    if ( $q->param("resend$count") )
      {
      $resenddest=$resendto{$q->param("resend$count")};
      print "<p>Resend to $resenddest</p>";
      # if the entire message was quarantined, send the whole thing from the
      # saved ENTIRE_MESSAGE file
      $buffer="folder".$count;
      $folder=$q->param($buffer);
      $file = $folder."/ENTIRE_MESSAGE";
      open(ENTIRE_MSG, $file);
      @msg = <ENTIRE_MSG>;
      if ( defined(@msg))       # send whole message
        {
        print "<p>Whole message was quarantined - sending complete.</p>";
        $sender=$q->param("sender$count");
        send_entire($sender,$resenddest,$mydomain,$localsmtp,$remotesmtp,@msg);
        }
      else      # only a part was quarantined
        {
        # create the mail message
        # Create a new multipart message:
        # remember the subject is URL encoded!
        $subject='[Quarantined attachments] - '.url_decode($q->param("subject$count"));
        $sender=$q->param("sender$count");
        $recip=$resenddest;

        print "<p>Partial message was quarantined - reconstructing</p>";
        $att_count=1;
        $DONE=0;
        while ( !$DONE )        # build attachment details
          {
          $buffer="att_type".$count."_".$att_count;
          $type=$q->param($buffer);
          if (defined($type))
            {
            print "<br> Attachment $count/$att_count type:".$type.'<br>';
            $buffer="file".$count."_".$att_count;
            $file=$q->param($buffer);
            $buffer="folder".$count;
            $folder=$q->param($buffer);
            push @atts, $type;
            push @atts, $folder."/PART.".$att_count.".BODY";
            push @atts, $file;
            $att_count++;
            }
          else
            {
            $DONE=1;
            }
          }
        send_partial($sender,$recip,$subject,$localsmtp,$remotesmtp,$mydomain,@atts);
	}
 

      }
    }
  print $q->end_table;
  if ($autorefresh) 
    {
    print $q->h3('Page will reload quarantine list shortly...');
    }
  print "<a href=$scriptname>Return to list</a>";
  print $q->end_html;
  }

sub url_encode {
    my $text = shift;
    $text =~ s/([^a-z0-9_.!~*'(  ) -])/sprintf "%%%02X", ord($1)/ei;
    $text =~ tr/ /+/;
    return $text;
}

sub url_decode {
    my $text = shift;
    $text =~ tr/\+/ /;
    $text =~ s/%([a-f0-9][a-f0-9])/chr( hex( $1 ) )/ei;
    return $text;
}

sub myreaddir
{
my ( $dir ) = @_;
my ( @list );
my ( $FDIR );
my ( $count,@new );

opendir (FDIR, $dir) || die("Unable to open directory $dir");
@list=readdir(FDIR);

foreach $file ( @list )
  {
  if (  $file =~ /^[A-z]/ )
    {
    push(@new,$file);
    }
  }
return @new;
}

sub send_entire
{
my ($sender,$recip,$mydomain,$localsmtp,$remotesmtp,@msg) = @_;
my $check, $smtp;

$check=0;
if ( $recip =~ /$mydomain/i )
  {
  print "<font color=#ff00ff>Sending to $recip via $localsmtp</font>\n";
  $smtp = Net::SMTP->new($localsmtp,Timeout => 60, Debug=>1);
  }
else
  {
  print "<font color=#ff00ff>Sending to $recip via $remotesmtp</font>\n";
  $smtp = Net::SMTP->new($remotesmtp,Timeout => 60, Debug=>1);
  }
if ( defined ($smtp) )
  {
  $check+=$smtp->mail($sender);
  $check+=$smtp->to($recip);
  $check+=$smtp->data(@msg);
  $check+=$smtp->quit;  
  if ( $check == 4 )
    {
    print "<font color=blue>Sent OK.</font>";
    }
  else
    {
    print "<font color=red>Error sending at step $count!</font>";
    }
  }
else
  {
  print "<font color=red>Cannot connect to SMTP server!</font>";
  }
}

sub send_partial
{
my ($sender,$recip,$subject,$localsmtp,$remotesmtp,$mydomain,@atts) = @_;
my $msg;
my $att_count, $DONE;

$msg = new MIME::Lite (
                    From    =>$sender,
                    To      =>$recip,
                    Subject =>$subject,
                    Type    =>'multipart/mixed');
    
# Add message part (each "attach" has same arguments as "new"):
attach $msg 
       Type     =>'TEXT',   
       Data     =>"\n\nThe part of your message which was quarantined is attached to this message.  Sorry for the delay.\n\n";  

# now the attachments
$DONE=0;
$att_count=1;
while ( ! $DONE)
  {
  $type=pop @atts;
  if (defined($type))
    {
    print "<br>	Attachment $att_count type:".$type.'<br>';
    $folder=pop @atts;
    $file=pop @atts;
    attach $msg 
                    Type     =>$type,
                    Path     =>$folder,
                    Filename =>$file;
    print "<p>Attached file ".$file."</p>";
    $att_count++;
    }
  else
    {
    $DONE=1;
    }
  }
if ( $recip =~ /$mydomain/i )
  {
  print "<font color=#ff00ff>Sending via $localsmtp</font>\n";
  MIME::Lite->send('smtp', $localsmtp, Timeout=>60)||print "<font color=red>Error sending to $localsmtp</font>";
  }
else
  {
  print "<font color=#ff00ff>Sending via $remotesmtp</font>\n";
  MIME::Lite->send('smtp', $remotesmtp, Timeout=>60)||print "<font color=red>Error sending to $remotesmtp</font>";
  }
$msg->send||print "<font color=red>Error sending!</font>";
}
1;