#!/usr/bin/perl

require 5.000;

# FBB Word filter & 7PLUS capture
#
# Author:  Stewart Wilkinson G0LGS
#

#
# Nothing below here should need changing (unless its broken)
#

$Vers="0.60";
$VDate="20-Mar-2005";
$VData="M_Filter & 7PLUS capture for XFBB 7.01+ (c) 2005 by G0LGS V${Vers} ${VDate}.";

# Read Settings from FBBCONFIG
&ReadFBB_CFG;

# M_FILTER Config File.
$MYCFG="${CONF}/m_filter.cfg";

# Wrong number of Parameters ?
if( $#ARGV < 4 ){
   printf STDERR "%s\n", ${VData};
   if( ! -f ${MYCFG} ){
      printf STDERR "WARNING: The Config File %s required by m_filter is missing or unreadable.\n", ${MYCFG};
      printf STDERR "Please correct the problem, as Message Filtering will not work without it.\n";
   }
   exit 0;
}

# The Parameters
$Mesg=$ARGV[0];
$Type=$ARGV[1];
$From=$ARGV[2];
$To=$ARGV[3];
$RecNo=$ARGV[4];	# Seems to Always be 0 in XFBB.

# Date / Time
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time);
$SEC=("00".."59")[$sec];
$MIN=("00".."59")[$min];
$HOUR=("00".."23")[$hour];
$MDAY=("00".."31")[$mday];
$MON=("01".."12")[$mon];
$YEAR=("00".."99")[$year % 100];

# Weekly Log File Name
$week=int((${yday}+1) / 7);
$WK=("00".."53")[$week];
$LOGF="${DATA}/log/mftlog.${WK}";

# Some Default Values / Settings
$Subject="(no subject)";
$AUTO7PLUS=1;
$KMAIL=1;
$HMAIL=1;
$LOG=1;
$CAPT="/usr/lib/fbb/filter/m_filter.fwd";

# Read our Config file & build our list of search words.
&ReadMY_CFG;

# Don't try to trap our own Messages, as that will cause an endless loop
if( (${From} =~ /^${WHOAMI}$/) && (${To} =~ /^${SYSCALL}$/ )  ){
   exit 0;
}

# Do we Check Private Messages ?
if( ($Type =~ /p/i) && (!defined($CHECKPRIVATE) || (! $CHECKPRIVATE) ) ){
   exit 0;
}

$Hold=0;
$Kill=0;
$Found="";

# Check To:
foreach $A (@ToFl) {
   if( ${To} =~ /(${A})/i) {
      $Found="$1";
      $line=${To};
      $Hold=1;
      last;
   }
}
if( ${Hold} ){
   &DoMsg("Held","To");
   exit 3;
}

# Check From:
foreach $A (@FmFl) {
   if( ${From} =~ /(${A})/i) {
      $Found="$1";
      $line=${From};
      $Hold=1;
      last;
   }
}
if( ${Hold} ){
   &DoMsg("Held","From");
   exit 3;
}

# Subject / Message ID Checking

# Open dirmes.sys
if( open(DIRMES, '<', ${DIRMES} ) ) {

   # Move to the appropriate Record
   # (Always seems = 0 in XFBB).
   seek(DIRMES, ${RecNo} * 194, 0);

   # Read the Record
   if( read( DIRMES, $Rec, 194 ) == 194 ) {

      # Extract Data from Record.
      ($type,$Stat,$Num,$Size,$Date,$Adjbbs,$Route,$Destn,$to,$MID,$Subject,$Resv,$Crdate,$Stdate,$Bbs1,$Bbs2) =
      unpack("Z Z L L L Z7 Z41 Z7 Z7 Z13 Z61 Z16 L L A10 A10", $Rec);

      # Check Message ID
      foreach $M (@Mid) {
         if( ${MID} =~ /(${M})/i) {
            $Found="$1";
            $Hold=1;
            last;
         }
      }

      if( ${Hold} ){
         &DoMsg("Held", "MID");
         exit 3;
      }

      # Check Subject
      foreach $A (@Subj) {
         if( ${Subject} =~ /(${A})/i) {
            $Found="$1";
            $Hold=1;
            last;
         }
      }

      #Check for Kill Words
      foreach $KILL (@Kill) {
         if( ${Subject} =~ /(${KILL})/i) {
            $Found="$1";
            $Kill=1;
            last;
         }
      }

      if(${Kill}){
         &DoMsg("Killed", "Subject");
         exit 1;
      }

      # Check for Hold Words
      foreach $HOLD (@Hold) {
         if( ${Subject} =~ /(${HOLD})/i) {
            $Found="$1";
            $Hold=1;
            last;
         }
      }

      if( ${Hold} ){
         &DoMsg("Held", "Subject");
         exit 3;
      }

   }

   close(DIRMES);
}

