/usr/share/perl5/Mojo/CookieJar.pm is in libmojolicious-perl 2.98+dfsg-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | package Mojo::CookieJar;
use Mojo::Base -base;
use Mojo::Cookie::Request;
has max_cookie_size => 4096;
# "I can't help but feel this is all my fault.
# It was those North Korean fortune cookies - they were so insulting.
# 'You are a coward'
# Nobody wants to hear that after a nice meal.
# Marge, you can't keep blaming yourself.
# Just blame yourself once, then move on."
sub add {
my ($self, @cookies) = @_;
# Add 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 $domain = $cookie->domain;
$domain =~ s/^\.//;
my $path = $cookie->path;
my $name = $cookie->name;
my $jar = $self->{jar}{$domain} ||= [];
@$jar = (grep({$_->path ne $path || $_->name ne $name} @$jar), $cookie);
}
return $self;
}
sub empty { shift->{jar} = {} }
sub extract {
my ($self, $tx) = @_;
my $url = $tx->req->url;
for my $cookie (@{$tx->res->cookies}) {
$cookie->domain($url->host) unless $cookie->domain;
$cookie->path($url->path) unless $cookie->path;
$self->add($cookie);
}
}
# "Dear Homer, IOU one emergency donut.
# Signed Homer.
# Bastard!
# He's always one step ahead."
sub find {
my ($self, $url) = @_;
# Look through the jar
return unless my $domain = $url->host;
my $path = $url->path->to_string || '/';
my @found;
while ($domain =~ /[^.]+\.[^.]+|localhost$/) {
next unless my $old = $self->{jar}{$domain};
# Grab cookies
my $new = $self->{jar}{$domain} = [];
for my $cookie (@$old) {
# 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->scheme ne 'https';
next unless $path =~ /^\Q@{[$cookie->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));
}
1;
=head1 NAME
Mojo::CookieJar - Cookie jar for HTTP 1.1 user agents
=head1 SYNOPSIS
use Mojo::CookieJar;
my $jar = Mojo::CookieJar->new;
=head1 DESCRIPTION
L<Mojo::CookieJar> is a minimalistic and relaxed cookie jar for HTTP 1.1 user
agents.
=head1 ATTRIBUTES
L<Mojo::CookieJar> implements the following attributes.
=head2 C<max_cookie_size>
my $max_cookie_size = $jar->max_cookie_size;
$jar = $jar->max_cookie_size(4096);
Maximum cookie size in bytes, defaults to C<4096>.
=head1 METHODS
L<Mojo::CookieJar> inherits all methods from L<Mojo::Base> and implements the
following new ones.
=head2 C<add>
$jar = $jar->add(@cookies);
Add multiple L<Mojo::Cookie::Response> objects to the jar.
=head2 C<empty>
$jar->empty;
Empty the jar.
=head2 C<extract>
$jar = $jar->extract($tx);
Extract response cookies from transaction.
=head2 C<find>
my @cookies = $jar->find($url);
Find L<Mojo::Cookie::Request> objects in the jar for L<Mojo::URL> object.
=head2 C<inject>
$jar = $jar->inject($tx);
Inject request cookies into transaction.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
=cut
|