File Coverage

blib/lib/HTML/XSSLint.pm

Criterion	Covered	Total	%
statement	55	61	90.1
branch	5	10	50.0
condition			n/a
subroutine	14	16	87.5
pod	0	7	0.0
total	74	94	78.7

package HTML::XSSLint;

use strict;
use vars qw($VERSION);
$VERSION = 0.01;

require LWP::UserAgent;
use base qw(LWP::UserAgent);

use Digest::MD5;
use HTML::XSSLint::Result;
use HTML::Form;
use HTTP::Request;
use URI;

sub _croak { require Carp; Carp::croak(@_); }

sub audit {
    my($self, $uri) = @_;
    $uri = URI->new($uri);

    my $request  = HTTP::Request->new(GET => $uri);
    my $response = $self->request($request);
    $response->is_success or _croak("Can't fetch $uri");

    my @forms = HTML::Form->parse($response->content, $uri);
    return wantarray ? (map $self->do_audit($_), @forms) : $self->do_audit($forms[0]);
}

sub do_audit {
    my($self, $form) = @_;
    my $params   = $self->make_params($form->inputs);
    my $request  = $self->fillin_and_click($form, $params);
    my $response = $self->request($request);
    $response->is_success or _croak("Can't fetch " . $form->action);

    my @names = $self->compare($response->content, $params);
    return HTML::XSSLint::Result->new(
	form => $form,
	names => \@names,
    );
}

sub make_params {
    my($self, @inputs) = @_;
    my %params = map {
	my $value = $self->random_string;
	($_->name => "<>$value");
    } grep {
	defined($_->name) && length($_->name)
    } @inputs;
    return \%params;
}

sub random_string {
    my $self = shift;
    return substr(Digest::MD5::md5_hex(rand() . {} . $$ . time), 0, 8);
}

sub fillin_and_click {
    my($self, $form, $params) = @_;
    local *HTML::Form::ListInput::value = \&hf_li_value; # hack it
    for my $name (keys %$params) {
	$form->value($name => $params->{$name});
    }
    return $form->click;
}

sub compare {
    my($self, $html, $params) = @_;
    return grep {
	my $value = $params->{$_};
	$html =~ /$value/;
    } keys %$params;
}

sub hf_li_value {
    my $self = shift;
    my $old = $self->{value};
    $self->{value} = shift if @_;
    $old;
}

1;
__END__