# Open the Message.
if( ! open( MESG, '<', ${Mesg} ) ){
   printf STDERR "Unable to open Message '%s'\n", ${Mesg};
   exit 0;
}

# Check R: Lines
$Pos = tell(MESG);
while(($line = <MESG>) ){
   chomp($line);

   # Is this an R-Line ?
   if( $line =~ /^R\:\d{6,}\/\d{4}[zZ]{0,1}\s+\d*\@[\:]{0,1}(\S+)/i ) {

      if( !defined(${Via}) ) {
         $Via = $1;
         $Via =~ /^(\w*)\.(.*)$/;
         $via = $1;
      }

      foreach $RL (@Rlin) {
         if( $line =~ /(${RL})/i) {
            $Found="$1";
            $Hold=1;
            last;
         }       
      }
      if( $Found ){
         last;
      }

      foreach $KILL (@Kill) {
         if( $line =~ /(${KILL})/i) {
            $Found="$1";
            $Kill=1;
            last;
         }
      }
      if( $Found ){
         last;
      }

      foreach $HOLD (@Hold) {
         if( $line =~ /(${HOLD})/i) {
            $Found="$1";
            $Hold=1;
            last;
         }
      }
      if( $Found ){
         last;
      }

   # No more R:Lines
   }else{
      seek(MESG, $Pos, 0);
      last;
   }

}continue{
   $Pos = tell(MESG);
}

if( ${Kill} ){
   &DoMsg("Killed", "R-line");
   close(MESG);
   exit 1;
}

if( ${Hold} ){
   &DoMsg("Held", "R-line");
   close(MESG);
   exit 3;
}

$Is7plus=0;

# Check for 7PLUS
if( defined(${AUTO7PLUS}) && ${AUTO7PLUS} ) {

   # Check if this the Message has any 7plus
   $Pos = tell(MESG);
   while($line = <MESG>){
      chomp($line);

      # Translate 'non-printable' characters to '.'
      $line =~ s/[\x01-\x1f]/\./g;
      $line =~ s/[\x80-\xff]/\./g;

      # Ignore blank lines
      if( $line =~ /^\s*$/ ){
         next;
      }elsif( $line =~ /\_7\+/ ){
         ${Is7plus} = 1;
         last;
      }
   }
   seek(MESG, ${Pos}, 0);

   # Append to 'mfilter.fwd' file
   if( ${Is7plus} ){
      if( open( CAPT, '>>', ${CAPT} ) ){

         # Message Header
         printf CAPT "SP %s \< %s\n", ${To}, ${From};
         printf CAPT "%s\n", ${Subject};      

         # Start at top Of Message
         seek(MESG, 0, 0);
         # Append to file
         print CAPT <MESG>;

         # Reset MESG pointer for rest of checks.
         seek(MESG, ${Pos}, 0);

         printf CAPT "/EX\n";
         close(CAPT);
      }
   }
}

# Check the Message Text
$Pos = tell(MESG);

