/HTTP/Fuzzer.pm

package HTTP::Fuzzer;

=pod
=head1 NAME

HTTP::Fuzzer - An extensible HTTP Fuzzer

=head1 SYNOPSIS

 use HTTP::Fuzzer;
 use HTTP::Fuzzer::WordListGenerator;
 
 sub handleHttpRequest($$$$) {
    my $params = shift;         
    my $request = shift;
    my $responseCode = shift;
    my $responseContent = shift;
    
    if ($responseCode == 200) {
        while (my ($k,$v) = each %$params) {
            print "$k: $v\n";
        }
    }
 }
 
 my $fuzzer = new HTTP::Fuzzer();
 
 # simple use case
 $fuzzer->addService(
    host    => 'http://127.0.0.1',
    url     => '/{path}',
    filter_response_codes => '404',
    handler => \&handleHttpRequest );

 $fuzzer->addFuzzingValue('path', 'admin');
 $fuzzer->addFuzzingValue('path', 'install');
 $fuzzer->run();
 
 # more complicated test case
 $fuzzer->addService(
    method  => 'POST',
    host    => 'http://ws.contoso.com',
    url     => '/books',
    content => '<book><isbn>{isbn}</isbn><title>{title}</title></book>'
    filter_response_codes => '404',
    handler => \&handleHttpRequest );

 $fuzzer->setHttpProxy('http://192.168.1.1:8080');

 my $limit = 1000;
 $fuzzer->addFuzzingValue('isbn', '<a>'x$limit . 'haha' . '</a>'x$limit);
 $fuzzer->addFuzzingValue('isbn', new HTTP::Fuzzer::WordListGenerator(file => 'D:\Tools\Wordlists\books_isbn.txt'));
 $fuzzer->addFuzzingValue('title', '<a>'x$limit . 'haha' . '</a>'x$limit);
 $fuzzer->addFuzzingValue('title', new HTTP::Fuzzer::WordListGenerator(file => 'D:\Tools\Wordlists\books_title.txt'));
 $fuzzer->run();
 
=head2 FUZZING

Fuzzed parameters are to be surrounded by curly brackets, such as C<{isbn}> or
C<{title}>. For every parameter you have to specify at least one value or
a way of generating values, such as word lists, regular expressions, ...

It is not allowed to encapsulate parameters.

=head2 ENCODINGS

Any part of the request can be encoded as needed:

 my $headers = [
    Authorization => 'BASIC BASE64{{username}:{password}}'
 ];
 $fuzzer->addService(
    method  => 'GET',
    host    => 'http://ws.contoso.com',
    url     => '/',
    filter_response_codes => '403',
    headers => $headers,
    handler => \&handleHttpRequest );

All encodings process exactly one argument (eg. C<'{username}:{password}'>,
after substituting the value for C<username> and C<password>).

Currently, the following encodings are available:

=over
=item URLENCODE
=item HTMLENCODE
=item BASE64
=item MD5
=item SHA1
=item XML

You may, if this makes sense to you, encapsulate encodings, such as

 my $url = 'login.php?username=URLENCODE{{username}}&password=URLENCODE{SHA1{{username}:{password}}}';
 
=cut

use strict;
use REST::Client;
use HTTP::Fuzzer::Encoder;
use Data::Dumper;
use Carp::Assert;

use constant {
  E_XML => \&escape_xml,
  E_URI => \&uri_encode,
  E_HTML => \&htmlentities
};

use constant {
    FUZZER_DEBUG   => 0
};

=pod
Running mode:
OFFLINE => the callback function is invocated with all values despite responseCode and responseContent;
the request is not sent

ONLINE =>  send a request and invoke the callback function with request and response parameters
=cut
use constant {
    OFFLINE => 'offline',
    ONLINE  => 'online'
};

sub TRACE {
    print (@_) if(FUZZER_DEBUG);
}

sub extract_params($$) {
    my $self = shift;
    my $svc = shift;
    my @params = ();
    
    # find last parameter and remove it from the string
    while ($svc =~ s/(.*)PARAMETER\{(\w+)\}(.*)/$1$3/) {
        my $param = $2;
        $param =~ m/[a-zA-Z0-9]+/ or die "invalid character in parameter '$param'";
        unshift @params, $param;
    }
    return @params
}

sub combine_values($$$$) {
    my $self = shift;
    my $svc = shift;
    my $dst = shift;
    my $src = shift;
    
    if (@$src == 0) {
        $self->sendRequest($svc, $dst);
        return;
    }
    
    my $param = shift @$src;
    #print STDERR "BEGIN handle $param\n";
    
    my $values = $self->{values}->{$param};
    
    # add all generators as default values
    if (! defined($values)) {
        die "no default values for {$param} found ...\n";
    }
    
    # create combinations of values
    foreach my $value (@$values) {
        if (ref($value) && $value->isa('HTTP::Fuzzer::AbstractGenerator')) {
          my $generator = $value;
          
          # acquire required parameters, to pass it to the generator function
          my %reqs = ();
          for my $req (@{$self->{requirements}->{$param}}) {
              $reqs{$req} = $dst->{$req}
                  or die "unresolved requirement: $param requires $req\n";
          }
          
          $generator->init(%reqs);
          while ($generator->hasNext()) {
              $dst->{$param} = $generator->next();
              assert(defined($dst->{$param}));
              $self->combine_values($svc, $dst, $src);
          }
        } else {
            $dst->{$param} = $value;
            $self->combine_values($svc, $dst, $src);
        }
    }     
    #print STDERR "END handle $param\n";    
    unshift @$src, $param;
}

