The extract_cookies method of HTTP::Cookies used to ignore all Set-Cookie
headers if there was any Set-Cookie2 headers in the response. This was wrong.
Only Set-Cookie headers that reference the same cookie as a Set-Cookie2
header was to be ignored. This is a patch fixes that problem.
Regards,
Gisle
Index: lib/HTTP/Cookies.pm
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/lib/HTTP/Cookies.pm,v
retrieving revision 1.16
diff -u -p -u -r1.16 Cookies.pm
--- lib/HTTP/Cookies.pm 2001/04/04 17:30:44 1.16
+++ lib/HTTP/Cookies.pm 2001/07/20 20:03:54
@@ -240,14 +240,12 @@ sub extract_cookies
{
my $self = shift;
my $response = shift || return;
+
my @set = split_header_words($response->_header("Set-Cookie2"));
- my $netscape_cookies;
- unless (@set) {
- @set = $response->_header("Set-Cookie");
- return $response unless @set;
- $netscape_cookies++;
- }
+ my @ns_set = $response->_header("Set-Cookie");
+ return $response unless @set || @ns_set; # quick exit
+
my $url = $response->request->url;
my $req_host = $url->host;
$req_host = "$req_host.local" unless $req_host =~ /\./;
@@ -255,16 +253,23 @@ sub extract_cookies
my $req_path = _url_path($url);
_normalize_path($req_path) if $req_path =~ /%/;
- if ($netscape_cookies) {
+ if (@ns_set) {
# The old Netscape cookie format for Set-Cookie
# http://www.netscape.com/newsref/std/cookie_spec.html
# can for instance contain an unquoted "," in the expires
# field, so we have to use this ad-hoc parser.
my $now = time();
- my @old = @set;
- @set = ();
+
+ # Build a hash of cookies that was present in Set-Cookie2
+ # headers. We need to skip them if we also find them in a
+ # Set-Cookie header.
+ my %in_set2;
+ for (@set) {
+ $in_set2{$_->[0]}++;
+ }
+
my $set;
- for $set (@old) {
+ for $set (@ns_set) {
my @cur;
my $param;
my $expires;
@@ -282,9 +287,12 @@ sub extract_cookies
push(@cur, $k => $v);
}
}
+ next if $in_set2{$cur[0]};
+
# push(@cur, "Port" => $req_port);
push(@cur, "Discard" => undef) unless $expires;
push(@cur, "Version" => 0);
+ push(@cur, "ns-cookie" => 1);
push(@set, \@cur);
}
}
@@ -319,6 +327,7 @@ sub extract_cookies
my $discard = delete $hash{discard};
my $secure = delete $hash{secure};
my $maxage = delete $hash{'max-age'};
+ my $ns_cookie = delete $hash{'ns-cookie'};
# Check domain
my $domain = delete $hash{domain};
@@ -338,7 +347,7 @@ sub extract_cookies
next SET_COOKIE;
}
my $hostpre = substr($req_host, 0, length($req_host) - $len);
- if ($hostpre =~ /\./ && !$netscape_cookies) {
+ if ($hostpre =~ /\./ && !$ns_cookie) {
LWP::Debug::debug("Host prefix contain a dot: $hostpre => $domain");
next SET_COOKIE;
}
@@ -351,7 +360,7 @@ sub extract_cookies
if (defined $path && $path ne '') {
$path_spec++;
_normalize_path($path) if $path =~ /%/;
- if (!$netscape_cookies &&
+ 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;
Index: t/base/cookies.t
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/t/base/cookies.t,v
retrieving revision 1.9
diff -u -p -u -r1.9 cookies.t
--- t/base/cookies.t 2001/04/04 17:30:47 1.9
+++ t/base/cookies.t 2001/07/20 20:03:54
@@ -1,4 +1,4 @@
-print "1..34\n";
+print "1..35\n";
#use LWP::Debug '+';
use HTTP::Cookies;
@@ -531,7 +531,40 @@ print "not " unless $req->header("Cookie
$req->header("Cookie2") eq "\$Version=\"1\"";
print "ok 34\n";
+# test mixing of Set-Cookie and Set-Cookie2 headers.
+# Example from http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl
+# which gives up these headers:
+#
+# HTTP/1.1 200 OK
+# Connection: close
+# Date: Fri, 20 Jul 2001 19:54:58 GMT
+# Server: Apache/1.3.19 (Unix) ApacheJServ/1.1.2
+# Content-Type: text/html
+# Content-Type: text/html; charset=iso-8859-1
+# Link: </trip/stylesheet.css>; rel="stylesheet"; type="text/css"
+# Servlet-Engine: Tomcat Web Server/3.2.1 (JSP 1.1; Servlet 2.2; Java 1.3.0; SunOS
+5.8 sparc; java.vendor=Sun Microsystems Inc.)
+# Set-Cookie: trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/
+# Set-Cookie: JSESSIONID=fkumjm7nt1.JS24;Path=/trs
+# Set-Cookie2: JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs"
+# Title: TRIP.com Travel - FlightTRACKER
+# X-Meta-Description: Trip.com privacy policy
+# X-Meta-Keywords: privacy policy
+
+$req = HTTP::Request->new('GET',
+'http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl');
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->push_header("Set-Cookie" =>
+qq(trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/));
+$res->push_header("Set-Cookie" => qq(JSESSIONID=fkumjm7nt1.JS24;Path=/trs));
+$res->push_header("Set-Cookie2" =>
+qq(JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs"));
+#print $res->as_string;
+$c = HTTP::Cookies->new; # clear it
+$c->extract_cookies($res);
+print $c->as_string;
+print "not " unless $c->as_string eq <<'EOT'; print "ok 35\n";
+Set-Cookie3: trip.appServer="1111-0000-x-024"; path="/"; domain=".trip.com";
+path_spec; discard; version=0
+Set-Cookie3: JSESSIONID="fkumjm7nt1.JS24"; path="/trs"; domain="www.trip.com";
+path_spec; discard; version=1
+EOT
#-------------------------------------------------------------------
