$found++ if $port eq $req_port;
$port = "";
}
else {
my $p;
for $p (split(/,/, $port)) {
$found++, last if $p eq $req_port;
}
}
unless ($found) {
LWP::Debug::debug(" port $port:$req_port does not fit");
next;
}
}
if ($version > 0 && $netscape_only) {
LWP::Debug::debug(" domain $domain applies to " .
"Netscape-style cookies only");
next;
}
LWP::Debug::debug(" it's a match");
# set version number of cookie header.
# XXX: What should it be if multiple matching
# Set-Cookie headers have different versions themselves
if (!$set_ver++) {
if ($version >= 1) {
push(@cval, "\$Version=$version");
}
elsif (!$self->{hide_cookie2}) {
$request->header(Cookie2 => '$Version="1"');
}
}
# do we need to quote the value
if ($val =~ /\W/ && $version) {
$val =~ s/([\\\"])/\\$1/g;
$val = qq("$val");
}
# and finally remember this cookie
push(@cval, "$key=$val");
if ($version >= 1) {
push(@cval, qq(\$Path="$path")) if $path_spec;
push(@cval, qq(\$Domain="$domain")) if $domain =~ /^\./;
if (defined $port) {
my $p = '$Port';
$p .= qq(="$port") if length $port;
push(@cval, $p);
}
}
}
}
} continue {
# Try with a more general domain, alternately stripping
# leading name components and leading dots. When this
# results in a domain with no leading dot, it is for
# Netscape cookie compatibility only:
#
# a.b.c.net Any cookie
# .b.c.net Any cookie
# b.c.net Netscape cookie only
# .c.net Any cookie
if ($domain =~ s/^\.+//) {
$netscape_only = 1;
}
else {
$domain =~ s/[^.]*//;
$netscape_only = 0;
}
}
$request->header(Cookie => join("; ", @cval)) if @cval;
$request;
}
sub extract_cookies
{
my $self = shift;
my $response = shift || return;
my @set = _split_header_words($response->_header("Set-Cookie2"));
my @ns_set = $response->_header("Set-Cookie");
return $response unless @set || @ns_set; # quick exit
my $request = $response->request;
my $url = $request->url;
my $req_host = _host($request, $url);
$req_host = "$req_host.local" unless $req_host =~ /\./;
my $req_port = $url->port;
my $req_path = _url_path($url);
_normalize_path($req_path) if $req_path =~ /%/;
if (@ns_set) {
=2= |