while($line = <MESG>){
   chomp($line);

   # Translate 'non-printable' characters to '.'
   $line =~ s/[\x01-\x1f]/\./g;
   $line =~ s/[\x80-\xff]/\./g;

   # Ignore blank lines
   if( $line =~ /^\s*$/ ){
      next;
   }

   # Check for Kill Words
   foreach $KILL (@Kill) {
      if( $line =~ /(${KILL})/i) {
         $Found="$1";
         $Kill=1;
         last;
      }
   }
   if($Found){
      last;
   }

   # Check for Hold Words
   foreach $HOLD (@Hold) {
      if( $line =~ /(${HOLD})/i) {
         $Found="$1";
         $Hold=1;
         last;
      }
   }

   if($Found){
      last;
   }
}continue{
   $Pos = tell(MESG);
}

if(${Kill}){
   &DoMsg("Killed", "Message");
   close(MESG);
   exit 1;
}

if(${Hold}){
   &DoMsg("Held", "Message");
   close(MESG);
   exit 3;
}

close(MESG);

# Message Check complete / Tell XFBB to accept message
exit 0;

# Functions used above

# Generate LOG Entry / SYSOP Message

sub DoMsg
{
   local( $Action ) = $_[0];
   local( $Where ) = $_[1];

   if( defined(${LOG}) && ${LOG} ){
      if( open(LOG, '>>', ${LOGF} ) ) {

         if( defined($via) ) {
            printf LOG "%02d/%02d/%02d %02d:%02d:%02d %s Fm:%s To:%s Via:%s Fnd:%s in %s\n", ${MDAY}, ${MON},${YEAR},${HOUR},${MIN},${SEC}, ${Action}, ${From}, ${To}, ${via}, ${Found}, ${Where};
         }else{ 
            printf LOG "%02d/%02d/%02d %02d:%02d:%02d %s Fm:%s To:%s Fnd:%s in %s\n", ${MDAY}, ${MON},${YEAR},${HOUR},${MIN},${SEC}, ${Action}, ${From}, ${To}, ${Found}, ${Where};
         }

         close(LOG);
      }
   }

   # Generate SYSOP Message ?

   if(   ( (${Action} =~ /^killed/i) && (defined(${KMAIL}) && ${KMAIL}) ) 
      || ( (${Action} =~ /^held/i  ) && (defined(${HMAIL}) && ${HMAIL}) )  ) {

      if( open(LOCK, '>', ${LOCK} ) ) {

         printf LOCK "$$";

         if( open(MAIL, '>>', ${MAIL} ) ){

            printf MAIL "SP %s < %s\n", ${SYSCALL}, ${WHOAMI};
            printf MAIL "Message from: %s ${Action}\n\n", ${From};
            printf MAIL "%s\n\n", ${VData};

            if( $Where =~ /^Message/i ){            

               printf MAIL "Message From: %s To: %s - %s because %s contained:\n", ${From}, ${To}, ${Action}, ${Where};
               printf MAIL "the word or phrase '%s' in the following line from the message:-\n\n", ${Found};
               printf MAIL "%s\n\n", ${line};

            }elsif( $Where =~ /^Subject/i ){            

               printf MAIL "Message From: %s To: %s - %s because %s contained\n", ${From}, ${To}, ${Action}, ${Where};
               printf MAIL "the word or phrase '%s' (Subect: '%s')\n\n", ${Found}, ${Subject};

            }else{

               printf MAIL "Message From: %s To: %s - %s because %s contained\n", ${From}, ${To}, ${Action}, ${Where};
               printf MAIL "the word or phrase '%s'\n\n", ${Found};

            }

            if( defined(${Via}) ) {
               printf MAIL "\nThe message was forwarded from '%s'\n\n", ${Via};
            }

            printf MAIL "/EX\n";
            close(MAIL);
         }

         close(LOCK);
         unlink(${LOCK});
      }
   }
}

sub IsEnabled
{
   local($Ret) = 0;
   local($P) = $_[0];

   if( ($P =~ /^0/) || ($P =~ /^n\S*/i) || ($P =~ /^off/i) || ($P =~ /^di\S*/i) ){
         ${Ret}=0;

   }elsif( ($P =~ /^1/) || ($P =~ /^y\S*/i) || ($P =~ /^ok/i) || ($P =~/^on/i) || ($P =~ /^en\S*/i) ){
         ${Ret}=1;

   }

   return ${Ret};
}

