#! /usr/bin/perl -w

=head1 NAME

snort2ts - Convert Snort Rules to TrafficScript

=head1 DESCRIPTION

snort2ts parses Snort (www.snort.org) rule signatures and converts compatible 
rules into Zeus ZXTM TrafficScript.

This program has been designed to be used in conjunction with the snort rules
that are freely downloadable from www.snort.org/vrt. Currently ZXTM can only
inspect http packets so only the rules for web traffic  will be worth 
converting. Rule files are passed in on the command line and outputed to either
a file or directly to a ZXTM server using SOAP.

=head1 EXAMPLES

   $ ./snort2ts.pl ./rules/web-misc.rules
Read in a single rule file. The system will ask where the traffic script will 
be saved.

   $ ./snort2ts.pl -p 8080 -h 10.100.1.0/16 -f out ./rules/*.rules
Read in files from directory rules and output to out-response and out-request.
-p sets the the http port and -h sets the local network (many rules will ignore
data coming from the local network).

   $ ./snort2ts.pl -s https://admin:adminpw@zxtmip:9090 -pz ./rules/*.rules
Read in from rules directory and upload the created rules to the specified ZXTM
server. Rules will be created using the default rule name ('Snort'), and 2 rules
are usually created 'Snort - Request' and 'Snort - Response'.

=head1 AUTHOR

Matthew Horney (mhorney@zeus.com)

=head1 COPYRIGHT

snort2ts copyright (c) 2007 Zeus Technology Ltd.  All rights reserved.

Snort (an intrusion detection tool) was written by Marty Roesch and is
available from http://www.snort.org/, under the GPL.

=head1 DISCLAIMER

This information is furnished on an 'as is' basis.  Zeus Technology
makes no warranties of any kind, either expressed or implied as to any
matter including, but not limited to, warranty of fitness for a
particular purpose, exclusivity or results obtained from use of the
material. Zeus Technology does not make any warranty of any kind with
respect to freedom from patent, trademark, or copyright
infringement. For the avoidance of doubt this software is not covered
by any Zeus Technology Support and/or maintenance agreement.

=cut

use strict;
use warnings;

# Function for getting valid input from STDIN
sub query {
   my( $queryString, @options ) = @_;
   print $queryString;
   chop( my $answer = <STDIN> );
   
   if( @options ) {
      @options = map( substr($_, 0, 1) . 
         join( "?", split( //, substr($_, 1) ) ) . 
         "?", @options );  
      
         while(1) {
         foreach my $option ( @options ) {
            if( $answer =~ /^$option$/i ) {
               $option =~ s/\?//g;
               return $option;
            }
         }
         print "\n'$answer' was not a valid option.\n";
         print $queryString;
         chop( $answer = <STDIN> );
      }
   } else {
      while( $answer =~ /^\s*$/ ) {
         print "\n'$answer' was not a valid option.\n";
         print $queryString;
         chop( $answer = <STDIN> );
      }

      return $answer;
   }
}

# Define serializer
BEGIN {
   package ZeusDeserializer;
   @ZeusDeserializer::ISA = 'SOAP::Deserializer';
   sub typecast {
      my( $self, $val, $name, $attrs, $kids, $type ) = @_;
      return $val if $type && $type =~ /Protocol|Rule/;
      return undef;
   }
}

# Variables we get out of the command line
my $zxtmServer = "";
my $tsFileName = "Snort";
my $outputFile = "";
my $enableLogging = 1;
my $enableBlocking = 1;
my $enableOverwrite = -1; # 0 - Allways no 1 - Allways Yes -1 - Ask
my $enablePortsFromZxtm = 0;
my $actionCode = "";
my @ruleFiles;
my @httpPorts = ();
my $homeNet = "";
my @ignoreSid = ();

# Parse the command line arguments
my $lastFlag = "";
my $help = 0;
print "\n";
foreach ( @ARGV ) {
   if( grep( /\-\-?help/, @ARGV ) ) { @ruleFiles = (); $help = 1; last; }
   elsif( $lastFlag =~ /^s$/ ) { $zxtmServer = $_; }
   elsif( $lastFlag =~ /^r$/ ) { $tsFileName = $_; }
   elsif( $lastFlag =~ /^a$/ ) { $actionCode .= $_; }
   elsif( $lastFlag =~ /^f$/ ) { $outputFile .= $_; }
   elsif( $lastFlag =~ /^p$/ ) { push ( @httpPorts,  $_ ); }
   elsif( $lastFlag =~ /^h$/ ) { $homeNet = $_; }
   elsif( $lastFlag =~ /^i$/ ) { 
      foreach my $sid ( split ",", $_ ) {
         push( @ignoreSid, $sid );
      }
   }
   elsif( $lastFlag =~ /^d$/i ) {
      opendir( DIR, $_ ) or die( "Cannot open directory $_\n" );

      my $all = 0;
      print "Reading directory $_...\n";
      while (defined(my $file = readdir(DIR))) {
         $file = $_ . $file;
         next unless( -e $file && -f $file && -r $file && !($file =~ /[\/\\]\..*$/) );
         unless( $all ) {
            my $answer = query( "Parse file '$file'? [y/n/all/q]:", 
               "yes","no","all","quit" );
          
            $all = 1 if( $answer =~ /all/ );
            exit if( $answer =~ /quit/ );
            next unless( $answer =~ /yes/ || $all );
         }

         push( @ruleFiles, $file );
      } 
   }
   elsif( /^-l$/ ) { $enableLogging = 1; }
   elsif( /^-L$/ ) { $enableLogging = 0; }
   elsif( /^-b$/ ) { $enableBlocking = 1; }
   elsif( /^-B$/ ) { $enableBlocking = 0; }
   elsif( /^-o$/ ) { $enableOverwrite = 1; }
   elsif( /^-O$/ ) { $enableOverwrite = 0; }
   elsif( /^-pz$/ ) { $enablePortsFromZxtm = 1; }
   
   else {
      die("Cannot pass in tar files. Any rules must be extracted first.\n")
         if( /tar\.gz$|tar$/ );
      
      push( @ruleFiles, $_ ) if( -e $_ && -f $_ && -T $_ ) ;
   } 
   
   $lastFlag = "";
   $lastFlag = $1 if( /^-(\w)+/ );
}

if( !@ruleFiles && !$help ) {
   print "No input snort rule files specified.\n\n"
}

# Help string
if( !@ruleFiles || $help ) {
   print 
"Usage: snort2ts.pl [args..] rulefiles...
Converts the snort rules in rulefiles into ZXTM TrafficScript.
The rulefiles parameter should be text files containing snort
rules. 
NOTE: Currently the program processes HTTP rules only.

Available Arguments:
-d <dir>    Read entire directory to search for snort rules.
-f <prefix> Sets an output file prefix. 2 files will be 
            outputed: PREFIX-response and PREFIX-prequest.

-s <addr>   The ZXTM server to upload to via SOAP. 
            Format: protocol://user:pw\@addr:port
            E.g: https://admin:mypw\@myzxtm:9090 
-r <prefix> The prefix of the TrafficScript rule to be uploaded.
            There will be 2 rules generated: PREFIX - Response
            and PREFIX - request. Only works if you use -s.
            Default prefix: Snort.
-o/O        Always/Never overwrite existing rules on the ZXTM
            Server. Only works if you use -s. Default: the
            program queries.

-p <port>   Sets the http ports the system will use.
            Default: 80.
-pz         Retrieve the http port(s) from the specified ZXTM
            server (-s must be set for this to work).
-h <ipm>    Sets the local network, which should be the 
            range of your internal network. Many snort 
            rules only match against attacks NOT coming from
            your local network. Can be single ip or a range 
            e.g. 192.168.0.1/24. 

-i <sid>    Ignore's the rules with the specified sids. To
            specifiy more than one sid write them in a comma 
            separated list with no spaces, e.g. -i 123,56,1,32
-l/L        Enable/Disable logging all non-DOS intrusion.
            Default: On.
-b/B        Enable/Disable blocking all attacks.
            Default: On.
-a <ts>     Runs specified TrafficScript when an attack is 
            detected.

";
   exit;
}


# Ask the user for an output destination if they havent set one
unless( $outputFile || $zxtmServer || $help ) {
   print( "No destination for rules specified...\n" );
   
   my $answer = query( "Output to files (2 files will be generated, one for\n".
      "request rules and one for response)? [y/n/q]: ", "yes", "no", "quit" );
   exit if( $answer =~ /quit/ );
   if( $answer =~ /yes/ ) {
      $outputFile = query( "Enter prefix for the files: " );   
      print( "Traffic script will be saved in $outputFile-response & " .
         " $outputFile-request\n\n" );
   }

   $answer = query( "Upload to ZXTM server? [y/n/q]: ", "yes", "no", "quit" );
   exit if( $answer =~ /q/i );
   if( $answer =~ /ye?s?/i ) {
      $zxtmServer = query( "Enter server address\n".
         "   Format: prot://user:pw\@addr:port\n".
         "   E.g: https://admin:mypass\@zxtmserv:9090\n: " );

      $tsFileName = query( "Enter rule name prefix: " ); 
      
      $answer = query( "Get http ports from ZXTM? [y/n]: ", "yes", "no");
      $enablePortsFromZxtm = 1 if( $answer =~ /yes/ );
   }
   die( "\nNo output destination set.\n" ) unless( $outputFile || $zxtmServer );
   print( "\n" );

}

# Ask for a local network if one isn't set
unless( $homeNet ) {
   $homeNet = query( "No local network mask set, please enter one.\n" .
      "The local network is the range of ip addresses on your internal\n" .
      "network, and attacks from this range are usually ignored by snort\n" .
      "rules.\n".
      "e.g. 10.100.1.0/16\n: " );
      print "\n";
}


# Get http ports from the ZXTM server
my $safeServer = $zxtmServer; # Now without printing your password on screen
$safeServer =~ /\@(.*)/; $safeServer = $1;

if( $enablePortsFromZxtm && $zxtmServer ) { 
   print "Retriving http ports from $safeServer.\n\n";
   my $conn = SOAP::Lite
      -> ns( 'http://soap.zeus.com/zxtm/1.0/VirtualServer/' )
      -> proxy( "$zxtmServer/soap" )
      -> deserializer( ZeusDeserializer->new )
      -> on_fault( sub {
         my( $soap, $res ) = @_; 
         print "Error occured:\n";
         print " Fault: " . $res->faultstring . "\n" if ref $res;
         print " Status: " . $soap->transport->status . "\n";
         exit;
      } )
      ->readable(1);

   # Retrieve the virtual servers on the ZXTM server.
   my $result = $conn->getVirtualServerNames();
   my @virtualServers = @{$result->result};

   $result = $conn->getBasicInfo( \@virtualServers );
   my @basicInfo = @{ $result->result };

   # Loop through servers if they're http add their ports to the list
   my $all = 0;
   for(my $i = 0; $i < @basicInfo; $i++) {
      next unless( $basicInfo[$i]->{protocol} =~ /^http$/ );
      push( @httpPorts, $basicInfo[$i]->{port} );
   }
}

# If no port specified use default
@httpPorts = ( 80 ) unless( @httpPorts );

print "Parsing Rules...\n";
my $rulesParsed = 0;
my $rulesTotal = 0;

# Regexes for header stuff all in one place
my $var = "\\\$[\\w_]+";
my $actions = "alert|log";
my $prot = "tcp|ip";    # Supported protocols
my $ip = "!?\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}|any|\\\$HOME_NET|\\\$EXTERNAL_NET|\\\$HTTP_SERVERS";
my $port = "\\d*\:\\d*|\\d+|any|$var";

# Used by the reference option to link to an explanation of the exploit
# being detected.
my %ref = ( "bugtraq" => "http://www.securityfocus.com/bid/",
            "cve" => "http://cve.mitre.org/cgi-bin/cvename.cgi?name=",
            "nessus" => "http://cgi.nessus.org/plugins/dump.php3?id=",
            "arachnids" => "http://www.whitehats.com/info/IDS",
            "mcafee" => "http://vil.nai.com/vil/dispVirus.asp?virus_k=",
            "url" => "http://" ); 

# Stores the hierarchical data structure that stores the processed rules. 
my %sources = (); 

my $resExternOnly = 1;
my $reqExternOnly = 1;

# Process each file passed in on the command line
foreach my $file ( @ruleFiles ) {
   open( RULEFILE, $file );
   print( "Reading snort rule file $file.\n" );
   my @aborts = ();
   my $fileRuleCount = 0;

   my $notRuleFile = 1;
   while( <RULEFILE> ) {
      if( /($actions)\s+($prot)\s+($ip)\s+($port)\s+(\-\>|\<\-?\>)/ ) {
         $notRuleFile = 0;
      }
   }
   seek( RULEFILE, 0, 0 );

   if( $notRuleFile ) {
      print( " File contained no parsable rules.\n" );
      next;
   }

   while( <RULEFILE> ) {
      next if( /^\#/ );
      if( /([^\(]+)\((.*)\)/ ) {    # Split into header and option sections 
         my $header = $1;
         my $options = $2;
         $rulesTotal++;
         $fileRuleCount++;

         unless( $header =~ /^\s*($actions)\s+($prot)\s+($ip)\s+($port)\s+(\-\>|\<\-?\>)\s+($ip)\s+($port)/ ) {
            push( @aborts, "Unsupported Header ($header)\n" );
            next;
         }

         my $source = $3;
         my $sourcePort = $4;
         my $direction = $5;   
         my $dest = $6;
         my $destPort = $7;


         # $ts is the buffer for TrafficScript code. Initalialy we put the 
         # origonal sonrt rule as a comment in it.
         my $ts = "\n\t# ";
         my $cPos = 0;
         foreach my $section ( split( /\s/, $_ ) ) {
            if( $cPos + length( $section ) > 50) {
               $cPos = 0;
               $ts .= "\n\t# "
            }
            $ts .= $section . " ";
            $cPos += length( $section );
         }
         $ts .= "\n";

         my @contents = ({}); 
         my $i = 0; # Current content being altered.
         my $first = 1;
         my %logging = ();
         my $abort = 0;
         my $tab = "\t";
      
         # Read through the options, parse and  store them
         $options =~ s/\\;/#SEMI_COLON#/g;
         foreach my $opt ( split /\s*;\s*/, $options ) {
            $opt =~ s/#SEMI_COLON#/\\;/g;
            my ( $optId, @optPar ) = split /\,|\:/, $opt;
            $optId = lc $optId;
            
            $_ = $optId;
            # Meta-Data Rule Options
            if( /^msg/ ) {
               $logging{"msg"} = substr( $optPar[0], 1, -1 ); 
            } elsif( /^reference/ ) {
               $logging{"ref"} = $optPar[0]; 
               $logging{"ref_i"} = $optPar[1] if $optPar[1]; 
            } elsif( /^sid/ ) {
               if( grep( /^$optPar[0]$/, @ignoreSid ) ) {
                  $abort = "Ignored SID"; last;
               }
               $logging{"sid"} = $optPar[0]; 
            } elsif( /^rev/ ) {
               $logging{"rev"} = $optPar[0]; 
            } elsif( /^classtype/ ) {
               $logging{"class"} = $optPar[0];
            } elsif( /^priority/ ) {
               $logging{"priority"} = $optPar[0];
            } elsif( /^metadata/ ) {
               $abort = "Shared Libraries not allowed" 
                  if( scalar grep(/shared/, @optPar) );
                  
               $dest = "\$HTTP_SERVERS"
                  if( scalar grep(/service http/, @optPar) );

            # Payload Detection Options - Content related stuff
            } elsif( /^content/ || /^uricontent/ ) {
               my $temp = "";
               my $hex = 0; my $not = 0;
               my $text = $optPar[0];
               if( $text =~ /^\s*\!/ ) {
                  $text = substr( $text, 2, -1 );
                  $not = 1;
               } else {
                  $text = substr( $text, 1, -1 );
               }
               
               # Processing hex and normal sections.
               foreach my $part ( split( /\|/, "a" . $text . "a" ) ) {
                  if( $hex ) {
                     map( $temp .= "\\x$_" , split( /\s+/, $part ) ); 
                  } else {
                     $temp .= quotemeta $part;
                  }
                  $hex = not $hex;
               }            
               $temp = substr( $temp, 1, -1 );
               $temp =~ s/\\/\\\\/g;      
               if( $first ) {
                  $i--;
                  $first = 0;
               }
               $contents[++$i] = { "content" => $temp };
               $contents[$i]{"http_uri"} = 1 if( /^uricontent/ );
               $contents[$i]{"content_not"} = 1 if( $not );
               

            } elsif( /^nocase/ ) {
               $contents[$i]{"nocase"} = 1;
            } elsif( /^rawbytes/ ) {
               $abort = $optId; last; # Traffic Script unable to view raw data 
            } elsif( /^depth/ ) {
               $contents[$i]{"depth"} = $optPar[0];
            } elsif( /^offset/ ) {
               $contents[$i]{"offset"} = $optPar[0];
            } elsif( /^distance/ ) {
               $contents[$i]{"distance"} = $optPar[0];
            } elsif( /^within/ ) {
               $contents[$i]{"within"} = $optPar[0];
            } elsif( /^http_client_body/ ) {
               $contents[$i]{"http_body"} = 1;
            } elsif( /^http_uri/ ) {
               $contents[$i]{"http_uri"} = 1;
            } elsif( /^isdataat/ ) {
               $contents[$i]{"isdataat_val"} = $optPar[0];
               $contents[$i]{"isdataat_rel"} = 1 
                  if( grep(/\s*relative\s*/, @optPar) ); 

               # Traffic script unable to do raw data
               if( grep( /\s*rawbytes\s*/, @optPar ) ) { 
                  $abort = $optId; last; 
               }               
            } elsif( /^pcre/ ) { # PERL regex content
               my $regex = substr( $optPar[0], 1, -1 );
               $regex = $2 if( $regex =~ /^m?(.)(.*)/ );    
               my $del = quotemeta $1;
               $regex = $1 if($regex =~ /(.*)$del([ismxAEGRUB]*)$/); 
               my $params = $2;

               # Altering post params (Snort adds some non perl ones)
               if( $params =~ /[EGB]/ ) { 
                  $abort = "pcre (Unsupported regex option)"; 
                  last; 
               }
               $regex = "^$regex" if($params =~ /A/);
               $regex = "(?i)$regex" if($params =~ /i/);
               $regex = "(?s)$regex" if($params =~ /s/);
               $regex = "(?m)$regex" if($params =~ /m/);
               $regex = "(?x)$regex" if($params =~ /x/);
               
               $regex =~ s/\\/\\\\/g;
               $regex =~ s/([^\\])\"/$1\\\\\\\"/g;

               
               if( $first ) {
                  $i--;
                  $first = 0;
               }  
               $contents[++$i] = { "content" => $regex };
               $contents[$i]{"distance"} = 0 if($params =~ /R/);
               $contents[$i]{"http_uri"} = 1 if($params =~ /U/);

            } elsif( /^byte_test/ ) {
               $abort = $optId; last;  # Traffic Script unable to view raw data 
            } elsif( /^byte_jump/ ) {
               $abort = $optId; last;  # Traffic Script unable to view raw data 
            } elsif( /^ftpbounce/ ) {
               $abort = $optId; last;    # We're not doing ftp.
                     
            # Non Payload detection options
            } elsif( /^sameip/ ) {
               $abort = $optId; last;       # Traffic Script unable to do this? 
            } elsif( /^ip_proto/ ) {
               # Http only
               unless($optPar[0] =~ /\s*http\s*/) { 
                  $abort = $optId; last;
               }
            } elsif( /^flow/ ) {
               if( grep(/\s*(stateless|no_stream|stream)\s*/, @optPar) ) { 
                  $abort = $optId; last; 
               } 
               $dest = "\$HTTP_SERVERS" if( grep( /to_server/ , @optPar ) 
                  && $dest =~ /\$HOME_NET/ );
               $source = "\$HTTP_SERVERS" if( grep( /from_server/ , @optPar ) 
                  && $source =~ /\$HOME_NET/ );
               
               $abort = "Only HTTP Servers" if( grep( /to_client/ , @optPar ) 
                  && $dest =~ /\$HTTP_SERVERS/ );
               $abort = "Only HTTP Servers" if( grep( /from_client/ , @optPar)
                  && $source =~ /\$HTTP_SERVERS/ );   

               my $destTemp = quotemeta( $dest );
               if( $source =~ /$destTemp/ ) {
                  $abort = $optId; last;
               }

            # Post detection rule options
            } elsif( /^logto/ ) {
               # Doesn't effect much so ok to ignore   
            
            # Abort if we come across somthing we don't recognise
            } else { 
               $abort = $optId; last;    
            }
         }

         # Home net might mean http server?
         $dest =~ s/\$HOME_NET/\$HTTP_SERVERS/;
         
         # Currently only HTTP servers. Here we're checking that the rule is
         # for a http server address and port.
         $abort = "Only HTTP servers" 
            unless( $dest =~ /\$EXTERNAL_NET|\$HTTP_SERVERS|any/ );
         $abort = "Only HTTP servers"
            unless( $source =~ /\$HTTP_SERVERS/ || $dest =~ /\$HTTP_SERVERS/ );
         
         if( $dest =~ /\$HTTP_SERVERS/ && 
            $destPort =~ /\s*(\d*)\:(\d*)\s*/ ) {

            my @portMatches = grep( (!$1 || $_ >= $1 ) && (!$2 || $_ <= $2), 
               @httpPorts );
            $abort = "Only HTTP servers" unless( @portMatches ); 
            $destPort = "any" if( scalar @portMatches == scalar @httpPorts ); 
         } elsif( $destPort =~ /^\d+$/ && $dest =~ /\$HTTP_SERVERS/ ) {
            $abort = "Only HTTP servers"
               unless( grep( $_ == $destPort, @httpPorts ) );

            $destPort = "any" if( scalar @httpPorts == 1 );
         }
         
         if( $source =~ /\$HTTP_SERVERS/ &&
            $sourcePort =~ /\s*(\d+)?\:(\d+)?\s*/ ) {

            my @portMatches = grep( (!$1 || $_ >= $1 ) && (!$2 || $_ <= $2), 
               @httpPorts );
            $abort = "Only HTTP servers" unless( @portMatches ); 
            $sourcePort = "any" if( scalar @portMatches == scalar @httpPorts );
         } elsif( $sourcePort =~ /^\d+$/ && $source =~ /\$HTTP_SERVERS/ ) {
            $abort = "Only HTTP servers" 
               unless( grep( $_ == $sourcePort, @httpPorts ) );

            $sourcePort = "any" if( scalar @httpPorts == 1 );
         }
         
         # If ports are http we can effectivly set them to 'any'
         $sourcePort = "any" if( $sourcePort =~ /\$HTTP_PORTS/ );
         $destPort = "any" if( $destPort =~ /\$HTTP_PORTS/ );

         # Store error messages, maybee we'll put them somewhere.
         if( $abort ) {
            push ( @aborts, "Snort rule ignored: $abort\n" ); 
            #print "$abort:\n    $header ($options)\n";

            next;
         }
         
         # We only have EXTERNAL -> HTTP_SERVERS and visa versa we can
         # do a single check at the start and not have any other if statements.
         $resExternOnly = 0 if( 
            ( $source =~ /\$HTTP_SERVERS/ && !($dest =~ /\$EXTERNAL_NET/) ) );

         $reqExternOnly = 0 if( 
            ( $dest =~ /\$HTTP_SERVERS/ && !($source =~ /\$EXTERNAL_NET/) ) );
  
         # Building all the content searches in traffic script.
         my $lm = 0;

         foreach my $content ( @contents ) {
         
            my $temp = $$content{"content"};
            next unless( $temp );

            my $nocase = "";
            if( $$content{"nocase"} ) { $nocase = ", \"i\""; }
            
            # Depth / Offset / Distance / Within options. Gets complicated when
            # these rules interact.   
            #
            # Essentially each content search is a regex that returns the 
            # matched result plus all the data in front of it. It then uses this
            # to determine how far in the last match was for content searches 
            # which start from the end of the previous match.
            if( $$content{"depth"} || $$content{"offset"} || 
               $$content{"distance"} || $$content{"within"} ) {
               my $depth = 0; $depth = $$content{"depth"} 
                  if( defined $$content{"depth"} );
               my $offset = 0; $offset = $$content{"offset"} 
                  if( defined $$content{"offset"} );
               my $distance = 0; $distance = $$content{"distance"} 
                  if( defined $$content{"distance"} );
               my $within = 0; $within = $$content{"within"} 
                  if( defined $$content{"within"} );
                  
               if(defined $$content{"distance"} || 
                  defined $$content{"within"}) {
                  
                  # Set last match ( variable that stores end position of the
                  # last match ).
                  if( $lm ) { $ts .= $tab. "\$LAST_MATCH = string.len(\$1);\n";}
                  else      { $ts .= $tab. "\$LAST_MATCH = 0;\n"; }         
         
                  # If distance & offset are set we need to find out which is
                  # larger offset or distance + LAST_MATCH.
                  if( $$content{"offset"} ) {
                     $ts .= $tab . "\$OFFSET = ".
                        "lang.max($offset, \$LAST_MATCH + $distance);\n";
                  } else {
                     $ts .= $tab . "\$OFFSET = \$LAST_MATCH + $distance;\n";
                  }

                  # If depth and the relative search parameters are set we need
                  # to find out which gives us the smallest search area in the
                  # content string.
                  if( $$content{"depth"} ) {
                     $ts .= $tab . "\$DEPTH = ".
                        "lang.max(lang.min( " . ($offset + $depth) . 
                        ", \$LAST_MATCH + " . ($distance + $within) . 
                        "), \$OFFSET);\n";
                  } else {
                     $ts .= $tab . "\$DEPTH = lang.max( \$LAST_MATCH + " . 
                     ($distance + $within) . ", \$OFFSET);\n";
                  }

                  $temp = "^.{\" .\$OFFSET. \",\" .\$DEPTH. \"}" . $temp;
               } else {
                  $temp = "^.{$offset, " . ($offset + $depth) . "}" . $temp;

               }

            } else {
               $temp = "^.*" . $temp;
            }

            # Bracket it up so we can use it to tell the position of the last
            # match using the string length of $1.
            $temp = "(" . $temp . ")";
            
            my $d = "\$CONTENT";         
            $d = "\$HTTP_URI" if( $$content{"http_uri"} );
            $d = "\$HTTP_BODY" if( $$content{"http_body"} );
            
            my $not = "";
            $not =  "!" if($$content{"content_not"});
            $ts .= $tab . "if($not ".
               "string.regexmatch($d, \"$temp\"$nocase ) ) {\n\n"; 
            $tab .= "   ";
            $lm = 1;

         }
         
         # Actions to take if we have a match.
         
         # Logging code, stores all the snort info.
         if( $enableLogging && 
            (!$logging{"class"} || !($logging{"class"} =~ /dos/)) ) { 
            $ts .= $tab . "log.warn(\"SNORT RULE ";
            $ts .= "Sid:" . $logging{"sid"} . " " if($logging{"sid"});
            $ts .= " Src: \" . \$SOURCE_IP . \n" .
               "$tab   \" Url: \" . \$HTTP_URI);\n";            
         }

         # Blocking
         if( $enableBlocking && 
            (!$logging{"class"} || $logging{"class"} =~ /attack|dos/) ) {
            $ts .= $tab . "connection.discard();\n";
         }

         # Additional user action(s)         
         if( $actionCode ) {
            $actionCode =~ s/\n/\n$tab/;
            $ts .= $tab . $actionCode . "\n";
         }

         $ts .= $tab . "break;\n";

         # Put on the ending curly braces
         while( length $tab > 1 ) {
            $tab = substr($tab, 0, -3);
            $ts .= $tab . "}\n";
         }
         
         $sources{$source} = {}
            unless( $sources{$source} );
         $sources{$source}{$sourcePort} = {} 
            unless( $sources{$source}{$sourcePort} );
         $sources{$source}{$sourcePort}{$dest} = {} 
            unless( $sources{$source}{$sourcePort}{$dest} );
         $sources{$source}{$sourcePort}{$dest}{$destPort} = [] 
            unless( $sources{$source}{$sourcePort}{$dest}{$destPort} );         
         
         # Put traffic script in the nested hash table. Putting dos attacks
         # where the system blocks first.
         if( $logging{"class"} && $logging{"class"} =~ /attack|dos/ ) {
            unshift( @{$sources{$source}{$sourcePort}{$dest}{$destPort}},$ts );
         } else {
            push( @{$sources{$source}{$sourcePort}{$dest}{$destPort}}, $ts ); 
         }
           
         $rulesParsed++;
         
         # Snort rules can specify a check for both directions (ie source to 
         # destination and destination to source)
         if( $direction =~ /\<\-?\>/ ) {
            my $tmp;
            $tmp = $source; $source = $dest; $dest = $tmp;
            $tmp = $sourcePort; $sourcePort = $destPort; $destPort = $tmp;
            
            $sources{$source} = {}
               unless( $sources{$source} );
            $sources{$source}{$sourcePort} = {} 
               unless( $sources{$source}{$sourcePort} );
            $sources{$source}{$sourcePort}{$dest} = {} 
               unless( $sources{$source}{$sourcePort}{$dest} );
            $sources{$source}{$sourcePort}{$dest}{$destPort} = [] 
               unless( $sources{$source}{$sourcePort}{$dest}{$destPort} );         

            if( $logging{"class"} && $logging{"class"} =~ /attack|dos/ ) {
               unshift( @{$sources{$source}{$sourcePort}{$dest}{$destPort}},
                  $ts );
            } else {
               push( @{$sources{$source}{$sourcePort}{$dest}{$destPort}}, $ts ); 
            }
         }

      }

   }

   print " Parsed " . ($fileRuleCount - scalar @aborts) . "/$fileRuleCount ".
      " rules in the file.\n";
}


