r45461 - in /trunk/libwww-perl: Changes META.yml debian/changelog lib/HTTP/Cookies.pm lib/LWP.pm lib/LWP/Protocol/http.pm lib/LWP/Protocol/https.pm lib/LWP/UserAgent.pm lib/Net/HTTP.pm lib/Net/HTTP/Methods.pm t/base/cookies.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Wed Oct 7 23:18:55 UTC 2009


Author: jawnsy-guest
Date: Wed Oct  7 23:18:50 2009
New Revision: 45461

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45461
Log:
* New upstream release
  + Mirror will now die of X-Died is set (RT#48236)

Modified:
    trunk/libwww-perl/Changes
    trunk/libwww-perl/META.yml
    trunk/libwww-perl/debian/changelog
    trunk/libwww-perl/lib/HTTP/Cookies.pm
    trunk/libwww-perl/lib/LWP.pm
    trunk/libwww-perl/lib/LWP/Protocol/http.pm
    trunk/libwww-perl/lib/LWP/Protocol/https.pm
    trunk/libwww-perl/lib/LWP/UserAgent.pm
    trunk/libwww-perl/lib/Net/HTTP.pm
    trunk/libwww-perl/lib/Net/HTTP/Methods.pm
    trunk/libwww-perl/t/base/cookies.t

Modified: trunk/libwww-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/Changes?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/Changes (original)
+++ trunk/libwww-perl/Changes Wed Oct  7 23:18:50 2009
@@ -1,3 +1,25 @@
+_______________________________________________________________________________
+2009-10-06  Release 5.833
+
+
+Gisle Aas (5):
+      Deal with cookies that expire far into the future [RT#50147]
+      Deal with cookies that expire at or before epoch [RT#49467]
+      Pass separate type for https to LWP::ConnCache [RT#48899]
+      Improved handling of the User-Agent header [RT#48461]
+      HTTP::Cookies add_cookie_header previous Cookies [RT#46106]
+
+Andreas J. Koenig (1):
+      Improve diagnostics from LWP::UserAgent::mirror [RT#48869]
+
+Slaven Rezic (1):
+      mirror should die in case X-Died is set [RT#48236]
+
+Ville Skyttä (1):
+      Increase default Net::HTTP max line length to 8k.
+
+
+
 _______________________________________________________________________________
 2009-09-21  Release 5.832
 

Modified: trunk/libwww-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/META.yml?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/META.yml (original)
+++ trunk/libwww-perl/META.yml Wed Oct  7 23:18:50 2009
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               libwww-perl
-version:            5.832
+version:            5.833
 abstract:           The World-Wide Web library for Perl
 author:
     - Gisle Aas <gisle at activestate.com>

Modified: trunk/libwww-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/debian/changelog?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/debian/changelog (original)
+++ trunk/libwww-perl/debian/changelog Wed Oct  7 23:18:50 2009
@@ -1,3 +1,10 @@
+libwww-perl (5.833-1) UNRELEASED; urgency=low
+
+  * New upstream release
+    + Mirror will now die of X-Died is set (RT#48236)
+
+ -- Jonathan Yu <jawnsy at cpan.org>  Wed, 07 Oct 2009 15:38:06 -0400
+
 libwww-perl (5.832-1) unstable; urgency=low
 
   [ Jonathan Yu ]

Modified: trunk/libwww-perl/lib/HTTP/Cookies.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/HTTP/Cookies.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/HTTP/Cookies.pm (original)
+++ trunk/libwww-perl/lib/HTTP/Cookies.pm Wed Oct  7 23:18:50 2009
@@ -1,11 +1,11 @@
 package HTTP::Cookies;
 
 use strict;
-use HTTP::Date qw(str2time time2str);
+use HTTP::Date qw(str2time parse_date time2str);
 use HTTP::Headers::Util qw(_split_header_words join_header_words);
 
 use vars qw($VERSION $EPOCH_OFFSET);
-$VERSION = "5.832";
+$VERSION = "5.833";
 
 # Legacy: because "use "HTTP::Cookies" used be the ONLY way
 #  to load the class HTTP::Cookies::Netscape.
@@ -160,7 +160,12 @@
 	}
     }
 
-    $request->header(Cookie => join("; ", @cval)) if @cval;
+    if (@cval) {
+	if (my $old = $request->header("Cookie")) {
+	    unshift(@cval, $old);
+	}
+	$request->header(Cookie => join("; ", @cval));
+    }
 
     $request;
 }
@@ -219,9 +224,26 @@
 		}
 		if (!$first_param && lc($k) eq "expires") {
 		    my $etime = str2time($v);
-		    if ($etime) {
-			push(@cur, "Max-Age" => str2time($v) - $now);
+		    if (defined $etime) {
+			push(@cur, "Max-Age" => $etime - $now);
 			$expires++;
+		    }
+		    else {
+			# parse_date can deal with years outside the range of time_t,
+			my($year, $mon, $day, $hour, $min, $sec, $tz) = parse_date($v);
+			if ($year) {
+			    my $thisyear = (gmtime)[5] + 1900;
+			    if ($year < $thisyear) {
+				push(@cur, "Max-Age" => -1);  # any negative value will do
+				$expires++;
+			    }
+			    elsif ($year >= $thisyear + 10) {
+				# the date is at least 10 years into the future, just replace
+				# it with something approximate
+				push(@cur, "Max-Age" => 10 * 365 * 24 * 60 * 60);
+				$expires++;
+			    }
+			}
 		    }
 		}
                 elsif (!$first_param && lc($k) =~ /^(?:version|discard|ns-cookie)/) {

Modified: trunk/libwww-perl/lib/LWP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP.pm (original)
+++ trunk/libwww-perl/lib/LWP.pm Wed Oct  7 23:18:50 2009
@@ -1,6 +1,6 @@
 package LWP;
 
-$VERSION = "5.832";
+$VERSION = "5.833";
 sub Version { $VERSION; }
 
 require 5.005;

Modified: trunk/libwww-perl/lib/LWP/Protocol/http.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/Protocol/http.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/Protocol/http.pm (original)
+++ trunk/libwww-perl/lib/LWP/Protocol/http.pm Wed Oct  7 23:18:50 2009
@@ -18,7 +18,7 @@
     my($self, $host, $port, $timeout) = @_;
     my $conn_cache = $self->{ua}{conn_cache};
     if ($conn_cache) {
-	if (my $sock = $conn_cache->withdraw("http", "$host:$port")) {
+	if (my $sock = $conn_cache->withdraw($self->socket_type, "$host:$port")) {
 	    return $sock if $sock && !$sock->can_read(0);
 	    # if the socket is readable, then either the peer has closed the
 	    # connection or there are some garbage bytes on it.  In either
@@ -47,6 +47,11 @@
     eval { $sock->blocking(0); };
 
     $sock;
+}
+
+sub socket_type
+{
+    return "http";
 }
 
 sub socket_class
@@ -402,7 +407,7 @@
 	    if (($peer_http_version eq "1.1" && !$connection{close}) ||
 		$connection{"keep-alive"})
 	    {
-		$conn_cache->deposit("http", "$host:$port", $socket);
+		$conn_cache->deposit($self->socket_type, "$host:$port", $socket);
 	    }
 	}
     }

Modified: trunk/libwww-perl/lib/LWP/Protocol/https.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/Protocol/https.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/Protocol/https.pm (original)
+++ trunk/libwww-perl/lib/LWP/Protocol/https.pm Wed Oct  7 23:18:50 2009
@@ -5,6 +5,11 @@
 use vars qw(@ISA);
 require LWP::Protocol::http;
 @ISA = qw(LWP::Protocol::http);
+
+sub socket_type
+{
+    return "https";
+}
 
 sub _check_sock
 {

Modified: trunk/libwww-perl/lib/LWP/UserAgent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/UserAgent.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/UserAgent.pm (original)
+++ trunk/libwww-perl/lib/LWP/UserAgent.pm Wed Oct  7 23:18:50 2009
@@ -5,7 +5,7 @@
 
 require LWP::MemberMixin;
 @ISA = qw(LWP::MemberMixin);
-$VERSION = "5.832";
+$VERSION = "5.833";
 
 use HTTP::Request ();
 use HTTP::Response ();
@@ -92,7 +92,8 @@
                       requests_redirectable => $requests_redirectable,
 		     }, $class;
 
-    $self->agent($agent || $class->_agent);
+    $self->agent(defined($agent) ? $agent : $class->_agent)
+	if defined($agent) || !$def_headers || !$def_headers->header("User-Agent");
     $self->from($from) if $from;
     $self->cookie_jar($cookie_jar) if $cookie_jar;
     $self->parse_head($parse_head);
@@ -834,12 +835,16 @@
     my $tmpfile = "$file-$$";
 
     my $response = $self->request($request, $tmpfile);
+    if ( $response->header('X-Died') ) {
+	die $response->header('X-Died');
+    }
 
     # Only fetching a fresh copy of the would be considered success.
     # If the file was not modified, "304" would returned, which 
     # is considered by HTTP::Status to be a "redirect", /not/ "success"
     if ( $response->is_success ) {
-        my $file_length = ( stat($tmpfile) )[7];
+        my @stat        = stat($tmpfile) or die "Could not stat tmpfile '$tmpfile': $!";
+        my $file_length = $stat[7];
         my ($content_length) = $response->header('Content-length');
 
         if ( defined $content_length and $file_length < $content_length ) {

Modified: trunk/libwww-perl/lib/Net/HTTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/Net/HTTP.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/Net/HTTP.pm (original)
+++ trunk/libwww-perl/lib/Net/HTTP.pm Wed Oct  7 23:18:50 2009
@@ -3,7 +3,7 @@
 use strict;
 use vars qw($VERSION @ISA $SOCKET_CLASS);
 
-$VERSION = "5.832";
+$VERSION = "5.833";
 unless ($SOCKET_CLASS) {
     eval { require IO::Socket::INET } || require IO::Socket;
     $SOCKET_CLASS = "IO::Socket::INET";
@@ -128,7 +128,7 @@
 =item $s->max_line_length
 
 Get/set a limit on the length of response line and response header
-lines.  The default is 4096.  A value of 0 means no limit.
+lines.  The default is 8192.  A value of 0 means no limit.
 
 =item $s->max_header_length
 

Modified: trunk/libwww-perl/lib/Net/HTTP/Methods.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/Net/HTTP/Methods.pm?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/lib/Net/HTTP/Methods.pm (original)
+++ trunk/libwww-perl/lib/Net/HTTP/Methods.pm Wed Oct  7 23:18:50 2009
@@ -5,7 +5,7 @@
 use strict;
 use vars qw($VERSION);
 
-$VERSION = "5.832";
+$VERSION = "5.833";
 
 my $CRLF = "\015\012";   # "\r\n" is not portable
 
@@ -69,7 +69,7 @@
     $peer_http_version = "1.0" unless defined $peer_http_version;
     my $send_te = delete $cnf->{SendTE};
     my $max_line_length = delete $cnf->{MaxLineLength};
-    $max_line_length = 4*1024 unless defined $max_line_length;
+    $max_line_length = 8*1024 unless defined $max_line_length;
     my $max_header_lines = delete $cnf->{MaxHeaderLines};
     $max_header_lines = 128 unless defined $max_header_lines;
 

Modified: trunk/libwww-perl/t/base/cookies.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/t/base/cookies.t?rev=45461&op=diff
==============================================================================
--- trunk/libwww-perl/t/base/cookies.t (original)
+++ trunk/libwww-perl/t/base/cookies.t Wed Oct  7 23:18:50 2009
@@ -1,7 +1,7 @@
 #!perl -w
 
 use Test;
-plan tests => 62;
+plan tests => 66;
 
 use HTTP::Cookies;
 use HTTP::Request;
@@ -644,6 +644,43 @@
 #print $req->as_string;
 ok($req->header("Cookie"), "foo=\"bar\"");
 
+# Test cookies that expire far into the future [RT#50147]
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie", "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL; expires=Mon, 03-Oct-2211 15:18:10 GMT; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired1=1; expires=Mon, 03-Oct-2001 15:18:10 GMT; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired2=1; expires=Fri Jan  1 00:00:00 GMT 1970; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired3=1; expires=Fri Jan  1 00:00:01 GMT 1970; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired4=1; expires=Thu Dec 31 23:59:59 GMT 1969; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired5=1; expires=Fri Feb  2 00:00:00 GMT 1950; path=/; domain=.example.com");
+$c->extract_cookies($res);
+#print $res->as_string;
+#print "---\n";
+#print $c->as_string;
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$c->add_cookie_header($req);
+#print $req->as_string;
+ok($req->header("Cookie"), "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL");
+
+$c->clear_temporary_cookies;
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$c->add_cookie_header($req);
+#print $req->as_string;
+ok($req->header("Cookie"), "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL");
+
+# Test merging of cookies
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie", "foo=1; path=/");
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$req->header("Cookie", "x=bcd");
+$c->add_cookie_header($req);
+ok($req->header("Cookie"), "x=bcd; foo=1");
+$c->add_cookie_header($req);
+ok($req->header("Cookie"), "x=bcd; foo=1; foo=1");
+#print $req->as_string;
+
+
 #-------------------------------------------------------------------
 
 sub interact




More information about the Pkg-perl-cvs-commits mailing list