1 | package Mojo::UserAgent::CookieJar;
|
---|
2 | use Mojo::Base -base;
|
---|
3 |
|
---|
4 | use Mojo::Cookie::Request;
|
---|
5 | use Mojo::Path;
|
---|
6 | use Scalar::Util 'looks_like_number';
|
---|
7 |
|
---|
8 | has 'ignore';
|
---|
9 | has max_cookie_size => 4096;
|
---|
10 |
|
---|
11 | sub add {
|
---|
12 | my ($self, @cookies) = @_;
|
---|
13 |
|
---|
14 | my $size = $self->max_cookie_size;
|
---|
15 | for my $cookie (@cookies) {
|
---|
16 |
|
---|
17 | # Convert max age to expires
|
---|
18 | my $age = $cookie->max_age;
|
---|
19 | $cookie->expires($age <= 0 ? 0 : $age + time) if looks_like_number $age;
|
---|
20 |
|
---|
21 | # Check cookie size
|
---|
22 | next if length($cookie->value // '') > $size;
|
---|
23 |
|
---|
24 | # Replace cookie
|
---|
25 | next unless my $domain = lc($cookie->domain // '');
|
---|
26 | next unless my $path = $cookie->path;
|
---|
27 | next unless length(my $name = $cookie->name // '');
|
---|
28 | my $jar = $self->{jar}{$domain} ||= [];
|
---|
29 | @$jar = (grep({ _compare($_, $path, $name, $domain) } @$jar), $cookie);
|
---|
30 | }
|
---|
31 |
|
---|
32 | return $self;
|
---|
33 | }
|
---|
34 |
|
---|
35 | sub all {
|
---|
36 | my $jar = shift->{jar};
|
---|
37 | return [map { @{$jar->{$_}} } sort keys %$jar];
|
---|
38 | }
|
---|
39 |
|
---|
40 | sub collect {
|
---|
41 | my ($self, $tx) = @_;
|
---|
42 |
|
---|
43 | my $url = $tx->req->url;
|
---|
44 | for my $cookie (@{$tx->res->cookies}) {
|
---|
45 |
|
---|
46 | # Validate domain
|
---|
47 | my $host = lc $url->ihost;
|
---|
48 | $cookie->domain($host)->host_only(1) unless $cookie->domain;
|
---|
49 | my $domain = lc $cookie->domain;
|
---|
50 | if (my $cb = $self->ignore) { next if $cb->($cookie) }
|
---|
51 | next 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 empty { delete shift->{jar} }
|
---|
62 |
|
---|
63 | sub find {
|
---|
64 | my ($self, $url) = @_;
|
---|
65 |
|
---|
66 | my @found;
|
---|
67 | my $domain = my $host = lc $url->ihost;
|
---|
68 | my $path = $url->path->to_abs_string;
|
---|
69 | while ($domain) {
|
---|
70 | next unless my $old = $self->{jar}{$domain};
|
---|
71 |
|
---|
72 | # Grab cookies
|
---|
73 | my $new = $self->{jar}{$domain} = [];
|
---|
74 | for my $cookie (@$old) {
|
---|
75 | next if $cookie->host_only && $host ne $cookie->domain;
|
---|
76 |
|
---|
77 | # Check if cookie has expired
|
---|
78 | if (defined(my $expires = $cookie->expires)) { next if time > $expires }
|
---|
79 | push @$new, $cookie;
|
---|
80 |
|
---|
81 | # Taste cookie
|
---|
82 | next if $cookie->secure && $url->protocol ne 'https';
|
---|
83 | next unless _path($cookie->path, $path);
|
---|
84 | my $name = $cookie->name;
|
---|
85 | my $value = $cookie->value;
|
---|
86 | push @found, Mojo::Cookie::Request->new(name => $name, value => $value);
|
---|
87 | }
|
---|
88 | }
|
---|
89 |
|
---|
90 | # Remove another part
|
---|
91 | continue { $domain =~ s/^[^.]*\.*// }
|
---|
92 |
|
---|
93 | return \@found;
|
---|
94 | }
|
---|
95 |
|
---|
96 | sub prepare {
|
---|
97 | my ($self, $tx) = @_;
|
---|
98 | return unless keys %{$self->{jar}};
|
---|
99 | my $req = $tx->req;
|
---|
100 | $req->cookies(@{$self->find($req->url)});
|
---|
101 | }
|
---|
102 |
|
---|
103 | sub _compare {
|
---|
104 | my ($cookie, $path, $name, $domain) = @_;
|
---|
105 | return
|
---|
106 | $cookie->path ne $path
|
---|
107 | || $cookie->name ne $name
|
---|
108 | || $cookie->domain ne $domain;
|
---|
109 | }
|
---|
110 |
|
---|
111 | sub _path { $_[0] eq '/' || $_[0] eq $_[1] || index($_[1], "$_[0]/") == 0 }
|
---|
112 |
|
---|
113 | 1;
|
---|
114 |
|
---|
115 | =encoding utf8
|
---|
116 |
|
---|
117 | =head1 NAME
|
---|
118 |
|
---|
119 | Mojo::UserAgent::CookieJar - Cookie jar for HTTP user agents
|
---|
120 |
|
---|
121 | =head1 SYNOPSIS
|
---|
122 |
|
---|
123 | use Mojo::UserAgent::CookieJar;
|
---|
124 |
|
---|
125 | # Add response cookies
|
---|
126 | my $jar = Mojo::UserAgent::CookieJar->new;
|
---|
127 | $jar->add(
|
---|
128 | Mojo::Cookie::Response->new(
|
---|
129 | name => 'foo',
|
---|
130 | value => 'bar',
|
---|
131 | domain => 'localhost',
|
---|
132 | path => '/test'
|
---|
133 | )
|
---|
134 | );
|
---|
135 |
|
---|
136 | # Find request cookies
|
---|
137 | for my $cookie (@{$jar->find(Mojo::URL->new('http://localhost/test'))}) {
|
---|
138 | say $cookie->name;
|
---|
139 | say $cookie->value;
|
---|
140 | }
|
---|
141 |
|
---|
142 | =head1 DESCRIPTION
|
---|
143 |
|
---|
144 | L<Mojo::UserAgent::CookieJar> is a minimalistic and relaxed cookie jar used by
|
---|
145 | L<Mojo::UserAgent>, based on L<RFC 6265|http://tools.ietf.org/html/rfc6265>.
|
---|
146 |
|
---|
147 | =head1 ATTRIBUTES
|
---|
148 |
|
---|
149 | L<Mojo::UserAgent::CookieJar> implements the following attributes.
|
---|
150 |
|
---|
151 | =head2 ignore
|
---|
152 |
|
---|
153 | my $ignore = $jar->ignore;
|
---|
154 | $jar = $jar->ignore(sub {...});
|
---|
155 |
|
---|
156 | A callback used to decide if a cookie should be ignored by L</"collect">.
|
---|
157 |
|
---|
158 | # Ignore all cookies
|
---|
159 | $jar->ignore(sub { 1 });
|
---|
160 |
|
---|
161 | # Ignore cookies for domains "com", "net" and "org"
|
---|
162 | $jar->ignore(sub {
|
---|
163 | my $cookie = shift;
|
---|
164 | return undef unless my $domain = $cookie->domain;
|
---|
165 | return $domain eq 'com' || $domain eq 'net' || $domain eq 'org';
|
---|
166 | });
|
---|
167 |
|
---|
168 | =head2 max_cookie_size
|
---|
169 |
|
---|
170 | my $size = $jar->max_cookie_size;
|
---|
171 | $jar = $jar->max_cookie_size(4096);
|
---|
172 |
|
---|
173 | Maximum cookie size in bytes, defaults to C<4096> (4KiB).
|
---|
174 |
|
---|
175 | =head1 METHODS
|
---|
176 |
|
---|
177 | L<Mojo::UserAgent::CookieJar> inherits all methods from L<Mojo::Base> and
|
---|
178 | implements the following new ones.
|
---|
179 |
|
---|
180 | =head2 add
|
---|
181 |
|
---|
182 | $jar = $jar->add(@cookies);
|
---|
183 |
|
---|
184 | Add multiple L<Mojo::Cookie::Response> objects to the jar.
|
---|
185 |
|
---|
186 | =head2 all
|
---|
187 |
|
---|
188 | my $cookies = $jar->all;
|
---|
189 |
|
---|
190 | Return all L<Mojo::Cookie::Response> objects that are currently stored in the
|
---|
191 | jar.
|
---|
192 |
|
---|
193 | # Names of all cookies
|
---|
194 | say $_->name for @{$jar->all};
|
---|
195 |
|
---|
196 | =head2 collect
|
---|
197 |
|
---|
198 | $jar->collect(Mojo::Transaction::HTTP->new);
|
---|
199 |
|
---|
200 | Collect response cookies from transaction.
|
---|
201 |
|
---|
202 | =head2 empty
|
---|
203 |
|
---|
204 | $jar->empty;
|
---|
205 |
|
---|
206 | Empty the jar.
|
---|
207 |
|
---|
208 | =head2 find
|
---|
209 |
|
---|
210 | my $cookies = $jar->find(Mojo::URL->new);
|
---|
211 |
|
---|
212 | Find L<Mojo::Cookie::Request> objects in the jar for L<Mojo::URL> object.
|
---|
213 |
|
---|
214 | # Names of all cookies found
|
---|
215 | say $_->name for @{$jar->find(Mojo::URL->new('http://example.com/foo'))};
|
---|
216 |
|
---|
217 | =head2 prepare
|
---|
218 |
|
---|
219 | $jar->prepare(Mojo::Transaction::HTTP->new);
|
---|
220 |
|
---|
221 | Prepare request cookies for transaction.
|
---|
222 |
|
---|
223 | =head1 SEE ALSO
|
---|
224 |
|
---|
225 | L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
---|
226 |
|
---|
227 | =cut
|
---|