view release on metacpan or  search on metacpan

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

    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 );
    if( !defined( $rv ) )
    {
        diag( "add_request_header returned an error: ", $jar->error ) if( $DEBUG );
    }
    $resp = $ua->request( $req );
    diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
    $rv = $jar->extract( $resp ) || do
    {
        diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
    };
    ok( $jar->exists( 'site_prefs' => $mp_host ), 'sites_prefs cookie received' );
    
    # test 5
    $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test05" );
    $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 );
    }
    $resp = $ua->request( $req );
    diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
    $rv = $jar->extract( $resp ) || do
    {
        diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
    };
    is( $resp->code, Apache2::Const::HTTP_OK, 'server received only 2 cookies out of 3' );
    
    # test 6
    $req = HTTP::Request->new( GET => "${proto}://${hostport}/account/test06" );
    $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 );
    }
    $resp = $ua->request( $req );
    diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
    $rv = $jar->extract( $resp ) || do
    {
        diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
    };
    is( $resp->code, Apache2::Const::HTTP_OK, 'server received all 3 cookies' );
    my $csrf_cookie = $jar->get( 'csrf_token' => $mp_host );
    ok( $csrf_cookie, 'found csrf_token cookie' );
    SKIP:
    {
        if( !defined( $csrf_cookie ) )
        {
            skip( "csrf_token cookie not found", 1 );
        }
        ok( $csrf_cookie->is_expired, 'server has expired the csrf cookie' );
        if( $DEBUG && !$csrf_cookie->is_expired )
        {
            diag( "csrf_token cookie is not expired, but it should be. Its expiration timestamp is: '", $csrf_cookie->expires, "' (", overload::StrVal( $csrf_cookie->expires ), ") and its is_expired method returned '", $csrf_cookie->is_expired, "'" )...
        }
    };
    
    $req = HTTP::Request->new( GET => "${proto}://${hostport}/account/" );
    $req->header( Host => "${mp_host}:${port}" );
    # Add them back to the client request object
    $rv = $jar->add_request_header( $req );
    if( !defined( $rv ) )
    {
        diag( "add_request_header returned an error: ", $jar->error ) if( $DEBUG );
    }
    $h = $req->header( 'Cookie' );
    like( $h, qr/session_token=${token}/ );
    # should not be here anymore, because we acknowledged it expired
    unlike( $h, qr/csrf_token=${csrf}/ );
    like( $h, qr/site_prefs=lang%3Den-GB/ );
};

subtest 'encrypted' => sub
{
    SKIP:
    {
        eval( "use Crypt::Cipher ${CRYPTX_REQUIRED_VERSION}" );
        if( $@ )
        {
            skip( "Crypt::Cipher is not installed on your system", 4 );
        }
        my $jar = Cookie::Jar->new( debug => $DEBUG );
        my $ua = Apache::TestRequest->new( cookie_jar => $jar );
        $ua->ssl_opts(
            SSL_fingerprint => 'sha1$DEE8650E44870896E821AAE4A5A24382174D100E',
        );
        
        # test 1
        my $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test07" );
        $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, 'server issued secret cookies' );
        my $c = $jar->get( 'secret_cookie' );
        ok( $c, 'found secret cookie in our repository' );
        if( !defined( $c ) )
        {
            skip( "Cookie secret_cookie not found.", 2 );
        }
        diag( "Secret cookie value is: '", $c->value, "'." ) if( $DEBUG );
        
        # test 2
        # Returning the secret cookie for check
        $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test08" );
        $req->header( Host => "${mp_host}:${port}" );
        diag( "Request is: ", $req->as_string ) if( $DEBUG );
        $resp = $ua->request( $req );
        diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
        is( $resp->code, Apache2::Const::HTTP_OK, 'server received valid encrypted cookie' );
        
        # test 3
        # Altering the secret cookie should yield a failed check
        my $encrypted_val = $c->value;
        # trim it by 1 character to alter its value
        $c->value( $encrypted_val->substr(1) );
        $req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test09" );
        $req->header( Host => "${mp_host}:${port}" );
        diag( "Request is: ", $req->as_string ) if( $DEBUG );
        $resp = $ua->request( $req );
        diag( "Server response is: ", $resp->as_string ) if( $DEBUG );
        is( $resp->code, Apache2::Const::HTTP_OK, 'server failed to decrypt the modified value' );
    };
};

subtest 'signed' => sub
{
    SKIP:
    {
        eval( "use Crypt::Cipher ${CRYPTX_REQUIRED_VERSION}" );