# Header building code
my $headerString =  
"\$headers = http.getHeaderNames();
while( \$headers != \"\" ) {
   \$p = string.find( \$headers, \" \" );
   if( \$p >= 0 ) {
      \$header = string.substring( \$headers, 0, \$p - 1 );   
      \$headers = string.skip( \$headers, \$p + 1 );
   } else {
      \$header = \$headers;
      \$headers = \"\";
   }
   \$CONTENT = \$CONTENT . \$header . \": \" . http.getHeader(\$header) . \"\\r\\n\";  
}\n";

#$headerString = "\$CONTENT = \$CONTENT . \"Host: kronos:5678\\r\\n\";\n";

# Requirement code and variables that need to be set.
my $req = 
"# Snort Config Variables\n" .
"\$HOME_NET = \"$homeNet\";\n" .
"\$HTTP_SERVERS = request.getLocalIP();\n" .

"\$SOURCE_IP = request.getRemoteIP();\n" .
"\$SOURCE_PORT = request.getRemotePort();\n" .
"\$DEST_IP = request.getLocalIP();\n" .
"\$DEST_PORT = request.getLocalPort();\n" .
"\$HTTP_URI = http.getRawURL();\n" .
"\$HTTP_BODY = http.getBody( lang.min(request.getLength(), 1024 * 100)  );\n\n" . 
"\$CONTENT = http.getMethod() .\" \". \$HTTP_URI .\" \". http.getVersion() . \"\\r\\n\";\n" . 
$headerString . 
"\$CONTENT = \$CONTENT . \$HTTP_BODY;\n\n";

# Response code and variables that need to be set.
my $res = 
"# Snort Config Variables\n" .
"\$HOME_NET = \"$homeNet\";\n" .
"\$HTTP_SERVERS = response.getLocalIP();\n" .

"\$SOURCE_IP = response.getRemoteIP();\n" .
"\$SOURCE_PORT = response.getRemotePort();\n" .
"\$DEST_IP = response.getLocalIP();\n" .
"\$DEST_PORT = response.getLocalPort();\n" .
"\$HTTP_URI = http.getRawURL();\n" .
"\$HTTP_BODY = http.getResponseBody( lang.min(response.getLength(), 1024 * 100)  );\n\n" . 
"\$CONTENT = http.getVersion() .\" \". http.getResponseCode() .\"\\r\\n\";\n" . 
$headerString .
"\$CONTENT = \$CONTENT . \$HTTP_BODY;\n\n";

# Build up the traffic script code. For each source/destination ip/port an if 
# statement is created. Checking the ip address and ports.

my $httpPortString = "";
foreach my $httpPort ( @httpPorts ) {
   $httpPortString .= " || " if( $httpPortString );
   $httpPortString .= "#PORT# == $httpPort";
}

if( $reqExternOnly ) {
   $req .= 
      "\n# Rules only check external traffic so we can".
      "\n# break if it's from the internal (local) network.".
      "\nif( string.ipmaskmatch( \$SOURCE_IP, \$HOME_NET ) ) {\n".
      "   break;\n}\n\n";
}

if( $resExternOnly ) {
   $res .=  
      "\n# Rules only check external traffic so we can".
      "\n# break if it's going to the internal (local) network.".
      "\nif( string.ipmaskmatch( \$DEST_IP, \$HOME_NET ) ) {\n".
      "   break;\n}\n\n";
}

# Source IPs
my $tab = "";
foreach my $sAddr ( keys %sources ) {
   my $out = "";
      
   unless( $sAddr =~ /\s*(any|\$HTTP_SERVERS)\s*/ || $reqExternOnly ) {
      my $sAddrTemp = $sAddr;
      $sAddrTemp = "\"$sAddrTemp/\"" if( $sAddrTemp =~ /\d+\.\d+/ );
      my $not = "";

      # EXTERNAL_NET = !HOME_NET
      $not = " !" if( $sAddrTemp =~ /\$EXTERNAL_NET/ ); 
      $sAddrTemp = "\$HOME_NET" if( $sAddrTemp =~ /\$EXTERNAL_NET/ );

      $out .= "if($not string.ipmaskmatch( \$SOURCE_IP, $sAddrTemp ) ) {\n";
      $tab .= "   ";
   }
   
   # Source Ports
   foreach my $sPort ( keys %{$sources{$sAddr}} ) {

      unless( $sPort =~ /\s*any\s*/ ) {
         $out .= $tab . "if( ";
         if( $sPort =~ /\s*(\d+)?\:(\d+)?\s*/ ) {
            $out .= "\$SOURCE_PORT >= $1" if( $1 ); 
            $out .= " && " if( $1 && $2 );
            $out .= "\$SOURCE_PORT <= $2" if( $2 );
         } else {
            $out .= "\$SOURCE_PORT == $sPort";
         }
         $out .= " ) {\n";
         $tab .= "   ";
      }
     
      # Destination IP
      foreach my $dAddr ( keys %{$sources{$sAddr}{$sPort}} ) {
         
         
         unless( $dAddr =~ /\s*(any|\$HTTP_SERVERS)\s*/ || $resExternOnly ) {
            my $dAddrTemp = $dAddr;
            $dAddrTemp = "\"$dAddrTemp\"" if( $dAddrTemp =~ /\d+\.\d+/ );
            my $not = "";

            $not = " !" if( $dAddrTemp =~ /\$EXTERNAL_NET/ );          
            $dAddrTemp = "\$HOME_NET" if( $dAddrTemp =~ /\$EXTERNAL_NET/ );

            $out .= $tab . 
               "if($not string.ipmaskmatch( \$DEST_IP, $dAddrTemp ) ) {\n";
            $tab .= "   ";
         }

         # Destination Ports
         foreach my $dPort ( keys %{$sources{$sAddr}{$sPort}{$dAddr}}) {
           
            unless( $dPort =~ /\s*any\s*/ ) {
               if( $dPort =~ /\s*(\d+)?\:(\d+)?\s*/ ) {
                  $out .= $tab . "if( ";

                  $out .= "\$DEST_PORT >= $1" if( $1 ); 
                  $out .= " && " if( $1 && $2 );
                  $out .= "\$DEST_PORT <= $2" if( $2 );
               } else {
                  $out .= $tab . "if( ";
                  $out .= "\$DEST_PORT == $dPort";
               }
               $out .= " ) {\n";
               $tab .= "   ";
            }
                                    
            # Add the code
            my $firstIf = 1;
            foreach my $ts ( @{$sources{$sAddr}{$sPort}{$dAddr}{$dPort}} ) {
               #$ts =~ s/\tif/\telse if/ unless($firstIf); #elseifs break stuff
               $ts =~ s/\t/$tab/g;
               $out .= $ts;               
               $firstIf = 0;
            }

            #my $ts .= join "\n", @{$sources{$sAddr}{$sPort}{$dAddr}{$dPort}};
            #$ts =~ s/\t/$tab/g;
            #$out .= $ts;

            unless( $dPort =~ /\s*any\s*/ ) {
               $tab = substr($tab, 0, -3);
               $out .= $tab . "}\n";
            }
         }
         unless( $dAddr =~ /\s*(any|\$HTTP_SERVERS)\s*/ || $resExternOnly ) {
            $tab = substr($tab, 0, -3);
            $out .= $tab . "}\n";
         }
      }
      unless( $sPort =~ /\s*any\s*/ ) {
         $tab = substr($tab, 0, -3);
         $out .= $tab . "}\n";
      }
   }
   unless( $sAddr =~ /\s*(any|\$HTTP_SERVERS)\s*/ || $reqExternOnly ) {
      $tab = substr($tab, 0, -3);
      $out .= $tab . "}\n";
   }

   $res .= $out if( $sAddr =~ /\$HTTP_SERVERS/ );
   $req .= $out unless( $sAddr =~ /\$HTTP_SERVERS/ );

} 

print "Parsing Complete. (Rules Parsed: $rulesParsed/$rulesTotal)\n\n";

# If output file specified, save it
if( $outputFile ) {

   open( REQOUT, "> $outputFile-request" ) or 
      die( "Could not open file $outputFile-request" );
   print( REQOUT $req ) 
      unless( $req =~ /\$CONTENT = \$CONTENT . \$HTTP_BODY;\n\n$/ );
   
   open( RESOUT, "> $outputFile-response" ) or
      die( "Could not open file $outputFile-response" );
   print( RESOUT $res ) 
      unless( $res =~ /\$CONTENT = \$CONTENT . \$HTTP_BODY;\n\n$/ );

   print "TrafficScript saved to files '$outputFile-request' & ".
   "'$outputFile-response'\n\n";
}

# If ZXTM server sepcified do some SOAP stuff
if( $zxtmServer ) {
   use SOAP::Lite 0.60;

     # Connect to the Server
   my $admin_server = $zxtmServer;
   my $conn = SOAP::Lite
      -> ns( 'http://soap.zeus.com/zxtm/1.0/Catalog/Rule/' )
      -> proxy( "$admin_server/soap" )
      -> deserializer( ZeusDeserializer->new )
      -> on_fault( sub {
            my( $soap, $res ) = @_; 
            print "Error occured:\n";
            print " Fault: " . $res->faultstring . "\n" if ref $res;
            print " Status: " . $soap->transport->status . "\n";
            exit;
         } )
      ->readable(1);

   print "Connected to ZXTM Server '$safeServer'\n";

   # Check the syntax - I have no faith
   my $result = $conn->checkSyntax( [$req] );
   unless( ${$result->result}[0]->{valid} ) {
      print "SYNTAX ERROR\n";
      print "--Warnings--\n" . ${$result->result}[0]->{warnings} . "\n";
      print "--Errors--\n" . ${$result->result}[0]->{errors} . "\n";
      die( "Syntax Error" );
   }
   $result = $conn->checkSyntax( [$res] );
   unless( ${$result->result}[0]->{valid} ) {
      print "SYNTAX ERROR\n";
      print "--Warnings--\n" . ${$result->result}[0]->{warnings} . "\n";
      print "--Errors--\n" . ${$result->result}[0]->{errors} . "\n";
      die( "Syntax Error" );
   }


   my %rules = (  "$tsFileName - Request" =>    $req, 
                  "$tsFileName - Response" =>   $res   );

   my @uploaded = ();
 
   # Upload Rules to Catalog on the ZXTM server
   foreach my $ruleName ( keys %rules ) {
      $result = $conn->getRuleNames();
      my @existingRules = map( quotemeta, @{$result->result} );
     
      # Check for overwritting, if so quesry user (or do what was specified on 
      # the command line.
      if( grep( $ruleName =~ /^$_$/ , @existingRules ) ) {
         if( $enableOverwrite == 0 ) {
            print "Rule $ruleName allready exists and never overwrite is set,".
               "skipping rule.\n";
            next;

         } elsif( $enableOverwrite == -1) {
            my $answer = query( "Rule '$ruleName' allready exists, " .
               "overwrite it? [y/n/all]: ", "yes", "no", "quit", "all" );
            if( $answer =~ /all/ )  { $enableOverwrite = 1; } 
            else { next unless( $answer =~ /yes/ ); } 
         }

         # Upload the rule.
         $conn->setRuleText( [ $ruleName ], [ $rules{$ruleName} ] );
         push( @uploaded, $ruleName );
         print "Uploaded '$ruleName' to catalog.\n";

      } else {
         $conn->addRule( [ $ruleName ], [ $rules{$ruleName} ] );
         push( @uploaded, $ruleName );
         print "Uploaded '$ruleName' to catalog.\n";
      }
   }

   # Add the rules to the http virtual servers.
   if( @uploaded ) {
      print "\n";
      my $conn2 = SOAP::Lite
         -> ns( 'http://soap.zeus.com/zxtm/1.0/VirtualServer/' )
         -> proxy( "$admin_server/soap" )
         -> deserializer( ZeusDeserializer->new )
         -> on_fault( sub {
            my( $soap, $res ) = @_; 
            print "Error occured:\n";
            print " Fault: " . $res->faultstring . "\n" if ref $res;
            print " Status: " . $soap->transport->status . "\n";
            exit;
         } )
         ->readable(1);

      # Retrieve the virtual servers on the ZXTM server.
      $result = $conn2->getVirtualServerNames();
      my @virtualServers = @{$result->result};

      $result = $conn2->getProtocol( \@virtualServers );
      my @protocols = @{ $result->result };

      # Loop through servers if they're http ask if we want to enable the rules
      # on those servers.
      my $all = 0;
      for(my $i = 0; $i < @protocols; $i++) {
         next unless( $protocols[$i] =~ /^http$/ );

         unless( $all ) {
            my $answer =  query( "Enable rules on http server ".
               "'$virtualServers[$i]'? [y/n/all/q]: ", 
               "yes", "no", "quit", "all"); 

            $all = 1 if( $answer =~ /all/ );
            exit if( $answer =~ /quit/ );
            next unless( $answer =~ /yes/ || $all );
         }
         
         # If they say yes set the rule as the first to be run on that server.
         foreach my $uploadedRule ( @uploaded ) {
            $result = $conn2->getRules( [ $virtualServers[$i] ] )
               if( $uploadedRule =~ /Request/ );

            $result = $conn2->getResponseRules( [ $virtualServers[$i] ] )
               if( $uploadedRule =~ /Response/ );
            
            # Remove the rule if its allready enabled.
            my $urRegex = quotemeta $uploadedRule;
            my @existingRules = 
               grep( !($_->{name} =~ /^$urRegex$/), @{@{$result->result}[0]});
           
            # Put the rule at the front.
            unshift( @existingRules, 
               {  "name" => $uploadedRule,
                  "enabled" => 1 } );

            $result = $conn2->setRules( [ $virtualServers[$i] ], 
               [ \@existingRules ] )  if( $uploadedRule =~ /Request/ );

            $result = $conn2->setResponseRules( [ $virtualServers[$i] ], 
               [ \@existingRules ] )  if( $uploadedRule =~ /Response/ );

            print "Enabled '$uploadedRule' on '$virtualServers[$i]'.\n";
         }
      }

   }
}