sub ReadFBB_CFG
{
   # Where is FBB Config File
   $FBBCONF="/etc/ax25/fbb.conf";

   if( defined( $ENV{FBBCONF} ) && "$ENV{FBBCONF}" != "" ){
      $FBBCONF = $ENV{FBBCONF}
   }

   # Read things we need from FBB Config file
   if(! open( FBBCONF, '<', $FBBCONF) ) {
      printf STDERR "Unable to open '%s'\n", ${FBBCONF};
      exit 1;
   }

   while($line = <FBBCONF>) {

      chomp($line);

      if( $line =~ /^\s*\#/) {
         next;

      }elsif( $line =~ /^\s*$/) {
         next;

      }else{
         $line =~ /^\s*(\S*)\s*\=\s*(.*)$/;
         $item = $1;
         $value = $2;

         if( $item =~ /^call/ ){
            $value =~ /^(\w*)\.(.*)$/;
            $BBSCALL = $1;
            $BBSHR = $2;
            $WHOAMI = $BBSCALL;

         }elsif( $item =~ /^data/ ){
            $value =~ /^(\S*)$/;
            $DATA = $1;
            $DIRMES="${DATA}/dirmes.sys";

         }elsif( $item =~ /^conf/ ){
            $value =~ /^(\S*)$/;
            $CONF = $1;

         }elsif( $item =~ /^name/ ){
            $value =~ /^(\S*)$/;
            $NAME = $1;

         }elsif( $item =~ /^syso/ ){
            $value =~ /^(\S*)$/;
            $SYSCALL = $1;

         }elsif( $item =~ /^impo/ ){
            $value =~ /^([^\.]\S*)\.(\S*)$/;
            $MAIL = "$1.$2";
            $LOCK = "$1.lck";
         }
      }
   }

   close(FBBCONF);

}

