Cookie
view release on metacpan or search on metacpan
lib/Cookie/Jar.pm view on Meta::CPAN
}
}
sub do
{
my $self = shift( @_ );
my $code = shift( @_ ) || return( $self->error( "No callback code was provided." ) );
return( $self->error( "Callback code provided is not a code." ) ) if( ref( $code ) ne 'CODE' );
my $ref = $self->_cookies->clone;
my $all = $self->new_array;
foreach my $c ( @$ref )
{
next if( !ref( $c ) || !$self->_is_a( $c, 'Cookie' ) );
# try-catch
local $@;
eval
{
local $_ = $c;
my $rv = $code->( $c );
if( !defined( $rv ) )
{
last;
}
elsif( $rv )
{
$all->push( $c );
}
};
if( $@ )
{
return( $self->error( "An unexpected error occurred while calling code reference on cookie named \"", $ref->{ $c }->name, "\": $@" ) );
}
}
return( $all );
}
# NOTE: Should we decrypt or encrypt the cookie jar file?
sub encrypt { return( shift->_set_get_boolean( 'encrypt', @_ ) ); }
sub exists
{
my $self = shift( @_ );
my( $name, $host, $path ) = @_;
$host ||= $self->host || '';
$path //= '';
return( $self->error( "No cookie name was provided to check if it exists." ) ) if( !defined( $name ) || !CORE::length( $name ) );
my $c = $self->get( $name => $host, $path );
return( defined( $c ) ? 1 : 0 );
}
# 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." ) );
}
my $all = Module::Generic::HeaderValue->new_from_multi( [$resp->header( 'Set-Cookie' )], debug => $self->debug, decode => 1 ) ||
return( $self->pass_error( Module::Generic::HeaderValue->error ) );
return( $resp ) unless( $all->length );
$uri || return( $self->error( "No uri set in the response object." ) );
my( $host, $port, $path );
if( $host = $resp->header( 'Host' ) ||
( $resp->request && ( $host = $resp->request->header( 'Host' ) ) ) )
{
if( $host =~ s/:(\d+)$// )
{
$port = $1;
}
$host = lc( $host );
}
else
{
$host = lc( $uri->host );
}
# URI::URL method
if( $uri->can( 'epath' ) )
{
$path = $uri->epath;
}
else
{
# URI::_generic method
$path = $uri->path;
}
$path = '/' unless( CORE::length( $path ) );
$port = $uri->port if( !defined( $port ) || !CORE::length( $port ) );
my $root;
if( $self->_is_ip( $host ) )
{
$root = $host;
}
else
{
my $dom = Cookie::Domain->new || return( $self->pass_error( Cookie::Domain->error ) );
my $res = $dom->stat( $host );
if( !defined( $res ) )
{
return( $self->pass_error( $dom->error ) );
}
# Possibly empty
$root = $res ? $res->domain : '';
}
foreach my $o ( @$all )
{
lib/Cookie/Jar.pm view on Meta::CPAN
{
my $self = shift( @_ );
my $file = $self->file;
if( $self->autosave && $file )
{
my $encrypt = $self->encrypt;
my $type = $self->type;
my $type2sub =
{
json => \&save,
lwp => \&save_as_lwp,
mozilla => \&save_as_mozilla,
netscape => \&save_as_netscape,
};
if( !CORE::exists( $type2sub->{ $type } ) )
{
warn( "Unknown cookie jar type '$type'. This can be either json, lwp or netscape\n" ) if( $self->_warnings_is_enabled );
return;
}
my $unloader = $type2sub->{ $type };
if( $encrypt )
{
$unloader->( $self, $file,
algo => $self->algo,
key => $self->secret,
) || do
{
warn( $self->error, "\n" ) if( $self->_warnings_is_enabled );
};
}
else
{
$unloader->( $self, $file ) || do
{
warn( $self->error, "\n" ) if( $self->_warnings_is_enabled );
};
}
}
};
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
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', '/' );
# set a new Set-Cookie header
$jar->set( 'my-cookie' => $cookie_object );
# Remove cookie from jar
$jar->delete( 'my-cookie' );
# or using the object itself:
$jar->delete( $cookie_object );
# Create and add cookie to jar
$jar->add(
name => 'session',
value => 'lang=en-GB',
path => '/',
secure => 1,
same_site => 'Lax',
) || die( $jar->error );
# or add an existing cookie
$jar->add( $some_cookie_object );
my $c = $jar->make({
name => 'my-cookie',
domain => 'example.com',
value => 'sid1234567',
path => '/',
expires => '+10D',
# or alternatively
maxage => 864000
# to make it exclusively accessible by regular http request and not ajax
http_only => 1,
# should it be used under ssl only?
secure => 1,
});
# Add the Set-Cookie headers
$jar->add_response_header;
# Alternatively, using a HTTP::Response object or equivalent
$jar->add_response_header( $http_response );
$jar->delete( 'some_cookie' );
$jar->do(sub
{
# cookie object is available as $_ or as first argument in @_
});
# For client side
# Takes a HTTP::Response object or equivalent
# Extract cookies from Set-Cookie headers received from server
$jar->extract( $http_response );
# get by domain; by default sort it
my $all = $jar->get_by_domain( 'example.com' );
# Reverse sort
$all = $jar->get_by_domain( 'example.com', sort => 0 );
# Save cookies repository as json
$jar->save( '/some/where/mycookies.json' ) || die( $jar->error );
# Load cookies into jar
$jar->load( '/some/where/mycookies.json' ) || die( $jar->error );
# Save encrypted
$jar->save( '/some/where/mycookies.json',
{
encrypt => 1,
key => $key,
iv => $iv,
algo => 'AES',
}) || die( $jar->error );
# Load cookies from encrypted file
$jar->load( '/some/where/mycookies.json',
{
decrypt => 1,
key => $key,
iv => $iv,
algo => 'AES'
}) || die( $jar->error );
# Merge repository
$jar->merge( $jar2 ) || die( $jar->error );
# For autosave
my $jar = Cookie::Jar->new(
file => '/some/where/cookies.json',
# True by default
autosave => 1,
encrypt => 1,
secret => 'My big secret',
algo => 'AES',
) || die( Cookie::Jar->error );
say "There are ", $jar->length, " cookies in the repository.";
# Take a string from a Set-Cookie header and get a Cookie object
my $c = $jar->extract_one( $cookie_string );
=head1 VERSION
v0.3.4
=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
);
It is also compatible with L<HTTP::Promise>, such as:
use HTTP::Promise;
my $ua = HTTP::Promise->new( cookie_jar => Cookie::Jar->new );
This module does not die upon error, but instead sets an L<error|Module::Generic/error> and returns C<undef> in scalar context or an empty list in list context, so you should always check the return value of a method.
=head1 METHODS
=head2 new
This instantiates a new package object and accepts the following options:
=over 4
=item * C<request>
This is an optional parameter to provide a L<Apache2::RequestRec> object. When provided, it will be used in various methods to get or set cookies from or onto http headers.
package MyApacheHandler;
use Apache2::Request ();
use Cookie::Jar;
sub handler : method
{
my( $class, $r ) = @_;
my $jar = Cookie::Jar->new( $r );
# Load cookies;
$jar->fetch;
$r->log_error( "$class: Found ", $jar->repo->length, " cookies." );
$jar->add(
name => 'session',
value => 'lang=en-GB',
path => '/',
secure => 1,
same_site => 'Lax',
);
# Will use Apache2::RequestRec object to set the Set-Cookie headers
$jar->add_response_header || do
{
$r->log_reason( "Unable to add Set-Cookie to response header: ", $jar->error );
return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
};
# Do some more computing
return( Apache2::Const::OK );
}
=item * C<debug>
Optional. If set with a positive integer, this will activate verbose debugging message
=back
=head2 add
Provided with an hash or hash reference of cookie parameters (see L<Cookie>) and this will create a new L<cookie|Cookie> and add it to the cookie repository.
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
$jar->add(
name => 'session',
value => 'lang=en-GB',
path => '/',
secure => 1,
same_site => 'Lax',
) || die( $jar->error );
# then placing it onto the response header
$jar->add_response_header;
This is the alter ego to L</add_request_header>, in that it performs the equivalent function, but for the server side.
You can optionally provide, as unique argument, an object, such as but not limited to, L<HTTP::Response>, as long as that class supports the C<header> method
Alternatively, if an L<Apache object|Apache2::RequestRec> has been set upon object instantiation or later using the L</request> method, then it will be used to set the outgoing C<Set-Cookie> headers (there is one for every cookie sent).
If no response, nor Apache2 object were set, then this will simply return a list of C<Set-Cookie> in list context, or a string of possibly multiline C<Set-Cookie> headers, or an empty string if there is no cookie found to be sent.
Be careful not to do the following:
# get cookies sent by the HTTP client
$jar->fetch || die( $jar->error );
# set the response headers with the cookies from our repository
$jar->add_response_header;
Why? Well, because L</fetch> retrieves the cookies sent by the HTTP client and store them into the repository. However, cookies sent by the HTTP client only contain the cookie name and value, such as:
GET /my/path/ HTTP/1.1
Host: www.example.org
Cookie: session_token=eyJleHAiOjE2MzYwNzEwMzksImFsZyI6IkhTMjU2In0.eyJqdGkiOiJkMDg2Zjk0OS1mYWJmLTRiMzgtOTE1ZC1hMDJkNzM0Y2ZmNzAiLCJmaXJzdF9uYW1lIjoiSm9obiIsImlhdCI6MTYzNTk4NDYzOSwiYXpwIjoiNGQ0YWFiYWQtYmJiMy00ODgwLThlM2ItNTA0OWMwZTczNjBlIiwiaXNzIjoi...
As you can see, 3 cookies were sent: C<session_token>, C<csrf_token> and C<site_prefs>
So, when L</fetch> creates an object for each one and store them, those cookies have no C<path> value and no other attribute, and when L</add_response_header> is then called, it stringifies the cookies and create a C<Set-Cookie> header for each one, ...
The HTTP client, when receiving those cookies will derive the missing cookie path to be C</my/path>, i.e. the current URI path, and will create a duplicate cookie from the previously stored cookie with the same name for that host, but that had the p...
So you can create a repository and use it to store the cookies sent by the HTTP client using L</fetch>, but in preparation of the server response, either use a separate repository with, for example, C<< my $jar_out = Cookie::Jar->new >> or use L</set...
# Add Set-Cookie header for that cookie, but do not add cookie to repository
$jar->set( $cookie_object );
=head2 algo
String. Sets or gets the algorithm to use when loading or saving the cookie jar.
=head2 autosave
Boolean. Sets or gets the boolean value for automatically saving the cookie jar to the given file specified with L</file>
lib/Cookie/Jar.pm view on Meta::CPAN
return(0);
});
print( "Found cookies: ", $found->map(sub{$_->name})->join( ',' ), "\n" );
=head2 encrypt
Boolean. Sets or gets the boolean value for whether to encrypt or not the cookie jar when saving it, or whether to decrypt it when loading cookies from it.
This defaults to false.
=head2 exists
Given a cookie name, this will check if it exists.
It returns 1 if it does, or 0 if it does not.
=head2 extract
Provided with a response object, such as, but not limited to L<HTTP::Response>, and this will retrieve any cookie sent from the remote server, parse them and add their respective to the repository.
As per the L<rfc6265, section 5.3.11 specifications|https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> if there are duplicate cookies for the same domain and path, only the last one will be retained.
If the cookie received does not contain any C<Domain> specification, then, in line with rfc6265 specifications, it will take the root of the current domain as the default domain value. Since finding out what is the root for a domain name is a non-tri...
=head2 extract_cookies
This is an alias for L</extract> for backward compatibility with L<HTTP::Cookies>
=head2 extract_one
This method takes a cookie string, which can be found in the C<Set-Cookie> header, parse it, and returns a L<Cookie> object if successful, or sets an L<error|Module::Generic/error> and return C<undef> or an empty list depending on the context.
It also takes an hash or hash reference of options.
The following options are supported:
=over 4
=item * C<host>
If provided, it will be used to find out the host's root domain, and to set the cookie object C<domain> property if none is specified in the cookie string.
=item * C<path>
If provided, it will be used to set the cookie object C<path> property.
=item * C<port>
If provided, it will be used to set the cookie object C<port> property.
=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>
If the option C<store> is true (by default it is true), this method will add the fetched cookies to the L<repository|/repo>.
It returns an hash reference of cookie key => L<cookie object|Cookie>
A cookie key is made of the host (possibly empty), the path and the cookie name separated by C<;>
# Cookies added to the repository
$jar->fetch || die( $jar->error );
# Cookies returned, but NOT added to the repository
my $cookies = $jar->fetch || die( $jar->error );
=head2 file
Sets or gets the file path to the cookie jar file.
If provided upon instantiation, and if the file exists on the filesystem and is not empty, C<Cookie::Jar> will load all the cookies from it.
If L</autosave> is set to a true, C<Cookie::Jar> will automatically save all cookies to the specified cookie jar file, possibly encrypting it if L</algo> and L</secret> are set.
=head2 get
Given a cookie name, an optional host and an optional path, this will retrieve its corresponding L<cookie object|Cookie> and return it.
If not found, it will try to return a value with just the cookie name.
If nothing is found, this will return and empty list in list context or C<undef> in scalar context.
You can C<get> multiple cookie object and this method will return a list in list context and the first cookie object found in scalar context.
# Wrong, an undefined returned value here only means there is no such cookie
my $c = $jar->get( 'my-cookie' );
die( $jar->error ) if( !defined( $c ) );
# Correct
my $c = $jar->get( 'my-cookie' ) || die( "No cookie my-cookie found\n" );
# Possibly get multiple cookie object for the same name
my @cookies = $jar->get( 'my_same_name' ) || die( "No cookies my_same_name found\n" );
# or
my @cookies = $jar->get( 'my_same_name' => 'www.example.org', '/private' ) || die( "No cookies my_same_name found\n" );
=head2 get_by_domain
Provided with a host and an optional hash or hash reference of parameters, and this returns an L<array object|Module::Generic::Array> of L<cookie objects|Cookie> matching the domain specified.
If a C<sort> parameter has been provided and its value is true, this will sort the cookies by path alphabetically. If the sort value exists, but is false, this will sort the cookies by path but in a reverse alphabetical order.
By default, the cookies are sorted.
=head2 host
Sets or gets the default host. This is especially useful for cookies repository used on the server side.
( run in 1.238 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )