package Mojo::UserAgent::CookieJar; use Mojo::Base -base; use Mojo::Cookie::Request; use Mojo::File qw(path); use Mojo::Path; use Scalar::Util qw(looks_like_number); has [qw(file ignore)]; has max_cookie_size => 4096; my $COMMENT = "# Netscape HTTP Cookie File\n# This file was generated by Mojolicious! Edit at your own risk.\n\n"; sub add { my ($self, @cookies) = @_; my $size = $self->max_cookie_size; for my $cookie (@cookies) { # Convert max age to expires my $age = $cookie->max_age; $cookie->expires($age <= 0 ? 0 : $age + time) if looks_like_number $age; # Check cookie size next if length($cookie->value // '') > $size; # Replace cookie next unless my $domain = lc($cookie->domain // ''); next unless my $path = $cookie->path; next unless length(my $name = $cookie->name // ''); my $jar = $self->{jar}{$domain} //= []; @$jar = (grep({ _compare($_, $path, $name, $domain) } @$jar), $cookie); } return $self; } sub all { my $jar = shift->{jar}; return [map { @{$jar->{$_}} } sort keys %$jar]; } sub collect { my ($self, $tx) = @_; my $url = $tx->req->url; for my $cookie (@{$tx->res->cookies}) { # Validate domain my $host = lc $url->ihost; $cookie->domain($host)->host_only(1) unless $cookie->domain; my $domain = lc $cookie->domain; if (my $cb = $self->ignore) { next if $cb->($cookie) } 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 empty { my $self = shift; delete $self->{jar}; return $self; } sub find { my ($self, $url) = @_; my @found; my $domain = my $host = lc $url->ihost; my $path = $url->path->to_abs_string; while ($domain) { next unless my $old = $self->{jar}{$domain}; # Grab cookies my $new = $self->{jar}{$domain} = []; for my $cookie (@$old) { next if $cookie->host_only && $host ne $cookie->domain; # Check if cookie has expired if (defined(my $expires = $cookie->expires)) { next if time > $expires } 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 load { my $self = shift; my $file = $self->file; return $self unless $file && -r $file; for my $line (split "\n", path($file)->slurp) { # Prefix used by curl for HttpOnly cookies my $httponly = $line =~ s/^#HttpOnly_// ? 1 : 0; next if $line =~ /^#/; my @values = split "\t", $line; next if @values != 7; $self->add(Mojo::Cookie::Response->new({ domain => $values[0] =~ s/^\.//r, host_only => $values[1] eq 'FALSE' ? 1 : 0, path => $values[2], secure => $values[3] eq 'FALSE' ? 0 : 1, expires => $values[4] eq '0' ? undef : $values[4], name => $values[5], value => $values[6], httponly => $httponly })); } return $self; } sub prepare { my ($self, $tx) = @_; return unless keys %{$self->{jar}}; my $req = $tx->req; $req->cookies(@{$self->find($req->url)}); } sub save { my $self = shift; return $self unless my $file = $self->file; my $final = path($file); my $tmp = path("$file.$$"); $tmp->spew($COMMENT . $self->to_string)->move_to($final); return $self; } sub to_string { my $self = shift; my @lines; for my $cookie (@{$self->all}) { my $line = [ $cookie->domain, $cookie->host_only ? 'FALSE' : 'TRUE', $cookie->path, $cookie->secure ? 'TRUE' : 'FALSE', $cookie->expires // 0, $cookie->name, $cookie->value ]; push @lines, join "\t", @$line; } return join "\n", @lines, ''; } sub _compare { my ($cookie, $path, $name, $domain) = @_; return $cookie->path ne $path || $cookie->name ne $name || $cookie->domain ne $domain; } sub _path { $_[0] eq '/' || $_[0] eq $_[1] || index($_[1], "$_[0]/") == 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 used by L, based on L. =head1 ATTRIBUTES L implements the following attributes. =head2 file my $file = $jar->file; $jar = $jar->file('/home/sri/cookies.txt'); File to L cookies from and L cookies to in Netscape format. Note that this attribute is B and might change without warning! # Save cookies to file $jar->file('cookies.txt')->save; # Empty cookie jar and load cookies from file $jar->file('cookies.txt')->empty->load; =head2 ignore my $ignore = $jar->ignore; $jar = $jar->ignore(sub {...}); A callback used to decide if a cookie should be ignored by L. # Ignore all cookies $jar->ignore(sub { 1 }); # Ignore cookies for domains "com", "net" and "org" $jar->ignore(sub ($cookie) { return undef unless my $domain = $cookie->domain; return $domain eq 'com' || $domain eq 'net' || $domain eq 'org'; }); =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> (4KiB). =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. # Names of all cookies say $_->name for @{$jar->all}; =head2 collect $jar->collect(Mojo::Transaction::HTTP->new); Collect response cookies from transaction. =head2 empty $jar = $jar->empty; Empty the jar. =head2 find my $cookies = $jar->find(Mojo::URL->new); Find L objects in the jar for L object. # Names of all cookies found say $_->name for @{$jar->find(Mojo::URL->new('http://example.com/foo'))}; =head2 load $jar = $jar->load; Load cookies from L. Note that this method is B and might change without warning! =head2 prepare $jar->prepare(Mojo::Transaction::HTTP->new); Prepare request cookies for transaction. =head2 save $jar = $jar->save; Save cookies to L. Note that this method is B and might change without warning! =head2 to_string my $string = $jar->to_string; Stringify cookies in Netscape format. Note that this method is B and might change without warning! =head1 SEE ALSO L, L, L. =cut