if ($domain =~ /\.\d+$/) {
LWP::Debug::debug("IP-address $domain illeagal as domain");
next SET_COOKIE;
}
my $len = length($domain);
unless (substr($req_host, -$len) eq $domain) {
LWP::Debug::debug("Domain $domain does not match host $req_host");
next SET_COOKIE;
}
my $hostpre = substr($req_host, 0, length($req_host) - $len);
if ($hostpre =~ /\./ && !$ns_cookie) {
LWP::Debug::debug("Host prefix contain a dot: $hostpre => $domain");
next SET_COOKIE;
}
}
else {
$domain = $req_host;
}
my $path = delete $hash{path};
my $path_spec;
if (defined $path && $path ne '') {
$path_spec++;
_normalize_path($path) if $path =~ /%/;
if (!$ns_cookie &&
substr($req_path, 0, length($path)) ne $path) {
LWP::Debug::debug("Path $path is not a prefix of $req_path");
next SET_COOKIE;
}
}
else {
$path = $req_path;
$path =~ s,/[^/]*$,,;
$path = "/" unless length($path);
}
my $port;
if (exists $hash{port}) {
$port = delete $hash{port};
if (defined $port) {
$port =~ s/\s+//g;
my $found;
for my $p (split(/,/, $port)) {
unless ($p =~ /^\d+$/) {
LWP::Debug::debug("Bad port $port (not numeric)");
next SET_COOKIE;
}
$found++ if $p eq $req_port;
}
unless ($found) {
LWP::Debug::debug("Request port ($req_port) not found in $port");
next SET_COOKIE;
}
}
else {
$port = "_$req_port";
}
}
$self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
if $self->set_cookie_ok(\%orig_hash);
}
$response;
}
sub set_cookie_ok
{
1;
}
sub set_cookie
{
my $self = shift;
my($version,
$key, $val, $path, $domain, $port,
$path_spec, $secure, $maxage, $discard, $rest) = @_;
# path and key can not be empty (key can't start with '$')
return $self if !defined($path) || $path !~ m,^/, ||
!defined($key) || $key =~ m,^\$,;
# ensure legal port
if (defined $port) {
return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
}
my $expires;
if (defined $maxage) {
if ($maxage <= 0) {
delete $self->{COOKIES}{$domain}{$path}{$key};
return $self;
}
$expires = time() + $maxage;
}
$version = 0 unless defined $version;
my @array = ($version, $val,$port,
$path_spec,
$secure, $expires, $discard);
=4= |