add files
|
1 |
package Mojo::UserAgent::CookieJar; |
2 |
use Mojo::Base -base; |
|
3 | ||
4 |
use Mojo::Cookie::Request; |
|
5 |
use Mojo::Path; |
|
6 | ||
7 |
has max_cookie_size => 4096; |
|
8 | ||
9 |
sub add { |
|
10 |
my ($self, @cookies) = @_; |
|
11 | ||
12 |
my $size = $self->max_cookie_size; |
|
13 |
for my $cookie (@cookies) { |
|
14 | ||
15 |
# Convert max age to expires |
|
16 |
if (my $age = $cookie->max_age) { $cookie->expires($age + time) } |
|
17 | ||
18 |
# Check cookie size |
|
19 |
next if length($cookie->value // '') > $size; |
|
20 | ||
21 |
# Replace cookie |
|
22 |
my $origin = $cookie->origin // ''; |
|
23 |
next unless my $domain = lc($cookie->domain // $origin); |
|
24 |
$domain =~ s/^\.//; |
|
25 |
next unless my $path = $cookie->path; |
|
26 |
next unless length(my $name = $cookie->name // ''); |
|
27 |
my $jar = $self->{jar}{$domain} ||= []; |
|
28 |
@$jar = (grep({_compare($_, $path, $name, $origin)} @$jar), $cookie); |
|
29 |
} |
|
30 | ||
31 |
return $self; |
|
32 |
} |
|
33 | ||
34 |
sub all { |
|
35 |
my $jar = shift->{jar}; |
|
36 |
return map { @{$jar->{$_}} } sort keys %$jar; |
|
37 |
} |
|
38 | ||
39 |
sub empty { shift->{jar} = {} } |
|
40 | ||
41 |
sub extract { |
|
42 |
my ($self, $tx) = @_; |
|
43 |
my $url = $tx->req->url; |
|
44 |
for my $cookie (@{$tx->res->cookies}) { |
|
45 | ||
46 |
# Validate domain |
|
47 |
my $host = $url->ihost; |
|
48 |
my $domain = lc($cookie->domain // $cookie->origin($host)->origin); |
|
49 |
$domain =~ s/^\.//; |
|
50 |
next |
|
51 |
if $host ne $domain && ($host !~ /\Q.$domain\E$/ || $host =~ /\.\d+$/); |
|
52 | ||
53 |
# Validate path |
|
54 |
my $path = $cookie->path // $url->path->to_dir->to_abs_string; |
|
55 |
$path = Mojo::Path->new($path)->trailing_slash(0)->to_abs_string; |
|
56 |
next unless _path($path, $url->path->to_abs_string); |
|
57 |
$self->add($cookie->path($path)); |
|
58 |
} |
|
59 |
} |
|
60 | ||
61 |
sub find { |
|
62 |
my ($self, $url) = @_; |
|
63 | ||
64 |
return unless my $domain = my $host = $url->ihost; |
|
65 |
my $path = $url->path->to_abs_string; |
|
66 |
my @found; |
|
67 |
while ($domain =~ /[^.]+\.[^.]+|localhost$/) { |
|
68 |
next unless my $old = $self->{jar}{$domain}; |
|
69 | ||
70 |
# Grab cookies |
|
71 |
my $new = $self->{jar}{$domain} = []; |
|
72 |
for my $cookie (@$old) { |
|
73 |
next unless $cookie->domain || $host eq $cookie->origin; |
|
74 | ||
75 |
# Check if cookie has expired |
|
76 |
my $expires = $cookie->expires; |
|
77 |
next if $expires && time > ($expires->epoch || 0); |
|
78 |
push @$new, $cookie; |
|
79 | ||
80 |
# Taste cookie |
|
81 |
next if $cookie->secure && $url->protocol ne 'https'; |
|
82 |
next unless _path($cookie->path, $path); |
|
83 |
my $name = $cookie->name; |
|
84 |
my $value = $cookie->value; |
|
85 |
push @found, Mojo::Cookie::Request->new(name => $name, value => $value); |
|
86 |
} |
|
87 |
} |
|
88 | ||
89 |
# Remove another part |
|
90 |
continue { $domain =~ s/^[^.]+\.?// } |
|
91 | ||
92 |
return @found; |
|
93 |
} |
|
94 | ||
95 |
sub inject { |
|
96 |
my ($self, $tx) = @_; |
|
97 |
return unless keys %{$self->{jar}}; |
|
98 |
my $req = $tx->req; |
|
99 |
$req->cookies($self->find($req->url)); |
|
100 |
} |
|
101 | ||
102 |
sub _compare { |
|
103 |
my ($cookie, $path, $name, $origin) = @_; |
|
104 |
return 1 if $cookie->path ne $path || $cookie->name ne $name; |
|
105 |
return ($cookie->origin // '') ne $origin; |
|
106 |
} |
|
107 | ||
108 |
sub _path { $_[0] eq '/' || $_[0] eq $_[1] || $_[1] =~ m!^\Q$_[0]/! } |
|
109 | ||
110 |
1; |
|
111 | ||
112 |
=encoding utf8 |
|
113 | ||
114 |
=head1 NAME |
|
115 | ||
116 |
Mojo::UserAgent::CookieJar - Cookie jar for HTTP user agents |
|
117 | ||
118 |
=head1 SYNOPSIS |
|
119 | ||
120 |
use Mojo::UserAgent::CookieJar; |
|
121 | ||
122 |
# Add response cookies |
|
123 |
my $jar = Mojo::UserAgent::CookieJar->new; |
|
124 |
$jar->add( |
|
125 |
Mojo::Cookie::Response->new( |
|
126 |
name => 'foo', |
|
127 |
value => 'bar', |
|
128 |
domain => 'localhost', |
|
129 |
path => '/test' |
|
130 |
) |
|
131 |
); |
|
132 | ||
133 |
# Find request cookies |
|
134 |
for my $cookie ($jar->find(Mojo::URL->new('http://localhost/test'))) { |
|
135 |
say $cookie->name; |
|
136 |
say $cookie->value; |
|
137 |
} |
|
138 | ||
139 |
=head1 DESCRIPTION |
|
140 | ||
141 |
L<Mojo::UserAgent::CookieJar> is a minimalistic and relaxed cookie jar based |
|
142 |
on RFC 6265 for L<Mojo::UserAgent>. |
|
143 | ||
144 |
=head1 ATTRIBUTES |
|
145 | ||
146 |
L<Mojo::UserAgent::CookieJar> implements the following attributes. |
|
147 | ||
148 |
=head2 max_cookie_size |
|
149 | ||
150 |
my $size = $jar->max_cookie_size; |
|
151 |
$jar = $jar->max_cookie_size(4096); |
|
152 | ||
153 |
Maximum cookie size in bytes, defaults to C<4096>. |
|
154 | ||
155 |
=head1 METHODS |
|
156 | ||
157 |
L<Mojo::UserAgent::CookieJar> inherits all methods from L<Mojo::Base> and |
|
158 |
implements the following new ones. |
|
159 | ||
160 |
=head2 add |
|
161 | ||
162 |
$jar = $jar->add(@cookies); |
|
163 | ||
164 |
Add multiple L<Mojo::Cookie::Response> objects to the jar. |
|
165 | ||
166 |
=head2 all |
|
167 | ||
168 |
my @cookies = $jar->all; |
|
169 | ||
170 |
Return all L<Mojo::Cookie::Response> objects that are currently stored in the |
|
171 |
jar. |
|
172 | ||
173 |
=head2 empty |
|
174 | ||
175 |
$jar->empty; |
|
176 | ||
177 |
Empty the jar. |
|
178 | ||
179 |
=head2 extract |
|
180 | ||
181 |
$jar->extract(Mojo::Transaction::HTTP->new); |
|
182 | ||
183 |
Extract response cookies from transaction. |
|
184 | ||
185 |
=head2 find |
|
186 | ||
187 |
my @cookies = $jar->find(Mojo::URL->new); |
|
188 | ||
189 |
Find L<Mojo::Cookie::Request> objects in the jar for L<Mojo::URL> object. |
|
190 | ||
191 |
=head2 inject |
|
192 | ||
193 |
$jar->inject(Mojo::Transaction::HTTP->new); |
|
194 | ||
195 |
Inject request cookies into transaction. |
|
196 | ||
197 |
=head1 SEE ALSO |
|
198 | ||
199 |
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. |
|
200 | ||
201 |
=cut |