Cookie
view release on metacpan or search on metacpan
"version" : "0",
"warnings" : "0"
}
},
"test" : {
"requires" : {
"Bytes::Random::Secure" : "0.29",
"File::Find" : "0",
"File::Spec" : "0",
"File::Which" : "0",
"HTTP::Request" : "6.22",
"HTTP::Response" : "6.22",
"Test::More" : "1.302162",
"Test::Time" : "0",
"open" : "0",
"utf8" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
---
abstract: 'Cookie Object with Encryption or Signature'
author:
- 'Jacques Deguest <jack@deguest.jp>'
build_requires:
Bytes::Random::Secure: '0.29'
ExtUtils::MakeMaker: '0'
File::Find: '0'
File::Spec: '0'
File::Which: '0'
HTTP::Request: '6.22'
HTTP::Response: '6.22'
Test::More: '1.302162'
Test::Time: '0'
open: '0'
utf8: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010'
license: perl
Makefile.PL view on Meta::CPAN
'Wanted' => 'v0.1.0',
},
TEST_REQUIRES =>
{
'open' => 0,
'utf8' => 0,
'Bytes::Random::Secure' => '0.29',
'File::Find' => 0,
'File::Spec' => 0,
'File::Which' => 0,
'HTTP::Request' => '6.22',
'HTTP::Response' => '6.22',
'Test::More' => '1.302162',
'Test::Time' => 0,
},
LICENSE => 'perl_5',
MIN_PERL_VERSION => 'v5.16.0',
(MM->can('signature_target') ? (SIGN => 1) : ()),
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', DIST_CP => 'cp' },
clean => { FILES => 'Cookie-*' },
( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => {
NAME
Cookie::Jar - Cookie Jar Class for Server & Client
SYNOPSIS
use Cookie::Jar;
my $jar = Cookie::Jar->new( request => $r ) ||
die( "An error occurred while trying to get the cookie jar:", Cookie::Jar->error );
# set the default host
$jar->host( 'www.example.com' );
$jar->fetch;
# or using a HTTP::Request object
# Retrieve cookies from Cookie header sent from client
$jar->fetch( request => $http_request );
if( $jar->exists( 'my-cookie' ) )
{
# do something
}
# get the cookie
my $sid = $jar->get( 'my-cookie' );
# get all cookies
my @all = $jar->get( 'my-cookie', 'example.com', '/' );
Jan 2020 12:17:30 GMT
Also APR::Request::Cookie and Apache2::Cookie which is a wrapper around
APR::Request::Cookie return a cookie object that returns the value of
the cookie upon stringification instead of the full "Set-Cookie"
parameters. Clearly they designed it with a bias leaned toward
collecting cookies from the browser.
This module supports modperl and uses a Apache2::RequestRec if provided,
or can use package objects that implement similar interface as
HTTP::Request and HTTP::Response, or if none of those above are
available or provided, this module returns its results as a string.
This module is also compatible with LWP::UserAgent, so you can use like
this:
use LWP::UserAgent;
use Cookie::Jar;
my $ua = LWP::UserAgent->new(
cookie_jar => Cookie::Jar->new
Alternatively, you can also provide directly an existing cookie object
my $c = $jar->add( $cookie_object ) || die( $jar->error );
add_cookie_header
This is an alias for "add_request_header" for backward compatibility
with HTTP::Cookies
add_request_header
Provided with a request object, such as, but not limited to
HTTP::Request and this will add all relevant cookies in the repository
into the "Cookie" http request header. The object method needs to have
the "header" method in order to get, or set the "Cookie" or "Set-Cookie"
headers and the "uri" method.
As long as the object provided supports the "uri" and "header" method,
you can provide any class of object you want.
Please refer to the rfc6265
<https://datatracker.ietf.org/doc/html/rfc6265> for more information on
the applicable rule when adding cookies to the outgoing request header.
This method does the equivalent of "extract", but for the server.
It retrieves all possible cookies from the http request received from
the web browser.
It takes an optional hash or hash reference of parameters, such as
"host". If it is not provided, the value set with "host" is used
instead.
If the parameter "request" containing an http request object, such as,
but not limited to HTTP::Request, is provided, it will use it to get the
"Cookie" header value. The object method needs to have the "header"
method in order to get, or set the "Cookie" or "Set-Cookie" headers.
Alternatively, if a value for "request" has been set, it will use it to
get the "Cookie" header value from Apache modperl.
You can also provide the "Cookie" string to parse by providing the
"string" option to this method.
$jar->fetch( string => q{foo=bar; site_prefs=lang%3Den-GB} ) ||
Cookie::Jar - Cookie Jar Class for Server & Client
# SYNOPSIS
use Cookie::Jar;
my $jar = Cookie::Jar->new( request => $r ) ||
die( "An error occurred while trying to get the cookie jar:", Cookie::Jar->error );
# set the default host
$jar->host( 'www.example.com' );
$jar->fetch;
# or using a HTTP::Request object
# Retrieve cookies from Cookie header sent from client
$jar->fetch( request => $http_request );
if( $jar->exists( 'my-cookie' ) )
{
# do something
}
# get the cookie
my $sid = $jar->get( 'my-cookie' );
# get all cookies
my @all = $jar->get( 'my-cookie', 'example.com', '/' );
v0.3.1
# DESCRIPTION
This is a module to handle [cookies](https://metacpan.org/pod/Cookie), according to the latest standard as set by [rfc6265](https://datatracker.ietf.org/doc/html/rfc6265), both by the http server and the client. Most modules out there are either anti...
For example, Apache2::Cookie does not work well in decoding cookies, and [Cookie::Baker](https://metacpan.org/pod/Cookie%3A%3ABaker) `Set-Cookie` timestamp format is wrong. They use Mon-09-Jan 2020 12:17:30 GMT where it should be, as per rfc 6265 Mon...
Also [APR::Request::Cookie](https://metacpan.org/pod/APR%3A%3ARequest%3A%3ACookie) and [Apache2::Cookie](https://metacpan.org/pod/Apache2%3A%3ACookie) which is a wrapper around [APR::Request::Cookie](https://metacpan.org/pod/APR%3A%3ARequest%3A%3ACoo...
This module supports modperl and uses a [Apache2::RequestRec](https://metacpan.org/pod/Apache2%3A%3ARequestRec) if provided, or can use package objects that implement similar interface as [HTTP::Request](https://metacpan.org/pod/HTTP%3A%3ARequest) an...
This module is also compatible with [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent), so you can use like this:
use LWP::UserAgent;
use Cookie::Jar;
my $ua = LWP::UserAgent->new(
cookie_jar => Cookie::Jar->new
);
Alternatively, you can also provide directly an existing [cookie object](https://metacpan.org/pod/Cookie)
my $c = $jar->add( $cookie_object ) || die( $jar->error );
## add\_cookie\_header
This is an alias for ["add\_request\_header"](#add_request_header) for backward compatibility with [HTTP::Cookies](https://metacpan.org/pod/HTTP%3A%3ACookies)
## add\_request\_header
Provided with a request object, such as, but not limited to [HTTP::Request](https://metacpan.org/pod/HTTP%3A%3ARequest) and this will add all relevant cookies in the repository into the `Cookie` http request header. The object method needs to have th...
As long as the object provided supports the `uri` and `header` method, you can provide any class of object you want.
Please refer to the [rfc6265](https://datatracker.ietf.org/doc/html/rfc6265) for more information on the applicable rule when adding cookies to the outgoing request header.
Basically, it will add, for a given domain, first all cookies whose path is longest and at path equivalent, the cookie creation date is used, with the earliest first. Cookies who have expired are not sent, and there can be cookies bearing the same na...
## add\_response\_header
# Adding cookie to the repository
If provided, it will be used to set the cookie object `port` property.
## fetch
This method does the equivalent of ["extract"](#extract), but for the server.
It retrieves all possible cookies from the http request received from the web browser.
It takes an optional hash or hash reference of parameters, such as `host`. If it is not provided, the value set with ["host"](#host) is used instead.
If the parameter `request` containing an http request object, such as, but not limited to [HTTP::Request](https://metacpan.org/pod/HTTP%3A%3ARequest), is provided, it will use it to get the `Cookie` header value. The object method needs to have the `...
Alternatively, if a value for ["request"](#request) has been set, it will use it to get the `Cookie` header value from Apache modperl.
You can also provide the `Cookie` string to parse by providing the `string` option to this method.
$jar->fetch( string => q{foo=bar; site_prefs=lang%3Den-GB} ) ||
die( $jar->error );
Ultimately, if none of those are available, it will use the environment variable `HTTP_COOKIE`
lib/Cookie/Jar.pm view on Meta::CPAN
# From http client point of view
sub extract
{
my $self = shift( @_ );
my $resp = shift( @_ ) || return( $self->error( "No response object was provided." ) );
return( $self->error( "Response object provided is not an object." ) ) if( !Scalar::Util::blessed( $resp ) );
my $uri;
if( $self->_is_a( $resp, 'HTTP::Response' ) )
{
my $req = $resp->request;
return( $self->error( "No HTTP::Request object is set in this HTTP::Response." ) ) if( !$resp->request );
$uri = $resp->request->uri;
}
elsif( $resp->can( 'uri' ) && $resp->can( 'header' ) )
{
$uri = $resp->uri;
}
else
{
return( $self->error( "Response object provided does not support the uri or scheme methods and is not a class or subclass of HTTP::Response either." ) );
}
lib/Cookie/Jar.pm view on Meta::CPAN
Cookie::Jar - Cookie Jar Class for Server & Client
=head1 SYNOPSIS
use Cookie::Jar;
my $jar = Cookie::Jar->new( request => $r ) ||
die( "An error occurred while trying to get the cookie jar:", Cookie::Jar->error );
# set the default host
$jar->host( 'www.example.com' );
$jar->fetch;
# or using a HTTP::Request object
# Retrieve cookies from Cookie header sent from client
$jar->fetch( request => $http_request );
if( $jar->exists( 'my-cookie' ) )
{
# do something
}
# get the cookie
my $sid = $jar->get( 'my-cookie' );
# get all cookies
my @all = $jar->get( 'my-cookie', 'example.com', '/' );
lib/Cookie/Jar.pm view on Meta::CPAN
v0.3.3
=head1 DESCRIPTION
This is a module to handle L<cookies|Cookie>, according to the latest standard as set by L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265>, both by the http server and the client. Most modules out there are either antiquated, i.e. they do not ...
For example, Apache2::Cookie does not work well in decoding cookies, and L<Cookie::Baker> C<Set-Cookie> timestamp format is wrong. They use Mon-09-Jan 2020 12:17:30 GMT where it should be, as per rfc 6265 Mon, 09 Jan 2020 12:17:30 GMT
Also L<APR::Request::Cookie> and L<Apache2::Cookie> which is a wrapper around L<APR::Request::Cookie> return a cookie object that returns the value of the cookie upon stringification instead of the full C<Set-Cookie> parameters. Clearly they designed...
This module supports modperl and uses a L<Apache2::RequestRec> if provided, or can use package objects that implement similar interface as L<HTTP::Request> and L<HTTP::Response>, or if none of those above are available or provided, this module return...
This module is also compatible with L<LWP::UserAgent>, so you can use like this:
use LWP::UserAgent;
use Cookie::Jar;
my $ua = LWP::UserAgent->new(
cookie_jar => Cookie::Jar->new
);
lib/Cookie/Jar.pm view on Meta::CPAN
Alternatively, you can also provide directly an existing L<cookie object|Cookie>
my $c = $jar->add( $cookie_object ) || die( $jar->error );
=head2 add_cookie_header
This is an alias for L</add_request_header> for backward compatibility with L<HTTP::Cookies>
=head2 add_request_header
Provided with a request object, such as, but not limited to L<HTTP::Request> and this will add all relevant cookies in the repository into the C<Cookie> C<HTTP> request header. The object method needs to have the C<header> method in order to get, or ...
As long as the object provided supports the C<uri> and C<header> method, you can provide any class of object you want.
Please refer to the L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265> for more information on the applicable rule when adding cookies to the outgoing request header.
Basically, it will add, for a given domain, first all cookies whose path is longest and at path equivalent, the cookie creation date is used, with the earliest first. Cookies who have expired are not sent, and there can be cookies bearing the same na...
=head2 add_response_header
# Adding cookie to the repository
lib/Cookie/Jar.pm view on Meta::CPAN
=back
=head2 fetch
This method does the equivalent of L</extract>, but for the server.
It retrieves all possible cookies from the HTTP request received from the web browser.
It takes an optional hash or hash reference of parameters, such as C<host>. If it is not provided, the value set with L</host> is used instead.
If the parameter C<request> containing an HTTP request object, such as, but not limited to L<HTTP::Request>, is provided, it will use it to get the C<Cookie> header value. The object method needs to have the C<header> method in order to get, or set t...
Alternatively, if a value for L</request> has been set, it will use it to get the C<Cookie> header value from Apache modperl.
You can also provide the C<Cookie> string to parse by providing the C<string> option to this method.
$jar->fetch( string => q{foo=bar; site_prefs=lang%3Den-GB} ) ||
die( $jar->error );
Ultimately, if none of those are available, it will use the environment variable C<HTTP_COOKIE>
lib/Cookies.pm view on Meta::CPAN
Cookies - Cookie Jar Class for Server & Client
=head1 SYNOPSIS
use Cookies;
my $jar = Cookies->new( request => $r ) ||
return( $self->error( "An error occurred while trying to get the cookie jar." ) );
# set the default host
$jar->host( 'www.example.com' );
$jar->fetch;
# or using a HTTP::Request object
# Retrieve cookies from Cookie header sent from client
$jar->fetch( request => $http_request );
if( $jar->exists( 'my-cookie' ) )
{
# do something
}
# get the cookie
my $sid = $jar->get( 'my-cookie' );
# get all cookies
my @all = $jar->get( 'my-cookie', 'example.com', '/' );
t/004_cookies.t view on Meta::CPAN
#!perl
BEGIN
{
use strict;
use warnings;
use lib './lib';
use Test::More;
use vars qw( $DEBUG $CRYPTX_REQUIRED_VERSION );
# 2021-11-01T08:12:10
use Test::Time time => 1635754330;
use HTTP::Request ();
use HTTP::Response ();
our $CRYPTX_REQUIRED_VERSION = '0.074';
our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};
BEGIN
{
use_ok( 'Cookie' );
use_ok( 'Cookie::Jar' );
require( "./t/env.pl" ) if( -e( "t/env.pl" ) );
t/004_cookies.t view on Meta::CPAN
}
};
subtest 'cookie jar' => sub
{
$Cookie::Jar::COOKIES_DEBUG = $DEBUG;
# For server repository
my $srv = Cookie::Jar->new( debug => $DEBUG );
# For client repository
my $jar = Cookie::Jar->new( debug => $DEBUG );
my $req = HTTP::Request->new( GET => 'https://www.example.com/' );
$req->header( Host => 'www.example.com' );
my $resp = HTTP::Response->new( 200 => 'OK' );
$resp->request( $req );
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 $rv;
my $session_cookie = $srv->make( name => 'session_token' => value => $token, path => '/', expires => "Monday, 01-Nov-2021 17:12:40 GMT" ) ||
do
t/004_cookies.t view on Meta::CPAN
diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
};
$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" );
$req = HTTP::Request->new( GET => 'https://www.example.com/' );
$req->header( Host => 'www.example.com' );
$resp = HTTP::Response->new( 200 => 'OK' );
$resp->request( $req );
my $csrf_cookie = $srv->make( name => 'csrf_token', value => $csrf, path => '/' ) || do
{
diag( "Unable to create cookie: ", $srv->error ) if( $DEBUG );
};
# $resp->header( 'Set-Cookie' => qq{csrf_token=${csrf}; path=/} );
$rv = $srv->set( $csrf_cookie, response => $resp ) || do
{
diag( "set returned an error: ", $srv->error ) if( $DEBUG );
};
$rv = $jar->extract( $resp ) || do
{
diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
};
$req = HTTP::Request->new( GET => 'https://www.example.com/foo/bar' );
$req->header( Host => 'www.example.com' );
$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}/ );
t/004_cookies.t view on Meta::CPAN
};
$rv = $srv->set( $prefs_cookie, response => $resp ) || do
{
diag( "set returned an error: ", $srv->error ) if( $DEBUG );
};
$rv = $jar->extract( $resp ) || do
{
diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
};
$req = HTTP::Request->new( GET => 'https://www.example.com/' );
$req->header( Host => 'www.example.com' );
$rv = $jar->add_request_header( $req );
if( !defined( $rv ) )
{
diag( "add_request_header returned an error: ", $jar->error ) if( $DEBUG );
}
$h = $req->header( 'Cookie' );
diag( "HTTP request is: ", $req->as_string ) if( $DEBUG );
like( $h, qr/session_token=${token}/ );
like( $h, qr/csrf_token=${csrf}/ );
unlike( $h, qr/site_prefs=lang%3Den-GB/ );
$req = HTTP::Request->new( GET => 'https://www.example.com/account/images/' );
$req->header( Host => 'www.example.com' );
$rv = $jar->add_request_header( $req );
if( !defined( $rv ) )
{
diag( "add_request_header returned an error: ", $jar->error ) if( $DEBUG );
}
$h = $req->header( 'Cookie' );
diag( "HTTP request is: ", $req->as_string ) if( $DEBUG );
like( $h, qr/session_token=${token}/ );
like( $h, qr/csrf_token=${csrf}/ );
t/004_cookies.t view on Meta::CPAN
skip( "Cannot find cookie \"csrf_cookie\".", 3 );
}
$csrf_cookie->elapse;
diag( "Setting cookie csrf_token to expire: ", $csrf_cookie->as_string ) if( $DEBUG );
# Set the Set-Cookie header fields
$rv = $srv->set( $csrf_cookie, response => $resp ) || do
{
diag( "set returned an error: ", $srv->error ) if( $DEBUG );
};
diag( "Response header is now: ", $resp->as_string ) if( $DEBUG );
$req = HTTP::Request->new( GET => 'https://www.example.com/account/' );
$req->header( Host => 'www.example.com' );
$resp->request( $req );
# Extract them
$rv = $jar->extract( $resp ) || do
{
diag( "extract returned an error: ", $jar->error ) if( $DEBUG );
};
# Add them back to the client request object
$rv = $jar->add_request_header( $req );
if( !defined( $rv ) )
t/005_modperl.t view on Meta::CPAN
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;
t/005_modperl.t view on Meta::CPAN
# 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 );
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
{
t/005_modperl.t view on Meta::CPAN
{
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
t/005_modperl.t view on Meta::CPAN
{
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
{
t/005_modperl.t view on Meta::CPAN
{
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/test10" );
$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 a signed cookie' );
my $c = $jar->get( 'signed_cookie' );
ok( $c, 'found signed cookie in our repository' );
if( !defined( $c ) )
{
skip( "Cannot find signed cookie \"signed_cookie\"", 2 );
}
diag( "Signed cookie value is: '", $c->value, "'." ) if( $DEBUG );
# test 2
# Returning the signed cookie for check
$req = HTTP::Request->new( GET => "${proto}://${hostport}/tests/test11" );
$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 signed cookie' );
# test 3
# Altering the signed 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/test12" );
$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 validate the modified value' );
};
};
done_testing();
t/006_cookies_sqlite.t view on Meta::CPAN
BEGIN
{
use strict;
use warnings;
use lib './lib';
use Test::More;
use vars qw( $DEBUG $HAS_DBI $HAS_SQLITE_BIN $SQLITE_BIN );
# 2021-11-01T08:12:10
use Test::Time time => 1635754330;
use File::Which ();
use HTTP::Request ();
use HTTP::Response ();
use Module::Generic::File qw( file );
our $CRYPTX_REQUIRED_VERSION = '0.074';
our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
$DEBUG ||= 4 if( exists( $ENV{AUTOMATED_TESTING} ) );
};
BEGIN
{
require( "./t/env.pl" ) if( -e( "t/env.pl" ) );
t/CookieTest.pm view on Meta::CPAN
<Directory "@documentroot@">
SetHandler modperl
PerlResponseHandler CookieTest
AcceptPathInfo On
</Directory>
In the test unit:
use Apache::Test;
use Apache::TestRequest;
use HTTP::Request;
my $config = Apache::Test::config();
my $hostport = Apache::TestRequest::hostport( $config ) || '';
my $jar = Cookie::Jar->new( debug => $DEBUG );
my $ua = Apache::TestRequest->new;
my $req = HTTP::Request->new( GET => "http://${hostport}/tests/test01" );
$req->header( Host => $hostport );
my $resp = $ua->request( $req );
ok( $resp->content, 'ok' );
=head1 VERSION
v0.1.0
=head1 DESCRIPTION
( run in 0.530 second using v1.01-cache-2.11-cpan-de7293f3b23 )