view release on metacpan or  search on metacpan

lib/CGI/IDS.pm  view on Meta::CPAN

    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);
    }
}

#****if* 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);
    }
}

#****if* 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);
}

#****if* 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/<!–(.|\n)*–>//g;
    utf8::decode($theURL);
    return $theURL;
}

#****if* 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;
    utf8::encode($theURL);
    return $theURL;
}

#****if* 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);
}

#****if* 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

lib/CGI/IDS.pm  view on Meta::CPAN

     <param>
         <key>json_value</key>
         <encoding>json</encoding>
     </param>
     <param>
         <key>login_password</key>
         <conditions>
             <condition>
                 <key>username</key>
                 <rule><![CDATA[(?:^[a-z]+$)]]></rule>
            </condition>
            <condition>
                <key>send</key>
            </condition>
            <condition>
                <key>action</key>
                <rule><![CDATA[(?:^login$)]]></rule>
            </condition>
         </conditions>
     </param>
     <param>
         <key>sender_id</key>
         <rule><![CDATA[(?:[0-9]+\.[0-9a-f]+)]]></rule>
         <conditions>
             <condition>
                 <key>action</key>
                 <rule><![CDATA[(?:^message$)]]></rule>
            </condition>
         </conditions>
     </param>
 </whitelist>

=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<m> and I<s> in use.

=item * encoding

Use value I<json> 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<login_password> may only be skipped of filtering if
parameter I<action> equals I<login>, parameter I<send> is present
and parameter I<username> 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 C<E<lt>ruleE<gt>> means I<key has to be present no matter what content (can even be empty)>.

=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}.' => '.$entry->{value}."\n";
 }
 print LOG "non_filtered_keys:\n"
 foreach my $entry (@{$ids->{non_filtered_keys}}) {
     print LOG "\t".$entry->{reason}."\t".$entry->{key}.' => '.$entry->{value}."\n";
 }

C<$entry-E<gt>{reason}> returns following reasons for skipping and non-skipping a value:

=over 4

=item C<$ids-E<gt>{filtered_keys}>

=over 4