sub ReadMY_CFG
{

   if( ! open( MYCFG, '<', ${MYCFG} ) ) {
      if( ! -f "${CONF}/m_filter.warn" ){
         if( open(LOCK, '>', ${LOCK} ) ) {
            printf LOCK "$$";

            if( open(MAIL, '>>', ${MAIL} ) ){
               printf MAIL "SP %s < %s\n", ${SYSCALL}, ${WHOAMI};
               printf MAIL "WARNING: M_Filter Config Error\n\n";
               printf MAIL "The Config File %s required by m_filter is missing or unreadable.\n", ${MYCFG};
               printf MAIL "Please correct the problem, as Message Filtering will not work without it.\n";
               printf MAIL "/EX\n";
               close(MAIL);
            }
            close(LOCK);
            unlink(${LOCK});
         }

         if( open(WRN, '>', "${CONF}/m_filter.warn" ) ){
            print WRN "m_filter is not correctly configured !";
            close WRN;
         }

      }

      exit 0;
   }

   if( -f "${CONF}/m_filter.warn" ){
      unlink( "${CONF}/m_filter.warn" );
   }

   $Subj=0;
   $Rlin=0;
   $ToFl=0;
   $FmFl=0;
   $Hold=0;
   $Kill=0;
   $Mid=0;

   while(<MYCFG>) {
      chomp;

      # Comments
      if( /^\s*\;/ ) {
         next;

      }elsif( /^\s*\#\S*/ ){
         next;

      # Blank Lines
      }elsif( /^\s*$/ ) {
         next;

      # Generate Filter message for Held Messages ?
      }elsif( /^\s*\!\s*MAIL\s*\=\s*(\S*)/ ){
         $HMAIL = &IsEnabled($1);
         next;

      # Generate Filter message for Killed Messages ?
      }elsif( /^\s*\!\s*KMAIL\s*\=\s*(\S*)/ ){
         $KMAIL = &IsEnabled($1);
         next;

      # 7PLUS Capture ?
      }elsif( /^\s*\!\s*AUTO7PLUS\s*\=\s*(\S*)/ ){
         $AUTO7PLUS = &IsEnabled($1);
         next;

      # CHECK PRIVATE Messages ?
      }elsif( /^\s*\!\s*CHECKPRIVATE\s*\=\s*(\S*)/ ){
         $CHECKPRIVATE = &IsEnabled($1);
         next;

      # FBB m_filter.fwd (for 7plus AutoCapture)
      }elsif( /^\s*\!\s*7PLUS\s*\=\s*(\S*)/ ){
         $CAPT="$1";

      # FILTER Messages From:
      }elsif( /^\s*\!\s*WHOAMI\s*\=\s*(\S*)/ ){
         $WHOAMI = $1;

      # Logging ?
      }elsif( /^\s*\!\s*LOG\s*\=\s*(\S*)/ ){
         $LOG = &IsEnabled($1);
         next;

      # Kill Words / Phrases
      }elsif( /^\s*\!\sKILL/i ) {
         $Subj=0;
         $Rlin=0;
         $ToFl=0;
         $FmFl=0;
         $Hold=0;
         $Kill=1;
         $Mid=0;

      # Hold Words / Phrases
      }elsif( /^\s*\!\sHOLD/i ) {
         $Subj=0;
         $Rlin=0;
         $ToFl=0;
         $FmFl=0;
         $Hold=1;
         $Kill=0;
         $Mid=0;

      # R:Line Words / Phrases
      }elsif( /^\s*\!\sRLINE/i ) {
         $Subj=0;
         $Rlin=1;
         $ToFl=0;
         $FmFl=0;
         $Hold=0;
         $Kill=0;
         $Mid=0;

      # To Calls to Check
      }elsif( /^\s*\!\sTO/i ) {
         $Subj=0;
         $Rlin=0;
         $ToFl=1;
         $FmFl=0;
         $Hold=0;
         $Kill=0;
         $Mid=0;

      # From Calls to Check
      }elsif( /^\s*\!\sFROM/i ) {
         $Subj=0;
         $Rlin=0;
         $ToFl=0;
         $FmFl=1;
         $Hold=0;
         $Kill=0;
         $Mid=0;

      # Additional Subject Words
      }elsif( /^\s*\!\sSUBJECT/i ) {
         $Subj=1;
         $Rlin=0;
         $ToFl=0;
         $FmFl=0;
         $Hold=0;
         $Kill=0;
         $Mid=0;

      # Message ID's
      }elsif( /^\s*\!\sMID/i ) {
         $Subj=0;
         $Rlin=0;
         $ToFl=0;
         $FmFl=0;
         $Hold=0;
         $Kill=0;
         $Mid=1;

      # Ignore unknown config lines.
      }elsif( /^\s*\!\S*/i ) {
         next;

      }else{
         # Format Word / Phrase for PERL Regular Expression Handling.

         # Add '\' escapes to some special characters
         s/([\#\!\@\:\[\]\\\/\.\*\?])/\\$1/g;

         # Change any ' ' to '\s{1}' (match exactly 1 space)
         s/\ /\\s{1}/g;

         # Insert Temporary Leading Space (so that some of the remaining
         # checks work at the begining of the line)
         $_ = " " . $_;

         # Change '+', but not '%+' to '\b' (word boundary)
         s/([^%])\+/$1\\b/gx;

         # Change '%+' to '\+'
         s/%\+/\\+/g;

         # Change '_', but not '%_' to '\s+' (one or more spaces)
         s/([^%])_/$1\\s+/gx;

         # Change '%_' to '_'
         s/%_/_/g;

         # Change '%d' to '\d'	(decimal number)
         s/%d/\\d/gi;

         # Change '%s' to '\S'	(non-space char)
         s/%s/\\S/gi;

         # Remove Leading Space
         s/^\ //;

         if($Subj){
            push( @Subj, $_ );

         }elsif($Rlin){
            push( @Rlin, $_ );

         }elsif($ToFl){
            push( @ToFl, $_ );

         }elsif($FmFl){
            push( @FmFl, $_ );

         }elsif($Hold){
            push( @Hold, $_ );

         }elsif($Kill){
            push( @Kill, $_ );

         }elsif($Mid){
            push( @Mid, $_ );
         }
      }
   }

   close(MYCFG);
}
