package CGI::IDS; #------------------------- Notes ----------------------------------------------- # This source code is documented in both POD and ROBODoc format. # Please find additional POD documentation at the end of this file # (search for "__END__"). #------------------------------------------------------------------------------- #****c* IDS # NAME # PerlIDS (CGI::IDS) # DESCRIPTION # Website Intrusion Detection System based on PHPIDS http://php-ids.org rev. 1152 # AUTHOR # Hinnerk Altenburg # CREATION DATE # 2008-06-03 # COPYRIGHT # Copyright (C) 2008 Hinnerk Altenburg # # This file is part of PerlIDS. # # PerlIDS is free software: you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # PerlIDS is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public License # along with PerlIDS. If not, see . #**** =head1 NAME CGI::IDS - PerlIDS - Perl Website Intrusion Detection System (XSS, CSRF, SQLI, LFI etc.) =head1 VERSION Version 1.0103 - based on and tested against the filter tests of PHPIDS http://php-ids.org rev. 1152 =cut our $VERSION = '1.0103'; =head1 DESCRIPTION PerlIDS (CGI::IDS) is a website intrusion detection system based on PHPIDS L. It parses any hashref for possible attacks, so it does not depend on CGI.pm. The intrusion detection is based on a set of converters that convert the request according to common techniques that are used to hide attacks. These converted strings are checked for attacks by running a filter set of currently 68 regular expressions and a generic attack detector to find obfuscated attacks. For easily keeping the filter set up-to-date, PerlIDS is compatible to the original XML filter set of PHPIDS, which is frequently updated. Each matching regular expression has it’s own impact value that increases the tested string’s total attack impact. Using these total impacts, a threshold can be defined by the calling application to log the suspicious requests to database and send out warnings via e-mail or even SMS on high impacts that indicate critical attack activity. These impacts can be summed per IP address, session or user to identify attackers who are testing the website with small impact attacks over a time. =head1 SYNOPSIS use CGI; use CGI::IDS; $query = new CGI; # instantiate the IDS object; # do not scan keys, values only; don't scan PHP code injection filters (IDs 58,59,60); # All arguments are optional, 'my $ids = new CGI::IDS();' is also working correctly, # loading the entire shipped filter set and not scanning the keys. my $ids = new CGI::IDS( filters_file => '/home/hinnerk/ids/default_filter.xml', whitelist_file => '/home/hinnerk/ids/param_whitelist.xml', scan_keys => 0, disable_filters => [58,59,60], ); # start detection my $impact = $ids->detect_attacks( request => $query->Vars ); if ($impact > 10) { my_log( $ids->get_attacks() ); } if ($impact > 30) { my_warn_user(); my_email( $ids->get_attacks() ); } if ($impact > 50) { my_deactivate_user(); my_sms( $ids->get_attacks() ); } # now with scanning the hash keys $ids->set_scan_keys(scan_keys => 1); $impact = $ids->detect_attacks( request => $query->Vars ); See examples/demo.pl in CGI::IDS module package for a running demo. You might want to build your own 'session impact counter' that increases during multiple suspicious requests by one single user, session or IP address. =head1 METHODS =cut #------------------------- Pragmas --------------------------------------------- use strict; use warnings; #------------------------- Libs ------------------------------------------------ use XML::Simple qw(:strict); use HTML::Entities; use MIME::Base64; use Encode qw(decode); use Carp; use JSON::XS; use Time::HiRes; use utf8; use encoding 'utf8'; use FindBin qw($Bin); #------------------------- Settings -------------------------------------------- $XML::Simple::PREFERRED_PARSER = "XML::Parser"; #------------------------- Debugging ------------------------------------------- # debug modes (binary): use constant DEBUG_KEY_VALUES => (1 << 0); # print each key value pair use constant DEBUG_IMPACTS => (1 << 1); # print impact per key value pair use constant DEBUG_ARRAY_INFO => (1 << 2); # print attack info arrays use constant DEBUG_CONVERTERS => (1 << 3); # print output of each converter use constant DEBUG_SORT_KEYS_NUM => (1 << 4); # sort request by keys numerically use constant DEBUG_SORT_KEYS_ALPHA => (1 << 5); # sort request by keys alphabetically use constant DEBUG_WHITELIST => (1 << 6); # dumps loaded whitelist hash # use constant DEBUG_MODE => DEBUG_KEY_VALUES | # DEBUG_IMPACTS | # DEBUG_WHITELIST | # DEBUG_ARRAY_INFO | # DEBUG_CONVERTERS | # DEBUG_SORT_KEYS_NUM; # simply comment this line out to switch debugging mode on (also uncomment above declaration) use constant DEBUG_MODE => 0; #------------------------- Constants ------------------------------------------- # converter functions, processed in this order my @CONVERTERS = qw/ stripslashes _convert_from_commented _convert_from_newlines _convert_from_js_charcode _convert_js_regex_modifiers _convert_entities _convert_quotes _convert_from_sql_hex _convert_from_sql_keywords _convert_from_control_chars _convert_from_nested_base64 _convert_from_out_of_range_chars _convert_from_xml _convert_from_js_unicode _convert_from_utf7 _convert_concatenations _convert_from_proprietary_encodings _run_centrifuge /; #------------------------- Globals --------------------------------------------- # harmless string definition my $not_harmless = qr/[^\w\s\/@!?,]+/; #------------------------- Subs ------------------------------------------------ #****f* IDS/new # NAME # Constructor # DESCRIPTION # Creates an IDS object. # The filter set and whitelist will stay loaded during the lifetime of the object. # You may call detect_attacks() multiple times, the attack array ( get_attacks() ) # will be emptied at the start of each run of detect_attacks(). # INPUT # HASH # filters_file STRING The path to the filters XML file (defaults to shipped IDS.xml) # whitelist_file STRING The path to the whitelist XML file # scan_keys INT 1 to scan also the keys, 0 if not (default: 0) # disable_filters ARRAYREF[INT,INT,...] if given, these filter ids will be disabled # OUTPUT # IDS object, dies (croaks) if no filter rule could be loaded # EXAMPLE # # instantiate object; do not scan keys, values only # my $ids = new CGI::IDS( # filters_file => '/home/hinnerk/sandbox/ids/cgi-bin/default_filter.xml', # whitelist_file => '/home/hinnerk/sandbox/ids/cgi-bin/param_whitelist.xml', # scan_keys => 0, # disable_filters => [58,59,60], # ); #**** =head2 new() Constructor. Can optionally take a hash of settings. If I is not given, the shipped filter set will be loaded, I defaults to 0. The filter set and whitelist will stay loaded during the lifetime of the object. You may call C multiple times, the attack array (C) will be emptied at the start of each run of C. For example, the following is a valid constructor: my $ids = new CGI::IDS( filters_file => '/home/hinnerk/ids/default_filter.xml', whitelist_file => '/home/hinnerk/ids/param_whitelist.xml', scan_keys => 0, disable_filters => [58,59,60], ); The Constructor dies (croaks) if no filter rule could be loaded. =cut sub new { my ($package, %args) = @_; # defaults $args{scan_keys} = $args{scan_keys} ? 1 : 0; my $filters_file_default = __FILE__; $filters_file_default =~ s/IDS.pm/IDS.xml/; # self member variables my $self = { filters_file => $args{filters_file} || $filters_file_default, whitelist_file => $args{whitelist_file}, scan_keys => $args{scan_keys}, impact => 0, attacks => undef, # [] filters => [], filter_disabled => { map { $_ => 1} @{$args{disable_filters} || []} }, }; # create object bless $self, $package; # read & parse filter XML my $num_filters = $self->_load_filters_from_xml($self->{filters_file}); my $num_whitelist = $self->_load_whitelist_from_xml($self->{whitelist_file}); if (!$num_filters) { croak "No IDS filter rules loaded!"; } return $self; } #****f* IDS/detect_attacks # NAME # detect_attacks # DESCRIPTION # Parses a hashref (e.g. $query->Vars) for detection of possible attacks. # The attack array is emptied at the start of each run. # INPUT # +request hashref to be parsed # OUTPUT # Impact if filter matched, 0 otherwise # SYNOPSIS # $ids->detect_attacks(request => $query->Vars); #**** =head2 detect_attacks() DESCRIPTION Parses a hashref (e.g. $query->Vars) for detection of possible attacks. The attack array is emptied at the start of each run. INPUT +request hashref to be parsed OUTPUT Impact if filter matched, 0 otherwise SYNOPSIS $ids->detect_attacks(request => $query->Vars); =cut sub detect_attacks { my ($self, %args) = @_; return 0 unless ($args{request}); my $request = $args{request}; # reset last detection data $self->{impact} = 0; $self->{attacks} = []; $self->{filtered_keys} = []; $self->{non_filtered_keys} = []; my @request_keys = keys %$request; # sorting for filter debugging only if (DEBUG_MODE & DEBUG_SORT_KEYS_ALPHA) { @request_keys = sort {$a cmp $b} @request_keys; } elsif (DEBUG_MODE & DEBUG_SORT_KEYS_NUM) { @request_keys = sort {$a <=> $b} @request_keys; } foreach my $key (@request_keys) { my $filter_impact = 0; my $key_converted = ''; my $value_converted = ''; my $time_ms = 0; my @matched_filters = (); my @matched_tags = (); my $request_value = defined $request->{$key} ? $request->{$key} : ''; my $contains_encoding = 0; if (DEBUG_MODE & DEBUG_KEY_VALUES) { print "\n\n\n******************************************\n". "Key : $key\nValue : $request_value\n"; } # skip if value is empty or generally whitelisted if ( $request_value ne '' && !( $self->{whitelist}{$key} && !defined($self->{whitelist}{$key}->{rule}) && !defined($self->{whitelist}{$key}->{conditions}) && !defined($self->{whitelist}{$key}->{encoding}) ) ) { # If marked as JSON, try to convert from JSON to reduce false positives if (defined($self->{whitelist}{$key}) && defined($self->{whitelist}{$key}->{encoding}) && $self->{whitelist}{$key}->{encoding} eq 'json') { $request_value = _json_to_string($request_value); $contains_encoding = 1; } # make string utf8 utf8::upgrade($request_value); # scan only if value is not-harmless if ( $request_value =~ $not_harmless) { my $attacks = {}; if (!$self->{whitelist}{$key}) { # apply filters to value, not in whitelist push (@{$self->{filtered_keys}}, {key => $key, value => $request_value, reason => 'key'}); # key not whitelisted $attacks = $self->_apply_filters($request_value); } else { # check if all conditions match my $condition_mismatch = 0; foreach my $condition (@{$self->{whitelist}{$key}->{conditions}}) { if (! defined($request->{$condition->{key}}) || ( defined ($condition->{rule}) && $request->{$condition->{key}} !~ $condition->{rule} ) ) { $condition_mismatch = 1; } } # Apply filters if key is not in whitelisted environment conditions # or if the value does not match the whitelist rule if one is set. # Filtering is skipped if no rule is set. if ( $condition_mismatch || (defined($self->{whitelist}{$key}->{rule}) && $request_value !~ $self->{whitelist}{$key}->{rule}) || $contains_encoding ) { # apply filters to value, whitelist rules mismatched my $reason = ''; if ($condition_mismatch) { $reason = 'cond'; # condition mismatch } elsif (!$contains_encoding) { $reason = 'rule'; # rule mismatch } else { $reason = 'enc'; # contains encoding } push (@{$self->{filtered_keys}}, {key => $key, value => $request_value, reason => $reason}); $attacks = $self->_apply_filters($request_value); } else { # skipped, whitelist rule matched push (@{$self->{non_filtered_keys}}, {key => $key, value => $request_value, reason => 'r&c'}); # rule & conditions matched } } if ($attacks->{impact}) { $filter_impact += $attacks->{impact}; $time_ms += $attacks->{time_ms}; $value_converted = $attacks->{string_converted}; push (@matched_filters, @{$attacks->{filters}}); push (@matched_tags, @{$attacks->{tags}}); } } else { # skipped, harmless string push (@{$self->{non_filtered_keys}}, {key => $key, value => $request_value, reason => 'harml'}); # harmless } } else { # skipped, empty value or key generally whitelisted my $reason = $request_value ? 'key' : 'empty'; push (@{$self->{non_filtered_keys}}, {key => $key, value => $request_value, reason => $reason}); } # scan key only if desired if ($self->{scan_keys}) { # scan only if value is not-harmless if ( $key =~ $not_harmless ) { # apply filters to key my $attacks = $self->_apply_filters($key); $filter_impact += $attacks->{impact}; $time_ms += $attacks->{time_ms}; $key_converted = $attacks->{string_converted}; push (@matched_filters, @{$attacks->{filters}}); push (@matched_tags, @{$attacks->{tags}}); } else { # skipped, alphanumeric key only } } # add attack to log my %attack = (); if ($filter_impact) { # make arrays unique and sorted my %seen = (); @matched_filters = sort grep { ! $seen{$_} ++ } @matched_filters; %seen = (); @matched_tags = sort grep { ! $seen{$_} ++ } @matched_tags; %attack = ( key => $key, key_converted => $key_converted, value => $request_value, value_converted => $value_converted, time_ms => $time_ms, impact => $filter_impact, matched_filters => \@matched_filters, matched_tags => \@matched_tags, ); push (@{$self->{attacks}}, \%attack); } $self->{impact} += $filter_impact; if (DEBUG_MODE & DEBUG_ARRAY_INFO && %attack) { use Data::Dumper; print "------------------------------------------\n". Dumper(\%attack) . "\n\n"; } if (DEBUG_MODE & DEBUG_IMPACTS) { print "Impact: $filter_impact\n"; } } # end of foreach key if ($self->{impact} > 0) { return $self->{impact}; } else { return 0; } } #****f* IDS/set_scan_keys # NAME # set_scan_keys # DESCRIPTION # Sets key scanning option # INPUT # +scan_keys 1 to scan keys, 0 to switch off scanning keys, defaults to 0 # OUTPUT # none # SYNOPSIS # $ids->set_scan_keys(scan_keys => 1); #**** =head2 set_scan_keys() DESCRIPTION Sets key scanning option INPUT +scan_keys 1 to scan keys, 0 to switch off scanning keys, defaults to 0 OUTPUT none SYNOPSIS $ids->set_scan_keys(scan_keys => 1); =cut sub set_scan_keys { my ($self, %args) = @_; $self->{scan_keys} = $args{scan_keys} ? 1 : 0; } #****f* IDS/get_attacks # NAME # get_attacks # DESCRIPTION # Get an key/value/impact array of all detected attacks. # The array is emptied at the start of each run of detect_attacks(). # INPUT # none # OUTPUT # HASHREF ( # key => '', # value => '', # impact => n, # filters => (n, n, n, n, ...), # tags => ('', '', '', '', ...), # ) # SYNOPSIS # $ids->get_attacks(); #**** =head2 get_attacks() DESCRIPTION Get an key/value/impact array of all detected attacks. The array is emptied at the start of each run of C. INPUT none OUTPUT ARRAY ( key => '', value => '', impact => n, filters => (n, n, n, n, ...), tags => ('', '', '', '', ...), ) SYNOPSIS $ids->get_attacks(); =cut sub get_attacks { my ($self) = @_; return $self->{attacks}; } #****f* IDS/get_rule_description # NAME # get_rule_description # DESCRIPTION # This sub returns the rule description for a given rule id. This can be used for logging purposes. # INPUT # HASH # + rule_id id of rule # OUTPUT # SCALAR description # EXAMPLE # $ids->get_rule_description( rule_id => $rule_id ); #**** =head2 get_rule_description() DESCRIPTION Returns the rule description for a given rule id. This can be used for logging purposes. INPUT HASH + rule_id id of rule OUTPUT SCALAR description EXAMPLE $ids->get_rule_description( rule_id => $rule_id ); =cut sub get_rule_description { my ($self, %args) = @_; return $self->{rule_descriptions}{$args{rule_id}}; } #****if* IDS/_apply_filters # NAME # _apply_filters # DESCRIPTION # Applies filter rules to a string to detect attacks # INPUT # + $string string to be checked for possible attacks # OUTPUT # attack hashref: # ( # impact => n, # filters => (n, n, n, ...), # tags => ('', '', '', ...), # string_converted => string # ) # SYNOPSIS # IDS::_apply_filters($string); #**** sub _apply_filters { my ($self, $string) = @_; my %attack = ( filters => [], tags => [], impact => 0, string_converted => '', ); # benchmark my $start_time = Time::HiRes::time(); # run all string converters $attack{string_converted} = _run_all_converters($string); # apply filters foreach my $filter (@{$self->{filters}}) { # skip disabled filters next if ($self->{filter_disabled}{$filter->{id}}); my $string_converted_lc = lc($attack{string_converted}); if ($string_converted_lc =~ $filter->{rule}) { $attack{impact} += $filter->{impact}; push (@{$attack{filters}}, $filter->{id}); push (@{$attack{tags}}, @{$filter->{tags}}); } } # benchmark my $end_time = Time::HiRes::time(); $attack{time_ms} = int(($end_time-$start_time)*1000); return \%attack; } #****if* IDS/_load_filters_from_xml # NAME # _load_filters_from_xml # DESCRIPTION # loads the filters from PHPIDS filter XML file # INPUT # filterfile path + name of the XML filter file # OUTPUT # filtercount number of loaded filters # SYNOPSIS # IDS::_load_filters_from_xml('/home/xyz/default_filter.xml'); #**** sub _load_filters_from_xml { my ($self, $filterfile) = @_; my $filtercnt = 0; if ($filterfile) { # read & parse filter XML my $filterxml; eval { $filterxml = XML::Simple::XMLin($filterfile, forcearray => [ qw(rule description tags tag impact filter filters)], keyattr => [], ); }; if ($@) { croak "Error in _load_filters_from_xml while parsing $filterfile: $@"; } # convert XML structure into handy data structure foreach my $filterobj (@{$filterxml->{filter}}) { my @taglist = (); foreach my $tag (@{$filterobj->{tags}[0]->{tag}}) { push(@taglist, $tag); } my $rule = ''; eval { $rule = qr/$filterobj->{rule}[0]/ms; }; if ($@) { croak 'Error in filter rule #' . $filterobj->{id} . ': ' . $filterobj->{rule}[0] . ' Message: ' . $@; } my %filterhash = ( rule => $rule, impact => $filterobj->{impact}[0], id => $filterobj->{id}, tags => \@taglist, ); push (@{$self->{filters}}, \%filterhash); $self->{rule_descriptions}{$filterobj->{id}} = $filterobj->{description}[0]; $filtercnt++ } } return $filtercnt; } #****if* IDS/_load_whitelist_from_xml # NAME # _load_whitelist_from_xml # DESCRIPTION # loads the parameter whitelist XML file # INPUT # whitelistfile path + name of the XML whitelist file # OUTPUT # int number of loaded rules # SYNOPSIS # IDS::_load_whitelist_from_xml('/home/xyz/param_whitelist.xml'); #**** sub _load_whitelist_from_xml { my ($self, $whitelistfile) = @_; my $whitelistcnt = 0; if ($whitelistfile) { # read & parse whitelist XML my $whitelistxml; eval { $whitelistxml = XMLin($whitelistfile, forcearray => [ qw(whitelist param conditions condition)], keyattr => [], ); }; if ($@) { croak "Error in _load_whitelist_from_xml while parsing $whitelistfile: $@"; } # convert XML structure into handy data structure foreach my $whitelistobj (@{$whitelistxml->{param}}) { my @conditionslist = (); foreach my $condition (@{$whitelistobj->{conditions}[0]{condition}}) { if (defined($condition->{rule})) { # copy for error message my $rule = $condition->{rule}; eval { $condition->{rule} = qr/$condition->{rule}/ms; }; if ($@) { croak 'Error in whitelist rule of condition "' . $condition->{key} . '" for param "' . $whitelistobj->{key} . '": ' . $rule . ' Message: ' . $@; } } push(@conditionslist, $condition); } my %whitelisthash = (); if (defined($whitelistobj->{rule})) { eval { $whitelisthash{rule} = qr/$whitelistobj->{rule}/ms; }; if ($@) { croak 'Error in whitelist rule for param "' . $whitelistobj->{key} . '": ' . $whitelistobj->{rule} . ' Message: ' . $@; } } if (@conditionslist) { $whitelisthash{conditions} = \@conditionslist; } if ($whitelistobj->{encoding}) { $whitelisthash{encoding} = $whitelistobj->{encoding}; } $self->{whitelist}{$whitelistobj->{key}} = \%whitelisthash; $whitelistcnt++; } if (DEBUG_MODE & DEBUG_WHITELIST) { use Data::Dumper; print Dumper($self->{whitelist}); } } return $whitelistcnt; } #****if* IDS/_json_to_string # NAME # _json_to_string # DESCRIPTION # Tries to decode a string from JSON. Uses _datastructure_to_string(). # INPUT # value the string to convert # OUTPUT # value converted string if correct JSON, the unchanged input string otherwise # SYNOPSIS # IDS::_json_to_string($value); #**** sub _json_to_string { my ($value) = @_; my $json_ds; eval { $json_ds = JSON::XS::decode_json($value); }; if (!$@) { $value = _datastructure_to_string($json_ds)."\n"; } return $value; } #****if* IDS/_run_all_converters # NAME # _run_all_converters # DESCRIPTION # Runs all converter functions # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_run_all_converters($value); #**** sub _run_all_converters { my ($value) = @_; if (DEBUG_MODE & DEBUG_CONVERTERS) { print "------------------------------------------\n\n"; } foreach my $converter (@CONVERTERS) { no strict 'refs'; $value = $converter->($value); if (DEBUG_MODE & DEBUG_CONVERTERS) { print "$converter output:\n$value\n\n"; } } return $value; } #****if* IDS/_convert_from_commented # NAME # _convert_from_commented # DESCRIPTION # Check for comments and erases them if available # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_commented($value); #**** sub _convert_from_commented { my ($value) = @_; # check for existing comments if (preg_match(qr/(?:\|\/\*|\*\/|\/\/\W*\w+\s*$)|(?:--[^-]*-)/ms, $value)) { #/ my @pattern = ( qr/(?:(?:))/ms, qr/(?:(?:\/\*\/*[^\/\*]*)+\*\/)/ms, qr/(?:--[^-]*-)/ms, ); my $converted = preg_replace(\@pattern, ';', $value); $value .= "\n" . $converted; } # make sure inline comments are detected and converted correctly $value = preg_replace(qr/(<\w+)\/+(\w+=?)/m, '$1/$2', $value); $value = preg_replace(qr/[^\\:]\/\/(.*)$/m, '/**/$1', $value); return $value; } #****if* IDS/_convert_from_newlines # NAME # _convert_from_newlines # DESCRIPTION # Strip newlines # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_newlines($value); #**** sub _convert_from_newlines { my ($value) = @_; # check for inline linebreaks my @search = ('\r', '\n', '\f', '\t', '\v'); $value = str_replace(\@search, ';', $value); # convert real linebreaks (\013 in Perl instead of \v in PHP et al.) return preg_replace(qr/(?:\n|\r|\013)/m, ' ', $value); } #****if* IDS/_convert_from_js_charcode # NAME # _convert_from_js_charcode # DESCRIPTION # Checks for common charcode pattern and decodes them # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_js_charcode($value); #**** sub _convert_from_js_charcode { my ($value) = @_; my @matches = (); # check if value matches typical charCode pattern # PHP to Perl note: additional parenthesis around RegEx for getting PHP's $matches[0] if (preg_match_all(qr/(?:[\d+-=\/\* ]+(?:\s?,\s?[\d+-=\/\* ]+)){4,}/ms, $value, \@matches)) { my $converted = ''; my $string = implode(',', $matches[0]); $string = preg_replace(qr/\s/, '', $string); $string = preg_replace(qr/\w+=/, '', $string); my @charcode = explode(',', $string); foreach my $char (@charcode) { $char = preg_replace(qr/\W0/s, '', $char); my @matches = (); # PHP to Perl note: additional parenthesis around RegEx for getting PHP's $matches[0] if (preg_match_all(qr/(\d*[+-\/\* ]\d+)/, $char, \@matches)) { my @match = split(qr/(\W?\d+)/, (implode('', $matches[0])), # null, # PREG_SPLIT_DELIM_CAPTURE ); # 3rd argument null, 4th argument PREG_SPLIT_DELIM_CAPTURE is default in Perl and not there my $test = implode('', $matches[0]); if (array_sum(@match) >= 20 && array_sum(@match) <= 127) { $converted .= chr(array_sum(@match)); } } elsif ($char && $char >= 20 && $char <= 127) { $converted .= chr($char); } } $value .= "\n" . $converted; } # check for octal charcode pattern # PHP to Perl note: \\ in Perl instead of \\\ in PHP # PHP to Perl note: additional parenthesis around RegEx for getting PHP's $matches[0] if (preg_match_all(qr/((?:(?:[\\]+\d+\s*){8,}))/ms, $value, \@matches)) { my $converted = ''; my @charcode = explode('\\', preg_replace(qr/\s/, '', implode(',', $matches[0]))); foreach my $char (@charcode) { if ($char) { if (oct($char) >= 20 && oct($char) <= 127) { $converted .= chr(oct($char)); } } } $value .= "\n" . $converted; } # check for hexadecimal charcode pattern # PHP to Perl note: \\ in Perl instead of \\\ in PHP # PHP to Perl note: additional parenthesis around RegEx for getting PHP's $matches[0] if (preg_match_all(qr/((?:(?:[\\]+\w+[ \t]*){8,}))/ms, $value, \@matches)) { my $converted = ''; my @charcode = explode('\\', preg_replace(qr/[ux]/, '', implode(',', $matches[0]))); foreach my $char (@charcode) { if ($char) { if (hex($char) >= 20 && hex($char) <= 127) { $converted .= chr(hex($char)); } } } $value .= "\n" . $converted; } return $value; } #****if* IDS/_convert_js_regex_modifiers # NAME # _convert_js_regex_modifiers # DESCRIPTION # Eliminate JS regex modifiers # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_js_regex_modifiers($value); #**** sub _convert_js_regex_modifiers { my ($value) = @_; $value = preg_replace(qr/\/[gim]/, '/', $value); return $value; } #****if* IDS/_convert_quotes # NAME # _convert_quotes # DESCRIPTION # Normalize quotes # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_quotes($value); #**** sub _convert_quotes { my ($value) = @_; # normalize different quotes to " my @pattern = ('\'', '`', '´', '’', '‘'); $value = str_replace(\@pattern, '"', $value); return $value; } #****if* IDS/_convert_from_sql_hex # NAME # _convert_from_sql_hex # DESCRIPTION # Converts SQLHEX to plain text # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_sql_hex($value); #**** sub _convert_from_sql_hex { my ($value) = @_; my @matches = (); # PHP to Perl note: additional parenthesis around RegEx for getting PHP's $matches[0] if(preg_match_all(qr/((?:0x[a-f\d]{2,}[a-f\d\s]*)+)/im, $value, \@matches)) { foreach my $match ($matches[0]) { my $converted = ''; foreach my $hex_index (str_split($match, 2)) { if(preg_match(qr/[a-f\d]{2,3}/i, $hex_index)) { $converted .= chr(hex($hex_index)); } } $value = str_replace($match, $converted, $value); } } return $value; } #****if* IDS/_convert_from_sql_keywords # NAME # _convert_from_sql_keywords # DESCRIPTION # Converts basic SQL keywords and obfuscations # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_sql_keywords($value); #**** sub _convert_from_sql_keywords { my ($value) = @_; my $pattern = qr/(?:IS\s+null)|(LIKE\s+null)|(?:(?:^|\W)IN[+\s]*\([\s\d"]+[^()]*\))/ims; $value = preg_replace($pattern, '"=0', $value); $value = preg_replace(qr/null,/ims, ',0', $value); $value = preg_replace(qr/,null/ims, ',0', $value); # \\N instead of PHP's \\\N $pattern = qr/[^\w,]NULL|\\N|TRUE|FALSE|UTC_TIME|LOCALTIME(?:STAMP)?|CURRENT_\w+|BINARY|(?:(?:ASCII|SOUNDEX|MD5|R?LIKE)[+\s]*\([^()]+\))|(?:-+\d)/ims; $value = preg_replace($pattern, 0, $value); $pattern = qr/(?:NOT\s+BETWEEN)|(?:IS\s+NOT)|(?:NOT\s+IN)|(?:XOR|\WDIV\W|\WNOT\W|<>|RLIKE(?:\s+BINARY)?)|(?:REGEXP\s+BINARY)|(?:SOUNDS\s+LIKE)/ims; $value = preg_replace($pattern, '!', $value); $value = preg_replace(qr/"\s+\d/, '"', $value); return $value; } #****if* IDS/_convert_entities # NAME # _convert_entities # DESCRIPTION # Converts from hex/dec entities (use HTML::Entities;) # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_entities($value); #**** sub _convert_entities { my ($value) = @_; my $converted = ''; if (preg_match(qr/&#x?[\w]+/ms, $value)) { $converted = preg_replace(qr/(&#x?[\w]{2}\d?);?/ms, '$1;', $value); $converted = HTML::Entities::decode_entities($converted); $value .= "\n" . str_replace(';;', ';', $converted); } return $value; } #****if* IDS/_convert_from_control_chars # NAME # _convert_from_control_chars # DESCRIPTION # Detects nullbytes and controls chars via ord() # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_control_chars($value); #**** sub _convert_from_control_chars { my ($value) = @_; # critical ctrl values my @search = (chr(0), chr(1), chr(2), chr(3), chr(4), chr(5), chr(6), chr(7), chr(8), chr(11), chr(12), chr(14), chr(15), chr(16), chr(17), chr(18), chr(19)); $value = str_replace(\@search, '%00', $value); my $urlencoded = urlencode($value); # take care for malicious unicode characters $value = urldecode(preg_replace(qr/(?:%E(?:2|3)%8(?:0|1)%(?:A|8|9)\w|%EF%BB%BF|%EF%BF%BD)|(?:&#(?:65|8)\d{3};?)/i, '', $urlencoded)); $value = preg_replace(qr/(?:&[#x]*(200|820|200|820|zwn?j|lrm|rlm)\w?;?)/i, '', $value); $value = preg_replace(qr/(?:&#(?:65|8)\d{3};?)|(?:&#(?:56|7)3\d{2};?)|(?:&#x(?:fe|20)\w{2};?)|(?:&#x(?:d[c-f])\w{2};?)/i, '', $value); return $value; } #****if* IDS/_convert_from_nested_base64 # NAME # _convert_from_nested_base64 # DESCRIPTION # Matches and translates base64 strings and fragments used in data URIs (use MIME::Base64;) # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_nested_base64($value); #**** sub _convert_from_nested_base64 { my ($value) = @_; my @matches = (); preg_match_all(qr/(?:^|[,&?])\s*([a-z0-9]{30,}=*)(?:\W|$)/im, #)/ $value, \@matches, ); # PHP to Perl note: PHP's $matches[1] is Perl's default ($matches[0] is the entire RegEx match) foreach my $item (@matches) { if ($item && !preg_match(qr/[a-f0-9]{32}/i, $item)) { # fill up the string with zero bytes if too short for base64 blocks my $item_original = $item; if (my $missing_bytes = length($item) % 4) { for (1..$missing_bytes) { $item .= "="; } } $value = str_replace($item_original, MIME::Base64::decode_base64($item), $value); } } return $value; } #****if* IDS/_convert_from_out_of_range_chars # NAME # _convert_from_out_of_range_chars # DESCRIPTION # Detects nullbytes and controls chars via ord() # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_out_of_range_chars($value); #**** sub _convert_from_out_of_range_chars { my ($value) = @_; my @values = str_split($value); foreach my $item (@values) { if (ord($item) >= 127) { $value = str_replace($item, 'U', $value); } } return $value; } #****if* IDS/_convert_from_xml # NAME # _convert_from_xml # DESCRIPTION # Strip XML patterns # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_xml($value); #**** sub _convert_from_xml { my ($value) = @_; my $converted = strip_tags($value); if ($converted && ($converted ne $value)) { return $value . "\n" . $converted; } return $value; } #****if* IDS/_convert_from_js_unicode # NAME # _convert_from_js_unicode # DESCRIPTION # Converts JS unicode code points to regular characters # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_js_unicode($value); #**** sub _convert_from_js_unicode { my ($value) = @_; my @matches = (); # \\u instead of PHP's \\\u # PHP to Perl note: additional parenthesis around RegEx for getting PHP's $matches[0] preg_match_all(qr/(\\u[0-9a-f]{4})/ims, $value, \@matches); if ($matches[0]) { foreach my $match ($matches[0]) { $value = str_replace($match, chr(hex(substr($match, 2, 4))), $value); } $value .= "\n".'\u0001'; } return $value; } #****if* IDS/_convert_from_utf7 # NAME # _convert_from_utf7 # DESCRIPTION # Converts relevant UTF-7 tags to UTF-8 (use Encode qw/decode/;) # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_utf7($value); #**** sub _convert_from_utf7 { my ($value) = @_; if (preg_match(qr/\+A\w+-/m, $value)) { $value .= "\n" . decode("UTF-7", $value); } return $value; } #****if* IDS/_convert_concatenations # NAME # _convert_concatenations # DESCRIPTION # Converts basic concatenations # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_concatenations($value); #**** sub _convert_concatenations { my ($value) = @_; # normalize remaining backslashes # Perl's \\ should be equivalent to PHP's \\\ if ($value ne preg_replace(qr/(?:(\w)\\)/, '$1', $value)) { $value .= preg_replace(qr/(?:(\w)\\)/, '$1', $value); } my $compare = stripslashes($value); my @pattern = ( qr/(?:<\/\w+>\+<\w+>)/s, qr/(?:":\d+[^"[]+")/s, qr/(?:"?"\+\w+\+")/s, qr/(?:"\s*;[^"]+")|(?:";[^"]+:\s*")/s, qr/(?:"\s*(?:;|\+).{8,18}:\s*")/s, qr/(?:";\w+=)|(?:!""&&")|(?:~)/s, qr/(?:"?"\+""?\+?"?)|(?:;\w+=")|(?:"[|&]{2,})/s, qr/(?:"\s*\W+")/s, qr/(?:";\w\s*\+=\s*\w?\s*")/s, qr/(?:"[|&;]+\s*[^|&\n]*[|&]+\s*"?)/s, qr/(?:";\s*\w+\W+\w*\s*[|&]*")/s, qr/(?:"\s*"\s*\.)/s, qr/(?:\s*new\s+\w+\s*[+"])/, qr/(?:(?:^|\s+)(?:do|else)\s+)/, qr/(?:\{\s*new\s+\w+\s*\})/, qr/(?:(this|self).)/, ); # strip out concatenations my $converted = preg_replace(\@pattern, '', $compare); # strip object traversal $converted = preg_replace(qr/\w(\.\w\()/, '$1', $converted); # convert JS special numbers $converted = preg_replace(qr/(?:\(*[.\d]e[+-]*[^a-z\W]+\)*)|(?:NaN|Infinity)\W/ms, 1, $converted); if ($converted && ($compare ne $converted)) { $value .= "\n" . $converted; } return $value; } #****if* IDS/_convert_from_proprietary_encodings # NAME # _convert_from_proprietary_encodings # DESCRIPTION # Collects and decodes proprietary encoding types # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_convert_from_proprietary_encodings($value); #**** sub _convert_from_proprietary_encodings { my ($value) = @_; # Xajax error reportings $value = preg_replace(qr//im, '$1', $value); # strip false alert triggering apostrophes $value = preg_replace(qr/(\w)\"(s)/m, '$1$2', $value); # strip quotes within typical search patterns $value = preg_replace(qr/^"([^"=\\!><~]+)"$/, '$1', $value); # OpenID login tokens $value = preg_replace(qr/{[\w-]{8,9}\}(?:\{[\w=]{8}\}){2}/, '', $value); # convert Content to null to avoid false alerts $value = preg_replace(qr/Content/, '', $value); # strip emoticons $value = preg_replace(qr/(?:[:;]-[()\/PD]+)|(?:\s;[()PD]+)|(?::[()PD]+)|-\.-|\^\^/m, '', $value); # normalize separation char repetition $value = preg_replace(qr/([.+~=*_\-])\1{2,}/m, '$1', $value); # remove parenthesis inside sentences $value = preg_replace(qr/(\w\s)\(([&\w]+)\)(\s\w|$)/, '$1$2$3', $value); #/ # normalize ampersand listings $value = preg_replace(qr/(\w\s)&\s(\w)/, '$1$2', $value); return $value; } #****if* IDS/_run_centrifuge # NAME # _run_centrifuge # DESCRIPTION # The centrifuge prototype # INPUT # value the string to convert # OUTPUT # value converted string # SYNOPSIS # IDS::_run_centrifuge($value); #**** sub _run_centrifuge { my ($value) = @_; my $threshold = 3.49; if (strlen($value) > 25) { # Check for the attack char ratio my $tmp_value = $value; $tmp_value = preg_replace(qr/([*.!?+-])\1{1,}/m, '$1', $tmp_value); $tmp_value = preg_replace(qr/"[\p{L}\d\s]+"/m, '', $tmp_value); my $stripped_length = strlen(preg_replace(qr/[\d\s\p{L}.:,%\/><-]+/m, '', $tmp_value)); my $overall_length = strlen(preg_replace(qr/([\d\s\p{L}]{4,})+/m, 'aaa', preg_replace(qr/\s{2,}/ms, '', $tmp_value))); if ($stripped_length != 0 && $overall_length/$stripped_length <= $threshold ) { $value .= "\n".'$[!!!]'; } } if (strlen($value) > 40) { # Replace all non-special chars my $converted = preg_replace(qr/[\w\s\p{L},.!]/, '', $value); # Split string into an array, unify and sort my @array = str_split($converted); my %seen = (); my @unique = grep { ! $seen{$_} ++ } @array; @unique = sort @unique; # Normalize certain tokens my %schemes = ( '~' => '+', '^' => '+', '|' => '+', '*' => '+', '%' => '+', '&' => '+', '/' => '+', ); $converted = implode('', @unique); $converted = str_replace([keys %schemes], [values %schemes], $converted); $converted = preg_replace(qr/[+-]\s*\d+/, '+', $converted); $converted = preg_replace(qr/[()[\]{}]/, '(', $converted); $converted = preg_replace(qr/[!?:=]/, ':', $converted); $converted = preg_replace(qr/[^:(+]/, '', stripslashes($converted)); #/ # Sort again and implode @array = str_split($converted); @array = sort @array; $converted = implode('', @array); if (preg_match(qr/(?:\({2,}\+{2,}:{2,})|(?:\({2,}\+{2,}:+)|(?:\({3,}\++:{2,})/, $converted)) { return $value . "\n" . $converted; } } return $value; } #****if* IDS/_datastructure_to_string # NAME # _datastructure_to_string # DESCRIPTION # Walks recursively through array or hash and concatenates keys and values to one single string (\n separated) # INPUT # ref the array/hash to convert # OUTPUT # string converted string # SYNOPSIS # IDS::_datastructure_to_string($ref); #**** sub _datastructure_to_string { my $in = shift; my $out = ''; if (ref $in eq 'HASH') { foreach (keys %$in) { $out .= $_."\n"; $out .= _datastructure_to_string($in->{$_}); } } elsif (ref $in eq 'ARRAY') { foreach (@$in) { $out = _datastructure_to_string($_) . $out; } } else { $out .= $in."\n"; } return $out; } #------------------------- PHP functions --------------------------------------- #****f* IDS/array_sum # NAME # array_sum # DESCRIPTION # Equivalent to PHP's array_sum, sums all array values # INPUT # array the string to convert # OUTPUT # sum sum of all array values # SYNOPSIS # IDS::array_sum(@array); #**** sub array_sum { (my @array) = @_; my $sum = 0; foreach my $value (@array) { if ($value) { $sum += $value; } } return $sum; } #****f* IDS/preg_match # NAME # preg_match # DESCRIPTION # Equivalent to PHP's preg_match, but with two arguments only # INPUT # pattern the pattern to match # string the string # OUTPUT # boolean 1 if pattern matches string, 0 otherwise # SYNOPSIS # IDS::preg_match($pattern, $string); #**** sub preg_match { (my $pattern, my $string) = @_; return ($string =~ $pattern); } #****f* IDS/preg_match_all # NAME # preg_match_all # DESCRIPTION # Equivalent to PHP's preg_match_all, but with three arguments only. # Does not return nested arrays like PHP. # Does not automatically match entire RegEx in $matches[0] like PHP does - # Use brackets around your entire RegEx instead: preg_match_all(qr/(your(\d)(R|r)egex)/. # INPUT # pattern the pattern to match # string the string # arrayref the array to store the matches in # OUTPUT # array same content as written into arrayref # SYNOPSIS # IDS::preg_match_all(qr/(?:[\d+-=\/\* ]+(?:\s?,\s?[\d+-=\/\* ]+)+){4,}/ms, $value, \@matches) # if (IDS::preg_match_all(qr/(?:[\d+-=\/\* ]+(?:\s?,\s?[\d+-=\/\* ]+)+){4,}/ms, $value, \@matches)) { # print 'match'; # } #**** sub preg_match_all { (my $pattern, my $string, my $matches) = @_; return (@$matches = ($string =~ /$pattern/g)); } #****f* IDS/preg_replace # NAME # preg_replace # DESCRIPTION # Equivalent to PHP's preg_replace, but with three arguments only # INPUT # + pattern the pattern(s) to match # replacement the replacement(s) # + string the string(s) # OUTPUT # string the string(s) with all replacements done # SYNOPSIS # IDS::preg_replace(\@patterns, $replacement, $string); # IDS::preg_replace(qr/^f.*ck/i, 'censored', $string); # IDS::preg_replace(['badword', 'badword2', 'badword3'], ['censored1', 'censored2', 'censored3'], $string); #**** sub preg_replace { (my $patterns, my $replacements, my $strings) = @_; # check input if (!defined($strings) || !$strings || !defined($patterns) || !$patterns ) { return ''; } my $return_string = ''; if (ref($strings) ne 'ARRAY') { $return_string = $strings; } if (ref($strings) eq 'ARRAY') { my @replaced_strings = map { preg_replace($patterns, $replacements, $_); } @$strings; return \@replaced_strings; } elsif (ref($patterns) eq 'ARRAY') { my $pattern_no = 0; foreach my $pattern (@$patterns) { if (ref($replacements) eq 'ARRAY') { $return_string = preg_replace($pattern, @$replacements[$pattern_no++], $return_string); } else { $return_string = preg_replace($pattern, $replacements, $return_string); } } } else { my $repl = ''; if (ref($replacements) eq 'ARRAY') { $repl = @$replacements[0]; } else { if (!defined($replacements)) { $repl = ''; } else { $repl = $replacements; } } $repl =~ s/\\/\\\\/g; $repl =~ s/\"/\\"/g; $repl =~ s/\@/\\@/g; $repl = qq{"$repl"}; $return_string =~ s/$patterns/$repl/eeg; } return $return_string; } #****f* IDS/str_replace # NAME # str_replace # DESCRIPTION # Equivalent to PHP's str_replace, but with three arguments only (simply a wrapper for preg_replace, but escapes pattern meta characters) # INPUT # pattern the pattern(s) to match # replacement the replacement(s) # string the string(s) # OUTPUT # string the string(s) with all replacements done # SYNOPSIS # IDS::str_replace(\@patterns, $replacement, $string); # IDS::str_replace('bad\tword', 'censored', $string); # replaces 'bad\tword' but not 'bad word' or "bad\tword" # IDS::str_replace(['badword', 'badword2', 'badword3'], ['censored1', 'censored2', 'censored3'], $string); #**** sub str_replace { (my $patterns, my $replacements, my $strings) = @_; my @escapedpatterns = (); if (ref($patterns) eq 'ARRAY') { @escapedpatterns = map {quotemeta($_)} @$patterns; return preg_replace(\@escapedpatterns, $replacements, $strings); } else { return preg_replace(quotemeta($patterns), $replacements, $strings); } } #****f* IDS/str_split # NAME # str_split # DESCRIPTION # Equivalent to PHP's str_split # INPUT # string the string to split # OUTPUT # array the split string # SYNOPSIS # IDS::str_split($string); #**** sub str_split { (my $string, my $limit) = @_; if (defined($limit)) { return ($string =~ /(.{1,$limit})/g); } else { return split(//, $string); } } #****f* IDS/strlen # NAME # strlen # DESCRIPTION # Equivalent to PHP's strlen, wrapper for Perl's length() # INPUT # string the string # OUTPUT # string the string's length # SYNOPSIS # IDS::strlen($url); #**** sub strlen { (my $string) = @_; return length($string); } #****f* IDS/urldecode # NAME # urldecode # DESCRIPTION # Equivalent to PHP's urldecode # INPUT # string the URL to decode # OUTPUT # string the decoded URL # SYNOPSIS # IDS::urldecode($url); #**** sub urldecode { (my $theURL) = @_; $theURL =~ tr/+/ /; $theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg; $theURL =~ s///g; return $theURL; } #****f* IDS/urlencode # NAME # urlencode # DESCRIPTION # Equivalent to PHP's urlencode # INPUT # string the URL to encode # OUTPUT # string the encoded URL # SYNOPSIS # IDS::urlencode($url); #**** sub urlencode { (my $theURL) = @_; $theURL =~ s/([\W])/sprintf("%%%02X",ord($1))/eg; return $theURL; } #****f* IDS/implode # NAME # implode # DESCRIPTION # Equivalent to PHP's implode (simply wrapper of join) # INPUT # string glue the glue to put between the pieces # array pieces the pieces to be put together # OUTPUT # string the imploded string # SYNOPSIS # IDS::implode(';', @pieces); #**** sub implode { (my $glue, my @pieces) = @_; return join($glue, @pieces); } #****f* IDS/explode # NAME # explode # DESCRIPTION # Equivalent to PHP's explode (simply wrapper of split, but escapes met characters) # INPUT # string glue the glue to put between the pieces # string string the string to split # OUTPUT # array the exploded string # SYNOPSIS # IDS::explode(';', $string); #**** sub explode { (my $glue, my $string) = @_; return split(quotemeta($glue), $string); } #****f* IDS/stripslashes # NAME # stripslashes # DESCRIPTION # Equivalent to PHP's stripslashes # INPUT # string string the string # OUTPUT # string the stripped string # SYNOPSIS # IDS::stripslashes($string); #**** sub stripslashes { (my $string) = @_; # $string =~ s/(?:\\(\'|\"|\\|\0|N))/$1/g; $string =~ s/\\([^\\])/$1/g; return $string; } #****f* IDS/strip_tags # NAME # strip_tags # DESCRIPTION # Equivalent to PHP's strip_tags, but without 'allowable_tags' parameter # INPUT # string string the string # OUTPUT # string the stripped string # SYNOPSIS # IDS::strip_tags($string); #**** sub strip_tags { (my $string) = @_; while ($string =~ s/<(?:[^<>]*)>//gs) {}; return $string; } 1; __END__ =head1 XML INPUT FILES =head2 Filters This module is compatible with the PHPIDS filter set. Please find the latest (frequently updated) filter file from the PHPIDS Subversion repository at L. =head3 Example XML Code 1 )|(?:[^\w\s]\s*\/>)|(?:>")]]> finds html breaking injections including whitespace attacks xss csrf 4 2 \w=\/)|(?:#.+\)["\s]*>)|(?:"\s*(?:src|style|on\w+)\s*=\s*")]]> finds attribute breaking injections including whitespace attacks xss csrf 4 =head3 Used XML Tags =over 4 =item * filters The root tag. =over 4 =item * filter Filter item. =over 4 =item * id Filter ID for referring in log files etc. =item * rule The regular expression for detection of malicious code. Case-insensitive; mode modifiers I, I and I in use. =item * description Description of what the filter finds. =item * tags Set of tags that describe the kind of attack. =over 4 =item * tag Currently used values are I, I, I, I
, I, I, I, I, I. =back =item * impact Value of impact, defines the weight of the attack. Each detection run adds the particular filter impacts to one total impact sum. =back =back =back =head2 Whitelist Using a whitelist you can improve the speed an the accurancy of the IDS. A whitelist defines which parameters do not need to undergo the expensive scanning (if their values match given rules and given conditions). =head3 Example XML Code scr_id uid json_value json login_password username send action sender_id action =head3 Used XML Tags =over 4 =item * whitelist The root tag. =over 4 =item * param Parameter item. Defines the query parameter to be whitelisted. =over 4 =item * key Parameter key. =item * rule Regular expression to match. If the parameter value matches this rule or the rule tag is not present, the IDS will not run its filters on it. Case-sensitive; mode modifiers I and I in use. =item * encoding Use value I if the parameter contains JSON encoded data. IDS will test the decoded data, otherwise a false positive would occur due to the 'suspicious' JSON encoding characters. =item * conditions Set of conditions to be fulfilled. This is the parameter environment in which the whitelisted parameter has to live in. The parameter will only be skipped if all conditions (and its own parameter rule) match. In the example XML this means: I may only be skipped of filtering if parameter I equals I, parameter I is present and parameter I contains only small letters. =over 4 =item * condition A condition to be fulfilled. =over 4 =item * key Parameter key. =item * rule Regular expression to match. Missing CruleE> means I. =back =back =back =back =back =head3 Helper methods for building and improving whitelists # check request my $impact = $ids->detect_attacks( request => $request); # print reasons and key/value pairs to a logfile for analysis of your application parameters. print LOG "filtered_keys:\n" foreach my $entry (@{$ids->{filtered_keys}}) { print LOG "\t".$entry->{reason}."\t".$entry->{key}.' => '.$value."\n"; } print LOG "non_filtered_keys:\n" foreach my $entry (@{$ids->{non_filtered_keys}}) { print LOG "\t".$entry->{reason}."\t".$entry->{key}.' => '.$value."\n"; } C<$entry-E{reason}> returns following reasons for skipping and non-skipping a value: =over 4 =item C<$ids-E{filtered_keys}> =over 4 =item * I: key not whitelisted Filtered due to missing rule set for this key. =item * I: condition mismatch Filtered due to mismatching conditions for this key. =item * I: rule mismatch Filtered due to mismatching rule for this key. =item * I: value contains encoding Filtered due to containing (JSON) encoding for this key. =back =over 4 =item C<$ids-E{non_filtered_keys}> =over 4 =item * I: empty value Not filtered due to empty value for this key. =item * I: harmless value Not filtered due to harmless value string for this key. =item * I: key generally whitelisted Not filtered because the key has been generally whitelisted. =item * I: rule & conditions matched Not filtered due to matching rules and conditions for this key. =back =back =back =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc CGI::IDS You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 CREDITS Thanks to: =over 4 =item * Mario Heiderich (L) =item * Christian Matthies (L) =item * Ingo Bax (L) =back =head1 AUTHOR Hinnerk Altenburg, C<< >> =head1 SEE ALSO L =head1 COPYRIGHT & LICENSE Copyright (C) 2008 Hinnerk Altenburg This file is part of PerlIDS. PerlIDS is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. PerlIDS is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with PerlIDS. If not, see . =cut