diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm | 87 |
1 files changed, 70 insertions, 17 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm index dcbeba64d27..3aee7b4640b 100644 --- a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm +++ b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm @@ -4,18 +4,14 @@ use strict; use HTTP::Date qw(str2time parse_date time2str); use HTTP::Headers::Util qw(_split_header_words join_header_words); -use vars qw($EPOCH_OFFSET); -our $VERSION = '6.04'; +our $EPOCH_OFFSET; +our $VERSION = '6.08'; # Legacy: because "use "HTTP::Cookies" used be the ONLY way # to load the class HTTP::Cookies::Netscape. require HTTP::Cookies::Netscape; $EPOCH_OFFSET = 0; # difference from Unix epoch -if ($^O eq "MacOS") { - require Time::Local; - $EPOCH_OFFSET = Time::Local::timelocal(0,0,0,1,0,70); -} # A HTTP::Cookies object is a hash. The main attribute is the # COOKIES 3 level hash: $self->{COOKIES}{$domain}{$path}{$key}. @@ -231,7 +227,7 @@ sub extract_cookies my $param; my $expires; my $first_param = 1; - for $param (split(/;\s*/, $set)) { + for $param (@{_split_text($set)}) { next unless length($param); my($k,$v) = split(/\s*=\s*/, $param, 2); if (defined $v) { @@ -430,10 +426,17 @@ sub set_cookie sub save { my $self = shift; - my $file = shift || $self->{'file'} || return; + my %args = ( + file => $self->{'file'}, + ignore_discard => $self->{'ignore_discard'}, + @_ == 1 ? ( file => $_[0] ) : @_ + ); + Carp::croak('Unexpected argument to save method') if keys %args > 2; + my $file = $args{'file'} || return; open(my $fh, '>', $file) or die "Can't open $file: $!"; print {$fh} "#LWP-Cookies-1.0\n"; - print {$fh} $self->as_string(!$self->{ignore_discard}); + print {$fh} $self->as_string(!$args{'ignore_discard'}); + close $fh or die "Can't close $file: $!"; 1; } @@ -620,6 +623,50 @@ sub _normalize_path # so that plain string compare can be used $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg; } +# deals with splitting values by ; and the fact that they could +# be in quotes which can also have escaping. +sub _split_text { + my $val = shift; + my @vals = grep { $_ ne q{} } split(/([;\\"])/, $val); + my @chunks; + # divide it up into chunks to be processed. + my $in_string = 0; + my @current_string; + for(my $i = 0; $i < @vals; $i++) { + my $chunk = $vals[$i]; + if($in_string) { + if($chunk eq q{\\}) { + # don't care about next char probably. + # having said that, probably need to be appending to the chunks + # just dropping this. + $i++; + if($i < @vals) { + push @current_string, $vals[$i]; + } + } elsif($chunk eq q{"}) { + $in_string = 0; + } + else { + push @current_string, $chunk; + } + } else { + if($chunk eq q{"}) { + $in_string = 1; + } + elsif($chunk eq q{;}) { + push @chunks, join(q{}, @current_string); + @current_string = (); + } + else { + push @current_string, $chunk; + } + } + } + push @chunks, join(q{}, @current_string) if @current_string; + s/^\s+// for @chunks; + return \@chunks; +} + 1; =pod @@ -632,7 +679,7 @@ HTTP::Cookies - HTTP cookie jars =head1 VERSION -version 6.04 +version 6.08 =head1 SYNOPSIS @@ -661,8 +708,8 @@ knows about. Cookies are a general mechanism which server side connections can use to both store and retrieve information on the client side of the connection. For more information about cookies refer to -<URL:http://curl.haxx.se/rfc/cookie_spec.html> and -<URL:http://www.cookiecentral.com/>. This module also implements the +L<Cookie Spec|http://curl.haxx.se/rfc/cookie_spec.html> and +L<Cookie Central|http://www.cookiecentral.com>. This module also implements the new style cookies described in L<RFC 2965|https://tools.ietf.org/html/rfc2965>. The two variants of cookies are supposed to be able to coexist happily. @@ -741,18 +788,24 @@ The set_cookie() method updates the state of the $cookie_jar. The $key, $val, $domain, $port and $path arguments are strings. The $path_spec, $secure, $discard arguments are boolean values. The $maxage value is a number indicating number of seconds that this cookie will -live. A value of $maxage <= 0 will delete this cookie. %rest defines -various other attributes like "Comment" and "CommentURL". +live. A value of $maxage <= 0 will delete this cookie. The $version argument +sets the version of the cookie; the default value is 0 ( original Netscape +spec ). Setting $version to another value indicates the RFC to which the +cookie conforms (e.g. version 1 for RFC 2109). %rest defines various other +attributes like "Comment" and "CommentURL". =item $cookie_jar->save =item $cookie_jar->save( $file ) +=item $cookie_jar->save( file => $file, ignore_discard => $ignore_discard ) + This method file saves the state of the $cookie_jar to a file. The state can then be restored later using the load() method. If a filename is not specified we will use the name specified during -construction. If the attribute I<ignore_discard> is set, then we -will even save cookies that are marked to be discarded. +construction. If the $ignore_discard value is true (or not specified, +but attribute I<ignore_discard> was set at cookie jar construction), +then we will even save cookies that are marked to be discarded. The default is to save a sequence of "Set-Cookie3" lines. "Set-Cookie3" is a proprietary LWP format, not known to be compatible @@ -832,7 +885,7 @@ Gisle Aas <gisle@activestate.com> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2002-2017 by Gisle Aas. +This software is copyright (c) 2002-2019 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. |