—

              
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;
HideShow 143 lines of Pod
=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<Mojo::UserAgent::CookieJar> is a minimalistic and relaxed cookie jar used by L<Mojo::UserAgent>, based on L<RFC
6265|https://tools.ietf.org/html/rfc6265>.
=head1 ATTRIBUTES
L<Mojo::UserAgent::CookieJar> implements the following attributes.
=head2 file
  my $file = $jar->file;
  $jar     = $jar->file('/home/sri/cookies.txt');
File to L</"load"> cookies from and L</"save"> cookies to in Netscape format. Note that this attribute is
B<EXPERIMENTAL> 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</"collect">.
  # 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<Mojo::UserAgent::CookieJar> inherits all methods from L<Mojo::Base> and implements the following new ones.
=head2 add
  $jar = $jar->add(@cookies);
Add multiple L<Mojo::Cookie::Response> objects to the jar.
=head2 all
  my $cookies = $jar->all;
Return all L<Mojo::Cookie::Response> 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<Mojo::Cookie::Request> objects in the jar for L<Mojo::URL> 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</"file">. Note that this method is B<EXPERIMENTAL> 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</"file">. Note that this method is B<EXPERIMENTAL> and might change without warning!
=head2 to_string
  my $string = $jar->to_string;
Stringify cookies in Netscape format. Note that this method is B<EXPERIMENTAL> and might change without warning!
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
=cut