lw.pm

一个用perl写的功能强大的cgi漏洞检测程序

need to do more advanced things like set other multipart form

parameters, send multiple files, etc, then you will need to use the

normal API to do it yourself.



=cut



sub upload_file {

	my ($URL, $filepath, $paramname, $hr)=@_;



	return undef if(length($URL)      ==0);

	return undef if(length($filepath) ==0);

	return undef if(length($paramname)==0);

	return undef if(!(-e $filepath && -f $filepath));



	my (%req,%resp,%multi);

	my $rptr;



	if(defined $hr && ref($hr)){

		$rptr=$hr;

	} else {

		$rptr=\%req;

		LW::http_init_request(\%req);

	}



	LW::utils_split_uri($URL,$rptr); # this is newer >=1.1 syntax

	$rptr{'whisker'}->{'method'}='POST';

	LW::http_fixup_request($rptr);



	LW::multipart_setfile(\%multi,$filepath,$paramname);

	LW::multipart_write(\%multi,$rptr);



	if(http_do_request($rptr,\%resp)){

		return undef;

	}



	return $resp{'whisker'}->{'code'};

}



########################################################################



=pod



=head1 - Function: LW::download_file

  

Params: $url, $filepath [, \%hin_request]

Return: $code ($code will be set to undef on error)



LW::download_file is just an alias for LW::get_page_to_file().



=cut



sub download_file {

	goto &LW::get_page_to_file;

}



########################################################################





=pod    



=head1 ++ Sub package: encode



Various type encodings.  Installing MIME::Base64 will result in a 

compiled C version of base64 functions, which means they will be tons 

faster.  This is useful if you're going to run a Basic authentication 

brute force, which requires a high processing speed.  However, it's not 

required, since I include a Perl version, which is slower.



=cut



########################################################################



=pod    



=head1 - Function: LW::encode_base64

  

Params: $data, $eol

Return: $base64_encoded_data

        

LW::encode_base64 is a stub function which will choose the fastest

function available for doing base64 encoding.  This is done by checking to

see if the MIME::Base64 perl module is available (which uses fast C

routines).  If it's not, then it defaults to a perl version (which is

slower).  You can call the perl version direct, but I suggest using the

stub to gain speed advantages where possible.



=cut



#sub encode_base64;





########################################################################



=pod    



=head1 - Function: LW::decode_base64

  

Params: $data

Return: $base64_decoded_data

        

LW::decode_base64 is a stub function which will choose the fastest

function available for doing base64 decoding.  This is done by checking to

see if the MIME::Base64 perl module is available (which uses fast C

routines).  If it's not, then it defaults to a perl version (which is

slower).  You can call the perl version direct, but I suggest using the

stub to gain speed advantages where possible.



=cut



#sub decode_base64;





########################################################################



=pod    



=head1 - Function: LW::encode_base64_perl

        

Params: $data, $eol

Return: $b64_encoded_data



A perl implementation of base64 encoding.  I recommend you use

LW::encode_base64 instead, since it may use the MIME::Base64 module (if

available), which lead to speed advantages.  The perl code for this

function was actually taken from an older MIME::Base64 perl module, and

bears the following copyright:



Copyright 1995-1999 Gisle Aas <[e-mail]>



NOTE: the $eol parameter will be inserted every 76 characters.  This is

used to format the data for output on a 80 character wide terminal.



=cut



sub encode_base64_perl { # ripped from MIME::Base64

    my $res = "";

    my $eol = $_[1];

    $eol = "\n" unless defined $eol;

    pos($_[0]) = 0;

    while ($_[0] =~ /(.{1,45})/gs) {

        $res .= substr(pack('u', $1), 1);

        chop($res);}

    $res =~ tr|` -_|AA-Za-z0-9+/|;

    my $padding = (3 - length($_[0]) % 3) % 3;

    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;

    if (length $eol) {

        $res =~ s/(.{1,76})/$1$eol/g;

    } $res; }





########################################################################



=pod    



=head1 - Function: LW::decode_base64_perl

  

Params: $data

Return: $b64_decoded_data



A perl implementation of base64 decoding.  The perl code for this function

was actually taken from an older MIME::Base64 perl module, and bears the 

following copyright:



Copyright 1995-1999 Gisle Aas <[e-mail]>



=cut



sub decode_base64_perl { # ripped from MIME::Base64

    my $str = shift;

    my $res = "";

    $str =~ tr|A-Za-z0-9+=/||cd;

    $str =~ s/=+$//;                        # remove padding

    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format

    while ($str =~ /(.{1,60})/gs) {

        my $len = chr(32 + length($1)*3/4); # compute length byte

        $res .= unpack("u", $len . $1 );    # uudecode

    }$res;}





########################################################################



=pod    



=head1 - Function: LW::encode_str2uri

  

Params: $data

Return: $result



This function encodes every character (except the / character) with normal 

URL hex encoding.



=cut



sub encode_str2uri { # normal hex encoding

	my $str=shift;

	$str=~s/([^\/])/sprintf("%%%02x",ord($1))/ge;

	return $str;}





#########################################################################



=pod    



=head1 - Function: LW::encode_str2ruri

  

Params: $data

Return: $result



This function randomly encodes characters (except the / character) with 

normal URL hex encoding.



=cut



sub encode_str2ruri { # random normal hex encoding

    my @T=split(//,shift);

    my $s;

    foreach (@T) {

     if(m#;=:&@\?#){

        $s.=$_;

        next;

      }

      if((rand()*2)%2 == 1){	$s.=sprintf("%%%02x",ord($_)) ;

      }else{			$s.=$_; }

    }

    return $s;

}



#########################################################################



=pod    



=head1 - Function: LW::encode_unicode

  

Params: $data

Return: $result



This function converts a normal string into Windows unicode format.



=cut



sub encode_unicode

{

	my $r='';

 	foreach $c (split(//,shift)){

		$r.=pack("v",ord($c));

	}

	return $r;

}



#########################################################################

=pod



=head1 ++ Sub package: forms



This subpackage contains various routines to parse and handle HTML forms.  

The goal is to parse the variable, human-readable HTML into concrete

structures useable by your program.  The forms package does do a good job

at making these structures, but I will admit: they are not exactly simple,

and thus not a cinch to work with.  But then again, representing something

as complex as a HTML form is not a simple thing either.  I think the

results are acceptable for what's trying to be done.  Anyways...



Forms are stored in perl hashes, with elements in the following format:



	$form{'element_name'}=@([ 'type', 'value', @params ])



Thus every element in the hash is an array of anonymous arrays.  The first

array value contains the element type (which is 'select', 'textarea',

'button', or an 'input' value of the form 'input-text', 'input-hidden',

'input-radio', etc).



The second value is the value, if applicable (it could be undef if no

value was specified).  Note that select elements will always have an undef

value--the actual values are in the subsequent options elements.



The third value, if defined, is an anonymous array of additional tag

parameters found in the element (like 'onchange="blah"', 'size="20"',

'maxlength="40"', 'selected', etc).



The array does contain one special element, which is stored in the hash

under a NULL character ("\0") key.  This element is of the format:



	$form{"\0"}=['name', 'method', 'action', @parameters];



The element is an anonymous array that contains strings of the form's

name, method, and action (values can be undef), and a @parameters array

similar to that found in normal elements (above).



Accessing individual values stored in the form hash becomes a test of your

perl referencing skills.  Hint: to access the 'value' of the third element

named 'choices', you would need to do:



	$form{'choices'}->[2]->[1];



The '[2]' is the third element (normal array starts with 0), and the

actual value is '[1]' (the type is '[0]', and the parameter array is

'[2]').



=cut



################################################################



=pod



=head1 - Function: LW::forms_read

  

Params: \$html_data

Return: @found_forms



This function parses the given $html_data into libwhisker form hashes.  

It returns an array of hash references to the found forms.



=cut



sub forms_read {

	my $dr=shift;

	return undef if(!ref($dr) || length($$dr)==0);



	@LW::forms_found=();

	LW::html_find_tags($dr,\&forms_parse_callback);



	if(scalar %LW::forms_current){

		my %DUP=%LW::forms_current;

		push(@LW::forms_found,\%DUP);

	}

	return @LW::forms_found;

}



################################################################



=pod



=head1 - Function: LW::forms_write

  

Params: \%form_hash

Return: $html_of_form   [undef on error]



This function will take the given %form hash and compose a generic HTML

representation of it, formatted with tabs and newlines in order to make it

neat and tidy for printing.



Note: this function does *not* escape any special characters that were

embedded in the element values.



=cut



sub forms_write {

	my $hr=shift;

	return undef if(!ref($hr) || !(scalar %$hr));

	return undef if(!defined $$hr{"\0"});

	

	my $t='<form name="'.$$hr{"\0"}->[0].'" method="';

	$t.=$$hr{"\0"}->[1].'" action="'.$$hr{"\0"}->[2].'"';

	if(defined $$hr{"\0"}->[3]){

		$t.=' '.join(' ',@{$$hr{"\0"}->[3]}); }

	$t.=">\n";



	while( my($name,$ar)=each(%$hr) ){

	  next if($name eq "\0");

	  foreach $a (@$ar){

		my $P='';

		$P=' '.join(' ', @{$$a[2]}) if(defined $$a[2]);

		$t.="\t";



		if($$a[0] eq 'textarea'){

			$t.="<textarea name=\"$name\"$P>$$a[1]";

			$t.="</textarea>\n";



		} elsif($$a[0]=~m/^input-(.+)$/){

			$t.="<input type=\"$1\" name=\"$name\" ";

			$t.="value=\"$$a[1]\"$P>\n";



		} elsif($$a[0] eq 'option'){

			$t.="\t<option value=\"$$a[1]\"$P>$$a[1]\n";



		} elsif($$a[0] eq 'select'){

			$t.="<select name=\"$name\"$P>\n";



		} elsif($$a[0] eq '/select'){

			$t.="</select$P>\n";



		} else { # button

			$t.="<button name=\"$name\" value=\"$$a[1]\">\n";

		}

	  }

	}



	$t.="</form>\n";

	return $t;

}



################################################################





=pod



=head1 - Function: LW::forms_parse_html (INTERNAL)

  

Params: $TAG, \%elements, \$html_data, $offset, $len

Return: nothing



This is an &html_find_tags callback used to parse HTML into form hashes.  

You should not call this directly, but instead use &LW::forms_read.



=cut



{ # these are private static variables for &forms_parse_html

%FORMS_ELEMENTS=(	'form'=>1,	'input'=>1,

			'textarea'=>1,	'button'=>1,

			'select'=>1,	'option'=>1,

			'/select'=>1	);

$CURRENT_SELECT=undef;

$UNKNOWNS=0;



sub forms_parse_callback {

	my ($TAG, $hr, $dr, $start, $len)=(lc(shift),@_);

	my ($saveparam, $parr, $key)=(0,undef,'');



	# fastpath shortcut

	return undef if(!defined $FORMS_ELEMENTS{$TAG});

	LW::utils_lowercase_hashkeys($hr) if(scalar %$hr);



	if($TAG eq 'form'){



		if(scalar %LW::forms_current){ # save last form

			my %DUP=%LW::forms_current;

			push (@LW::forms_found, \%DUP);

			%LW::forms_current=();

		}



		$LW::forms_current{"\0"}=[$$hr{name},$$hr{method},

			$$hr{action},undef];

		delete $$hr{'name'}; delete $$hr{'method'}; delete $$hr{'action'};

		$key="\0"; $parr=\@{$LW::forms_current{"\0"}};

		$UNKNOWNS=0;



	} elsif($TAG eq 'input'){

		$$hr{type}='text' if(!defined $$hr{type});

		$$hr{name}='unknown'.$UNKNOWNS++ if(!defined $$hr{name});

		$key=$$hr{name};

	

		push( @{$LW::forms_current{$key}}, 

			(['input-'.$$hr{type},$$hr{value},undef]) );

		delete $$hr{'name'}; delete $$hr{'type'}; delete $$hr{'value'};

		$parr=\@{$LW::forms_current{$key}->[-1]};



	} elsif($TAG eq 'select'){

		$$hr{name}='unknown'.$UNKNOWNS++ if(!defined $$hr{name});

		$key=$$hr{name};

		push( @{$LW::forms_current{$key}}, (['select',undef,undef]) );

		$parr=\@{$LW::forms_current{$key}->[-1]};

		$CURRENT_SELECT=$key;

		delete $$hr{name};



	} elsif($TAG eq '/select'){

		push( @{$LW::forms_current{$CURRENT_SELECT}}, 

			(['/select',undef,undef]) );

		$CURRENT_SELECT=undef;

		return undef;



	} elsif($TAG eq 'option'){

		return undef if(!defined $CURRENT_SELECT);

		if(!defined $$hr{value}){

			my $stop=index($$dr,'<',$start+$len);

			return undef if($stop==-1); # MAJOR PUKE

			$$hr{value}=substr($$dr,$start+$len,

				($stop-$start-$len));

			$$hr{value}=~tr/\r\n//d;