#!/usr/bin/perl

# 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 <http://www.gnu.org/licenses/>.

=head1 NAME

PerlIDS (CGI::IDS) - example application

=head1 DESCRIPTION

This example application provides a textarea that will be parsed by the IDS and the scan 
result will be shown if any attack has been detected.

Two log files are created by the application:

=over 4

=item 1 I<filtered_keys.log>

Logging all filtered key/value pairs to finetune the whitelist.

=item 2 I<attacks.log>

Logging all attacks with detailed information.

=back

A sample whitelist file is provided in I<param_whitelist.xml>. Please have a look into L<CGI::IDS> for details.

=head1 AUTHOR

Hinnerk Altenburg, C<< <hinnerk at cpan.org> >>

=head1 SEE ALSO

L<http://php-ids.org/>

=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 <http://www.gnu.org/licenses/>.

=cut

#------------------------- Pragmata --------------------------------------------
use strict;
use warnings;

#------------------------- Libs ------------------------------------------------
use CGI;
use CGI::IDS;
use CGI::Pretty;
use Data::Dumper;
# use CGI::Carp qw(fatalsToBrowser);

#------------------------- Globals ---------------------------------------------
my $ids;
my $impact = 0;

#------------------------- Main ------------------------------------------------

my $query = new CGI;

# Start HTML output
print	$query->header,
		$query->start_html(
			-title=>'PerlIDS (CGI::IDS) demo application / smoke test',
			-style=>{'src'=>'style.css'},
		),
		$query->h1('PerlIDS (CGI::IDS) demo application / smoke test');

eval {
	# Check request for possible attacks (for check_request() see sub below)
	$impact = check_request( 
				request			=> scalar $query->Vars,
				# filter_file		=> './ids/default_filter.xml', 
				whitelist_file	=> './ids/param_whitelist.xml',
				filter_log		=> './ids/filtered_keys.log',
				attack_log		=> './ids/attacks.log'
	);

	# Generate input form
	print $query->h2('Put your vectors here:');
	print $query->start_form(
							-method=>'post',
							-action=>'demo.pl');
	print $query->textarea(	-name => 'vector',
							-rows => 10,
							-columns => 50,
							-default => $query->param('vector') );
	print $query->submit(	-name => 'submit',
							-value => 'Test your vector');
							print $query->endform;

	# Generate HTML scan result output showing details of the detected attack
	if ($impact > 0) {
	    print $query->h2('Scan result:');

		if ($query->param()) {
			my $attacks = $ids->get_attacks();
			foreach my $attack (@$attacks) {					
				print $query->start_table({-class => 'negative'});
				print '<tr><td class="title">' .
					join ( "</td></tr>\n<tr><td class=\"title\">", 
					(	
						'IMPACT: </td><td>'.			$attack->{impact},
						'TIME: </td><td>'.				$attack->{time_ms} . 'ms',
						'FILTERS MATCHED: </td><td>'.	join("<br />", map {"#$_: " . $ids->get_rule_description(rule_id => $_)} @{$attack->{matched_filters}}),
						'TAGS MATCHED: </td><td>'.		join(",", @{$attack->{matched_tags}}),
						# 'KEY: </td><td>'.				$query->escapeHTML($query->escapeHTML($attack->{key})),
						# 'KEY CONV: </td><td>'.			$query->escapeHTML($query->escapeHTML($attack->{key_converted})),
						'VALUE: </td><td>'.				$query->pre($query->escapeHTML($attack->{value})),
						'VALUE CONVERTED: </td><td>'.	$query->pre($query->escapeHTML($attack->{value_converted})),
					) ) .
					"</td></tr>\n";
				print '<tr><td>REQUEST: </td><td>'.$query->pre($query->escapeHTML(Dumper({$query->Vars}))).'</td></tr>';
				print $query->end_table();
			}
		}
	}
	elsif ($query->param()){
		print $query->p({-class => 'positive'}, 'No attack found!');
		print $query->p('PerlIDS did not detect your vector? Please help us to improve the filter set an send your vector to ', $query->em('hinnerk at cpan.org'), '!');
	}
};
if ($@) {
    print $query->h2({-class => 'negative'}, 'An Error occurred:');
    print $query->p({-class => 'negative'}, $@);
}

