HTTP-WebTest

 view release on metacpan or  search on metacpan

lib/HTTP/WebTest/SelfTest.pm  view on Meta::CPAN

=cut

use vars qw(@EXPORT $HOSTNAME $PORT $URL);

@EXPORT = qw($HOSTNAME $PORT $URL
             abs_url
             check_webtest
             read_file write_file
             generate_testfile canonical_output compare_output
             parse_basic_credentials
             start_webserver stop_webserver);

use Algorithm::Diff qw(diff);
use MIME::Base64;
use URI;

use HTTP::WebTest::Utils qw(find_port start_webserver stop_webserver);

=head2 $HOSTNAME

lib/HTTP/WebTest/SelfTest.pm  view on Meta::CPAN

    my @diff = diff([split /\n/, $output1], [split /\n/, $output2]);

    for my $hunk (@diff) {
	for my $diff_str (@$hunk) {
	    printf "%s %03d %s\n", @$diff_str;
	}
    }
}

=head2 parse_basic_credentials($credentials)

Decodes credentials for Basic authorization scheme according RFC2617.

=head3 Returns

Returns user/password pair.

=cut

sub parse_basic_credentials {
    my $credentials = shift;

    return () unless defined $credentials;
    $credentials =~ m|^ \s* Basic \s+ ([A-Za-z0-9+/=]+) \s* $|x;
    my $basic_credentials = $1;
    return () unless defined $basic_credentials;
    my $user_pass = decode_base64($basic_credentials);
    my($user, $password) = $user_pass =~ /^ (.*) : (.*) $/x;
    return () unless defined $password;

    return ($user, $password);
}

=head1 DEPRECATED SUBROUTINES

This module imports in namespace of test script following helper
subroutines but they are deprecated and may be removed in the future

t/02-generic.t  view on Meta::CPAN

    } elsif($path eq '/redirect-show-cookies') {
	my $response = new HTTP::Response(RC_FOUND);
	$response->header(Location => '/show-cookies');

	$connect->send_response($response);
    } elsif($path =~ m|/auth-(\w+)-(\w+)-(\w+)|) {
	my $realm = $1;
	my $user = $2;
	my $password = $3;

	# check if we have good credentials
	my $credentials = $request->header('Authorization');
	my($user1, $password1) = parse_basic_credentials($credentials);
	if(defined($user1) and defined($password1) and
	   $user eq $user1 and $password eq $password1) {
	    # authorization is ok
	    $connect->send_file_response('t/test1.txt');
	} else {
	    # authorization is either missing or wrong
	    my $response = new HTTP::Response(RC_UNAUTHORIZED);
	    $response->header(WWW_Authenticate => "Basic realm=\"$realm\"");

	    $connect->send_response($response);

t/03-proxy.t  view on Meta::CPAN

	return $response;
    };

    if($path eq '/show-url') {
	$connect->send_response($show_url_response->());
    } elsif($path =~ m|/pauth-(\w+)-(\w+)-(\w+)|) {
	my $realm = $1;
	my $user = $2;
	my $password = $3;

	# check if we have good credentials
	my $credentials = $request->header('Proxy-Authorization');
	my($user1, $password1) = parse_basic_credentials($credentials);
	if(defined($user1) and defined($password1) and
	   $user eq $user1 and $password eq $password1) {
	    # authorization is ok
	    $connect->send_response($show_url_response->());
	} else {
	    # authorization is either missing or wrong

	    # create response object
	    my $response = new HTTP::Response(RC_PROXY_AUTHENTICATION_REQUIRED);
	    $response->header(Proxy_Authenticate => "Basic realm=\"$realm\"");