package Mojo::UserAgent::CookieJar; use Mojo::Base -base; use Mojo::Cookie::Request; use Mojo::Path; has max_cookie_size => 4096; sub add { my ($self, @cookies) = @_; my $size = $self->max_cookie_size; for my $cookie (@cookies) { # Convert max age to expires if (my $age = $cookie->max_age) { $cookie->expires($age + time) } # Check cookie size next if length($cookie->value // '') > $size; # Replace cookie my $origin = $cookie->origin // ''; next unless my $domain = lc($cookie->domain // $origin); $domain =~ s/^\.//; next unless my $path = $cookie->path; next unless length(my $name = $cookie->name // ''); my $jar = $self->{jar}{$domain} ||= []; @$jar = (grep({_compare($_, $path, $name, $origin)} @$jar), $cookie); } return $self; } sub all { my $jar = shift->{jar}; return map { @{$jar->{$_}} } sort keys %$jar; } sub empty { shift->{jar} = {} } sub extract { my ($self, $tx) = @_; my $url = $tx->req->url; for my $cookie (@{$tx->res->cookies}) { # Validate domain my $host = $url->ihost; my $domain = lc($cookie->domain // $cookie->origin($host)->origin); $domain =~ s/^\.//; next if $host ne $domain && ($host !~ /\Q.$domain\E$/ || $host =~ /\.\d+$/); # Validate path my $path = $cookie->path // $url->path->to_dir->to_abs_string; $path = Mojo::Path->new($path)->trailing_slash(0)->to_abs_string; next unless _path($path, $url->path->to_abs_string); $self->add($cookie->path($path)); } } sub find { my ($self, $url) = @_; return unless my $domain = my $host = $url->ihost; my $path = $url->path->to_abs_string; my @found; while ($domain =~ /[^.]+\.[^.]+|localhost$/) { next unless my $old = $self->{jar}{$domain}; # Grab cookies my $new = $self->{jar}{$domain} = []; for my $cookie (@$old) { next unless $cookie->domain || $host eq $cookie->origin; # Check if cookie has expired my $expires = $cookie->expires; next if $expires && time > ($expires->epoch || 0); push @$new, $cookie; # Taste cookie next if $cookie->secure && $url->protocol ne 'https'; next unless _path($cookie->path, $path); my $name = $cookie->name; my $value = $cookie->value; push @found, Mojo::Cookie::Request->new(name => $name, value => $value); } } # Remove another part continue { $domain =~ s/^[^.]+\.?// } return @found; } sub inject { my ($self, $tx) = @_; return unless keys %{$self->{jar}}; my $req = $tx->req; $req->cookies($self->find($req->url)); } sub _compare { my ($cookie, $path, $name, $origin) = @_; return 1 if $cookie->path ne $path || $cookie->name ne $name; return ($cookie->origin // '') ne $origin; } sub _path { $_[0] eq '/' || $_[0] eq $_[1] || $_[1] =~ m!^\Q$_[0]/! } 1; =encoding utf8 =head1 NAME Mojo::UserAgent::CookieJar - Cookie jar for HTTP user agents =head1 SYNOPSIS use Mojo::UserAgent::CookieJar; # Add response cookies my $jar = Mojo::UserAgent::CookieJar->new; $jar->add( Mojo::Cookie::Response->new( name => 'foo', value => 'bar', domain => 'localhost', path => '/test' ) ); # Find request cookies for my $cookie ($jar->find(Mojo::URL->new('http://localhost/test'))) { say $cookie->name; say $cookie->value; } =head1 DESCRIPTION L is a minimalistic and relaxed cookie jar based on RFC 6265 for L. =head1 ATTRIBUTES L implements the following attributes. =head2 max_cookie_size my $size = $jar->max_cookie_size; $jar = $jar->max_cookie_size(4096); Maximum cookie size in bytes, defaults to C<4096>. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 add $jar = $jar->add(@cookies); Add multiple L objects to the jar. =head2 all my @cookies = $jar->all; Return all L objects that are currently stored in the jar. =head2 empty $jar->empty; Empty the jar. =head2 extract $jar->extract(Mojo::Transaction::HTTP->new); Extract response cookies from transaction. =head2 find my @cookies = $jar->find(Mojo::URL->new); Find L objects in the jar for L object. =head2 inject $jar->inject(Mojo::Transaction::HTTP->new); Inject request cookies into transaction. =head1 SEE ALSO L, L, L. =cut