# end the HTML
print $query->end_html;

#------------------------- Subs ------------------------------------------------

#****f* IDS/check_request
# NAME
#   check_request
# DESCRIPTION
#   This sub runs IDS->detect_attacks() on the request.
#   If an impact is detected, a record is appended to the log file.
# INPUT
#   HASH
#   + request
#     filter_file
#     whitelist_file
#     attack_log
#     filter_log
# OUTPUT
#   INT impact or UNDEF if no request or filter_file present
# EXAMPLE
#   check_request( 
#     request        => $query->Vars,
#     filter_file    => '../res/default_filter.xml', 
#     whitelist_file => '../res/test_param_whitelist.xml',
#     attack_log     => '../res/attacks.log',
#     filter_log     => '../res/filtered_keys.log',
#   );
#****

sub check_request {
	my %args = @_;
	return undef unless ($args{request});
	my $request = $args{request};

	# create global ids object on first call
	if (!defined($ids)) {
		$ids = new CGI::IDS(
			filters_file	=> $args{filter_file},
			whitelist_file	=> $args{whitelist_file},
			scan_keys		=> 0,
			disable_filters	=> [58,59,60],
		);
	}

	# check request
	my $impact = $ids->detect_attacks( request => $request );

	# log filtered keys for whitelist tuning 
	# (add rules for keys to the whilelist if the filters are applied to the keys' standard values)
	if ($args{filter_log} && @{$ids->{filtered_keys}}) {

			# open logfile for appending
			umask(02);
			if (open(LOG, '>>' . $args{filter_log})) {

				flock(LOG, 2);
					print LOG "--------------------------------\n";
					print LOG "Filtered:\n";

					# log all filtered keys
					foreach my $key (@{$ids->{filtered_keys}}) {
						print LOG "\t" . $key->{reason} . "\t" . $key->{key} . " -> " . $key->{value} . "\n";
					}

					# log all non-filtered keys as environment
					if ($ids->{non_filtered_keys}) {
						print LOG "Environment:\n";
						foreach my $key (@{$ids->{non_filtered_keys}}) {
							print LOG "\t" . $key->{reason} . "\t" . $key->{key} . " -> " . $key->{value} . "\n";
						}
					}

				close(LOG);
			}
			else {
				warn "Can't open ".$args{filter_log}.": $!";
			}
	}

	# log attack details if an impact was detected
	if ($impact && $args{attack_log}) {

		# open logfile for appending
		umask(02);
		if (open(LOG, ">>".$args{attack_log})) {
			my $attacks = $ids->get_attacks();

			flock(LOG, 2);
				print LOG "--------------------------------\n";
				print LOG scalar localtime() . "\n";
				print LOG "Attack details:\n\t";

				foreach my $attack (@$attacks) {					
					print LOG join ( "\n\t", 
						(	'TIME: '.				$attack->{time_ms} . 'ms',
							'KEY: '.				$attack->{key},
							'KEY CONV: '.			$attack->{key_converted},
							'VALUE: '.				$attack->{value},
							'VALUE CONV: '.			$attack->{value_converted},
							'IMPACT: '.				$attack->{impact},
							'FILTERS MATCHED: '.	join(",", @{$attack->{matched_filters}}),
							'TAGS MATCHED: '.		join(",", @{$attack->{matched_tags}}),
							'REQUEST: '.			Dumper({$query->Vars}),
						)
						);
				}

			close(LOG);
		}
		else {
			warn "Can't open ".$args{attack_log}.": $!";
		}
	}
	
	return $impact;
}