view release on metacpan or  search on metacpan

t/005_modperl.t  view on Meta::CPAN

#!/usr/local/bin/perl
BEGIN
{
    use Test::More;
    use lib './lib';
    use vars qw( $DEBUG $CRYPTX_REQUIRED_VERSION $hostport $host $port $mp_host $proto );
    use constant HAS_APACHE_TEST => $ENV{HAS_APACHE_TEST};
    use constant HAS_SSL => $ENV{HAS_SSL};
    if( HAS_APACHE_TEST )
    {
        use_ok( 'Cookie::Jar' ) || BAIL_OUT( "Unable to load Cookie::Jar" );
        use_ok( 'Apache2::Const', qw( -compile :common :http ) ) || BAIL_OUT( "Unable to load Apache2::Const" );
        require_ok( 'Apache::Test' ) || BAIL_OUT( "Unable to load Apache::Test" );
        use_ok( 'Apache::TestUtil' ) || BAIL_OUT( "Unable to load Apache::TestUtil" );
        use_ok( 'Apache::TestRequest' ) || BAIL_OUT( "Unable to load Apache::TestRequest" );
        use_ok( 'HTTP::Request' ) || BAIL_OUT( "Unable to load HTTP::Request" );
        plan no_plan;
    }
    else
    {
        plan skip_all => 'Not running under modperl';
    }
    # 2021-11-1T167:12:10+0900
    use Test::Time time => 1635754330;
    our $CRYPTX_REQUIRED_VERSION = '0.074';
    our $DEBUG = exists( $ENV{COOKIES_DEBUG} ) ? $ENV{COOKIES_DEBUG} : exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
    our( $hostport, $host, $port, $mp_host, $proto );
    require( "./t/env.pl" ) if( -e( "t/env.pl" ) );
};

BEGIN
{
    if( HAS_APACHE_TEST )
    {
        my $config = Apache::Test::config();
        $hostport = Apache::TestRequest::hostport( $config ) || '';
        ( $host, $port ) = split( ':', ( $hostport ) );
        $mp_host = 'www.example.org';
    }
    $proto = HAS_SSL ? 'https' : 'http';
    diag( "Host: '$host', port '$port'" ) if( $DEBUG );
};

use strict;
use warnings;

subtest 'basic' => sub
{
    my $token = q{eyJleHAiOjE2MzYwNzEwMzksImFsZyI6IkhTMjU2In0.eyJqdGkiOiJkMDg2Zjk0OS1mYWJmLTRiMzgtOTE1ZC1hMDJkNzM0Y2ZmNzAiLCJmaXJzdF9uYW1lIjoiSm9obiIsImlhdCI6MTYzNTk4NDYzOSwiYXpwIjoiNGQ0YWFiYWQtYmJiMy00ODgwLThlM2ItNTA0OWMwZTczNjBlIiwiaXNzIjoiaHR0cHM6...
    # For double authentication cookie scheme for example
    # See: <https://cheatsheetseries.owasp.org/cheatsheets/Cross-Site_Request_Forgery_Prevention_Cheat_Sheet.html#double-submit-cookie>
    my $csrf = q{9849724969dbcffd48c074b894c8fbda14610dc0ae62fac0f78b2aa091216e0b.1635825594};
    my $jar = Cookie::Jar->new( debug => $DEBUG );
    my $ua = Apache::TestRequest->new;
    # To get the fingerprint for the certificate in ./t/server.crt, do:
    # echo "sha1\$$(openssl x509 -noout -in ./t/server.crt -fingerprint -sha1|perl -pE 's/^.*Fingerprint=|(\w{2})(?:\:?|$)/$1/g')"
    $ua->ssl_opts(
        # SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE, 
        # SSL_verify_mode => 0x00
        # verify_hostname => 0,
        SSL_fingerprint => 'sha1$DEE8650E44870896E821AAE4A5A24382174D100E',
        # SSL_version     => 'SSLv3',
        # SSL_verfifycn_name => 'localhost',
    );
    my $req = HTTP::Request->new( 'GET' => "${proto}://${hostport}/tests/test01" );
    $req->header( Host => "${mp_host}:${port}" );
    diag( "Request is: ", $req->as_string ) if( $DEBUG );
    my $resp = $ua->request( $req );
    diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
    is( $resp->code, Apache2::Const::HTTP_OK, 'test01 server' );
    
    my $rv = $jar->extract( $resp ) || do
    {
        diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
    };
    
    # test 2
    $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test02" );
    $req->header( Host => "${mp_host}:${port}" );
    $rv = $jar->add_request_header( $req );
    if( !defined( $rv ) )
    {
        diag( "add_request_header returned an error: ", $jar->error ) if( $DEBUG );
    }
    ok( $rv, 'add_request_header' );
    is( $req->header( 'Cookie' ), "session_token=$token" );
    # Sending back the session cookie
    $resp = $ua->request( $req );
    diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
    is( $resp->code, Apache2::Const::HTTP_OK, 'test02 server' );
    
    $rv = $jar->extract( $resp ) || do
    {
        diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
    };
    ok( $jar->exists( 'csrf_token' => $mp_host ), 'server cookie received' );
    
    # test 3
    $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test03" );
    $req->header( Host => "${mp_host}:${port}" );
    $rv = $jar->add_request_header( $req );
    if( !defined( $rv ) )
    {
        diag( "add_request_header returned an error: ", $jar->error ) if( $DEBUG );
    }

    my $h = $req->header( 'Cookie' );
    like( $h, qr/session_token=${token}/ );
    like( $h, qr/csrf_token=${csrf}/ );
    
    $resp = $ua->request( $req );
    diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
    is( $resp->code, Apache2::Const::HTTP_OK, 'test03 server' );
    
    # test 4
    $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test04" );
    $req->header( Host => "${mp_host}:${port}" );
    $rv = $jar->add_request_header( $req );