sub mask_parameters($$) {
    my $self = shift;
    my $template = shift || return '';
    
    if (ref($template) eq 'HASH') {
      while(my($k,$v) = each %$template) {
        $template->{$k} = $self->mask_parameters($v);
      }
      return $template;
    }
    
    my $encodings = join('|', @{$self->{encoder}->get_encodings()}, 'PARAMETER');
    $template = reverse $template;
    $encodings = reverse $encodings; 
    
    $template =~ s/(\}\w+\{)(?!$encodings)/$1RETEMARAP/g;
    
    $template = reverse $template;
    return $template;
}

sub sendRequest($$$) {
    my $self = shift;
    my $svc = shift;
    my $params = shift;
    my @request_params = ();
    my $content = undef;
    my %response = ();
    my $new_svc = $self->{encoder}->apply_all_parameters($svc, $params);
        
    $self->{request_count}++;
    my $client = REST::Client->new(
        host    => $svc->{host},
        cert    => $svc->{cert},
        key     => $svc->{key},
        ca      => $svc->{ca},
        follow  => 1
        );
    $client->getUseragent()->ssl_opts('verify_hostname' => 0);
    if (defined($self->{http_proxy}) && $self->{http_proxy}) {
        $client->getUseragent()->proxy(['http', 'https'], $self->{http_proxy});
    }

    if ($self->{mode} eq ONLINE) {
        $client->request($new_svc->{method},
                         $new_svc->{url},
                         $new_svc->{content},
                         $new_svc->{headers});
        
        # filter unwanted response codes
        if (defined $svc->{filter_response_codes}) {
            return if ($client->responseCode() =~ m/$svc->{filter_response_codes}/o);
        }
        
        $response{responseCode} = $client->responseCode();
        $response{responseContent} = $client->responseContent();
        $response{responseHeader} = $client->responseHeader();
    }
    $svc->{handler}->(
        params  => $params,
        method  => $new_svc->{method},
        host    => $new_svc->{host},
        url     => $new_svc->{url},
        content => $new_svc->{content},
        headers => $new_svc->{headers},
        %response);
}


sub sort_parameters($$) {
    my $self = shift;
    my $parameters = shift;

    my @sorted_parameters = ();
    my %dependants = ();
    my %handled = ();
    
    my $param_count = 0;
    foreach my $param (@$parameters) {
        $dependants{$param} = $self->{requirements}->{$param};
        $param_count++;
    }
    # sort topologically
    while ($param_count > 0) {
        #trace(\%dependants);
        my $removed_key = 0;
        while (my ($param, $reqs) = each %dependants) {
            my $requirement_missing = 0;
            foreach my $requirement (@$reqs) {
                if (length($requirement)>0 && ! exists $handled{$requirement}) {
                    $requirement_missing = 1;
                    last;
                }
            }
            if (not $requirement_missing) {
                push @sorted_parameters, $param;
                $handled{$param} = 1;
                delete $dependants{$param};
                $removed_key = 1;
                $param_count--;
                last;
            }
        }
        #die "unresolvable requirements" if $removed_key == 0;
    }
    return \@sorted_parameters;
}

sub new($) {
    my $class = shift;
    my $self = {
        services    => [],
        defaults    => {},
        engines     => {},
        responses   => {},
        http_proxy  => undef,
        encoder     => new HTTP::Fuzzer::Encoder()
    };
    bless($self, $class);
    return $self;
}

sub setHttpProxy($$) {
    my $self = shift;
    $self->{http_proxy} = shift;
}

sub addService($%) {
    my $self = shift;
    my %args = @_;
    
    my $svc =  {
        method  =>  $args{method} || 'GET',
        host    =>  $args{host},
        url     =>  $self->mask_parameters($args{url}),
        content =>  $self->mask_parameters($args{content}),
        headers =>  $self->mask_parameters($args{headers}) || {},
        url_escape => \&url_escape,
        content_escape => \&escape_xml,
        handler => ($args{handler} or die "required argument missing: 'handler'"),
        filter_response_codes => $args{filter_response_codes},
        requirements => {}};
    push @{$self->{services}}, $svc;
}

sub addRequirement($$$) {
  my $self = shift;
  my $parameter = shift;
  my $requirement = shift;
  
  $self->{requirements}->{$parameter} = [] unless defined($self->{requirements}->{$parameter});
  push @{$self->{requirements}->{$parameter}}, $requirement;
}

sub addFuzzingValue($$$) {
    my $self = shift;
    my $parameter = shift;
    my $value = shift;
    $self->{values}->{$parameter} ||= [];
    push @{$self->{values}->{$parameter}}, $value;
}

sub run($;$) {
    my $self = shift;
    my $mode = shift || ONLINE;
    
    die "invalid mode: '$mode'"
        unless ($mode eq ONLINE || $mode eq OFFLINE);
    
    $self->{mode} = $mode;

    foreach my $svc (@{$self->{services}}) {
        my @params = $self->extract_params($svc->{url});
        if (defined($svc->{content})) {
          push @params, $self->extract_params($svc->{content});
        }
        while (my ($k, $v) = each %{$svc->{headers}}) {
          push @params, $self->extract_params($v);
        }
        my $sorted_parameters = $self->sort_parameters(\@params);
        $self->combine_values($svc, {}, $sorted_parameters);
    }
}
1;