ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-HTTP/HTTP.pm
(Generate patch)

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.65 by root, Fri Dec 31 03:47:32 2010 UTC vs.
Revision 1.70 by root, Fri Dec 31 20:31:47 2010 UTC

… …
94C<http_request> returns a "cancellation guard" - you have to keep the 94C<http_request> returns a "cancellation guard" - you have to keep the
95object at least alive until the callback get called. If the object gets 95object at least alive until the callback get called. If the object gets
96destroyed before the callback is called, the request will be cancelled. 96destroyed before the callback is called, the request will be cancelled.
97 97
98The callback will be called with the response body data as first argument 98The callback will be called with the response body data as first argument
99(or C<undef> if an error occured), and a hash-ref with response headers as 99(or C<undef> if an error occured), and a hash-ref with response headers
100second argument. 100(and trailers) as second argument.
101 101
102All the headers in that hash are lowercased. In addition to the response 102All the headers in that hash are lowercased. In addition to the response
103headers, the "pseudo-headers" (uppercase to avoid clashing with possible 103headers, the "pseudo-headers" (uppercase to avoid clashing with possible
104response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the 104response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the
105three parts of the HTTP Status-Line of the same name. If an error occurs 105three parts of the HTTP Status-Line of the same name. If an error occurs
… …
150Whether to recurse requests or not, e.g. on redirects, authentication 150Whether to recurse requests or not, e.g. on redirects, authentication
151retries and so on, and how often to do so. 151retries and so on, and how often to do so.
152 152
153=item headers => hashref 153=item headers => hashref
154 154
155The request headers to use. Currently, C<http_request> may provide its 155The request headers to use. Currently, C<http_request> may provide its own
156own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers 156C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and
157and will provide defaults for C<User-Agent:> and C<Referer:> (this can be 157will provide defaults at least for C<TE:>, C<Referer:> and C<User-Agent:>
158suppressed by using C<undef> for these headers in which case they won't be 158(this can be suppressed by using C<undef> for these headers in which case
159sent at all). 159they won't be sent at all).
160 160
161=item timeout => $seconds 161=item timeout => $seconds
162 162
163The time-out to use for various stages - each connect attempt will reset 163The time-out to use for various stages - each connect attempt will reset
164the timeout, as will read or write activity, i.e. this is not an overall 164the timeout, as will read or write activity, i.e. this is not an overall
… …
174C<$scheme> must be either missing, C<http> for HTTP or C<https> for 174C<$scheme> must be either missing, C<http> for HTTP or C<https> for
175HTTPS. 175HTTPS.
176 176
177=item body => $string 177=item body => $string
178 178
179The request body, usually empty. Will be-sent as-is (future versions of 179The request body, usually empty. Will be sent as-is (future versions of
180this module might offer more options). 180this module might offer more options).
181 181
182=item cookie_jar => $hash_ref 182=item cookie_jar => $hash_ref
183 183
184Passing this parameter enables (simplified) cookie-processing, loosely 184Passing this parameter enables (simplified) cookie-processing, loosely
185based on the original netscape specification. 185based on the original netscape specification.
186 186
187The C<$hash_ref> must be an (initially empty) hash reference which will 187The C<$hash_ref> must be an (initially empty) hash reference which will
188get updated automatically. It is possible to save the cookie_jar to 188get updated automatically. It is possible to save the cookie jar to
189persistent storage with something like JSON or Storable, but this is not 189persistent storage with something like JSON or Storable, but this is not
190recommended, as expiry times are currently being ignored. 190recommended, as session-only cookies might survive longer than expected.
191 191
192Note that this cookie implementation is not of very high quality, nor 192Note that this cookie implementation is not meant to be complete. If
193meant to be complete. If you want complete cookie management you have to 193you want complete cookie management you have to do that on your
194do that on your own. C<cookie_jar> is meant as a quick fix to get some 194own. C<cookie_jar> is meant as a quick fix to get some cookie-using sites
195cookie-using sites working. Cookies are a privacy disaster, do not use 195working. Cookies are a privacy disaster, do not use them unless required
196them unless required to. 196to.
197
198When cookie processing is enabled, the C<Cookie:> and C<Set-Cookie:>
199headers will be set and handled by this module, otherwise they will be
200left untouched.
197 201
198=item tls_ctx => $scheme | $tls_ctx 202=item tls_ctx => $scheme | $tls_ctx
199 203
200Specifies the AnyEvent::TLS context to be used for https connections. This 204Specifies the AnyEvent::TLS context to be used for https connections. This
201parameter follows the same rules as the C<tls_ctx> parameter to 205parameter follows the same rules as the C<tls_ctx> parameter to
… …
240 244
241This callback is useful, among other things, to quickly reject unwanted 245This callback is useful, among other things, to quickly reject unwanted
242content, which, if it is supposed to be rare, can be faster than first 246content, which, if it is supposed to be rare, can be faster than first
243doing a C<HEAD> request. 247doing a C<HEAD> request.
244 248
249The downside is that cancelling the request makes it impossible to re-use
250the connection. Also, the C<on_header> callback will not receive any
251trailer (headers sent after the response body).
252
245Example: cancel the request unless the content-type is "text/html". 253Example: cancel the request unless the content-type is "text/html".
246 254
247 on_header => sub { 255 on_header => sub {
248 $_[0]{"content-type"} =~ /^text\/html\s*(?:;|$)/ 256 $_[0]{"content-type"} =~ /^text\/html\s*(?:;|$)/
249 }, 257 },
… …
255string instead of the body data. 263string instead of the body data.
256 264
257It has to return either true (in which case AnyEvent::HTTP will continue), 265It has to return either true (in which case AnyEvent::HTTP will continue),
258or false, in which case AnyEvent::HTTP will cancel the download (and call 266or false, in which case AnyEvent::HTTP will cancel the download (and call
259the completion callback with an error code of C<598>). 267the completion callback with an error code of C<598>).
268
269The downside to cancelling the request is that it makes it impossible to
270re-use the connection.
260 271
261This callback is useful when the data is too large to be held in memory 272This callback is useful when the data is too large to be held in memory
262(so the callback writes it to a file) or when only some information should 273(so the callback writes it to a file) or when only some information should
263be extracted, or when the body should be processed incrementally. 274be extracted, or when the body should be processed incrementally.
264 275
… …
290If you think you need this, first have a look at C<on_body>, to see if 301If you think you need this, first have a look at C<on_body>, to see if
291that doesn't solve your problem in a better way. 302that doesn't solve your problem in a better way.
292 303
293=back 304=back
294 305
295Example: make a simple HTTP GET request for http://www.nethype.de/ 306Example: do a simple HTTP GET request for http://www.nethype.de/ and print
307the response body.
296 308
297 http_request GET => "http://www.nethype.de/", sub { 309 http_request GET => "http://www.nethype.de/", sub {
298 my ($body, $hdr) = @_; 310 my ($body, $hdr) = @_;
299 print "$body\n"; 311 print "$body\n";
300 }; 312 };
301 313
302Example: make a HTTP HEAD request on https://www.google.com/, use a 314Example: do a HTTP HEAD request on https://www.google.com/, use a
303timeout of 30 seconds. 315timeout of 30 seconds.
304 316
305 http_request 317 http_request
306 GET => "https://www.google.com", 318 GET => "https://www.google.com",
307 timeout => 30, 319 timeout => 30,
… …
310 use Data::Dumper; 322 use Data::Dumper;
311 print Dumper $hdr; 323 print Dumper $hdr;
312 } 324 }
313 ; 325 ;
314 326
315Example: make another simple HTTP GET request, but immediately try to 327Example: do another simple HTTP GET request, but immediately try to
316cancel it. 328cancel it.
317 329
318 my $request = http_request GET => "http://www.nethype.de/", sub { 330 my $request = http_request GET => "http://www.nethype.de/", sub {
319 my ($body, $hdr) = @_; 331 my ($body, $hdr) = @_;
320 print "$body\n"; 332 print "$body\n";
… …
352 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 364 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
353 365
354 _slot_schedule $_[0]; 366 _slot_schedule $_[0];
355} 367}
356 368
369# continue to parse $_ for headers and place them into the arg
370sub parse_hdr() {
371 my %hdr;
372
373 # things seen, not parsed:
374 # p3pP="NON CUR OTPi OUR NOR UNI"
375
376 $hdr{lc $1} .= ",$2"
377 while /\G
378 ([^:\000-\037]*):
379 [\011\040]*
380 ((?: [^\012]+ | \012[\011\040] )*)
381 \012
382 /gxc;
383
384 /\G$/
385 or return;
386
387 # remove the "," prefix we added to all headers above
388 substr $_, 0, 1, ""
389 for values %hdr;
390
391 \%hdr
392}
393
357our $qr_nlnl = qr{(?<![^\012])\015?\012}; 394our $qr_nlnl = qr{(?<![^\012])\015?\012};
358 395
359our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 }; 396our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 };
360our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" }; 397our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
361 398
… …
415 if (my $jar = $arg{cookie_jar}) { 452 if (my $jar = $arg{cookie_jar}) {
416 %$jar = () if $jar->{version} != 1; 453 %$jar = () if $jar->{version} != 1;
417 454
418 my @cookie; 455 my @cookie;
419 456
420 while (my ($chost, $v) = each %$jar) { 457 while (my ($chost, $paths) = each %$jar) {
421 if ($chost =~ /^\./) { 458 if ($chost =~ /^\./) {
422 next unless $chost eq substr $uhost, -length $chost; 459 next unless $chost eq substr $uhost, -length $chost;
423 } elsif ($chost =~ /\./) { 460 } elsif ($chost =~ /\./) {
424 next unless $chost eq $uhost; 461 next unless $chost eq $uhost;
425 } else { 462 } else {
426 next; 463 next;
427 } 464 }
428 465
429 while (my ($cpath, $v) = each %$v) { 466 while (my ($cpath, $cookies) = each %$paths) {
430 next unless $cpath eq substr $upath, 0, length $cpath; 467 next unless $cpath eq substr $upath, 0, length $cpath;
431 468
432 while (my ($k, $v) = each %$v) { 469 while (my ($cookie, $kv) = each %$cookies) {
433 next if $uscheme ne "https" && exists $v->{secure}; 470 next if $uscheme ne "https" && exists $kv->{secure};
471
472 if (exists $kv->{expires}) {
473 if (AE::now > parse_date ($kv->{expires})) {
474 delete $cookies->{$cookie};
475 next;
476 }
477 }
478
434 my $value = $v->{value}; 479 my $value = $kv->{value};
435 $value =~ s/([\\"])/\\$1/g; 480 $value =~ s/([\\"])/\\$1/g;
436 push @cookie, "$k=\"$value\""; 481 push @cookie, "$cookie=\"$value\"";
437 } 482 }
438 } 483 }
439 } 484 }
440 485
441 $hdr{cookie} = join "; ", @cookie 486 $hdr{cookie} = join "; ", @cookie
… …
455 } else { 500 } else {
456 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); 501 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
457 } 502 }
458 503
459 # leave out fragment and query string, just a heuristic 504 # leave out fragment and query string, just a heuristic
460 $hdr{referer} ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer}; 505 $hdr{referer} = "$uscheme://$uauthority$upath" unless exists $hdr{referer};
461 $hdr{"user-agent"} ||= $USERAGENT unless exists $hdr{"user-agent"}; 506 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"};
462 507
463 $hdr{"content-length"} = length $arg{body} 508 $hdr{"content-length"} = length $arg{body}
464 if length $arg{body} || $method ne "GET"; 509 if length $arg{body} || $method ne "GET";
510
511 $hdr{connection} = "close TE"; #1.1
512 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
465 513
466 my %state = (connect_guard => 1); 514 my %state = (connect_guard => 1);
467 515
468 _get_slot $uhost, sub { 516 _get_slot $uhost, sub {
469 $state{slot_guard} = shift; 517 $state{slot_guard} = shift;
… …
505# ++$KA_COUNT{$_[1]}; 553# ++$KA_COUNT{$_[1]};
506# $state{handle}{ka_count_guard} = AnyEvent::Util::guard { 554# $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
507# --$KA_COUNT{$_[1]} 555# --$KA_COUNT{$_[1]}
508# }; 556# };
509# $hdr{connection} = "keep-alive"; 557# $hdr{connection} = "keep-alive";
510# } else {
511 delete $hdr{connection};
512# } 558# }
513 559
514 $state{handle}->starttls ("connect") if $rscheme eq "https"; 560 $state{handle}->starttls ("connect") if $rscheme eq "https";
515 561
516 # handle actual, non-tunneled, request 562 # handle actual, non-tunneled, request
517 my $handle_actual_request = sub { 563 my $handle_actual_request = sub {
518 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 564 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
519 565
520 # send request 566 # send request
521 $state{handle}->push_write ( 567 $state{handle}->push_write (
522 "$method $rpath HTTP/1.0\015\012" 568 "$method $rpath HTTP/1.1\015\012"
523 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr) 569 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
524 . "\015\012" 570 . "\015\012"
525 . (delete $arg{body}) 571 . (delete $arg{body})
526 ); 572 );
527 573
… …
529 return unless %state; 575 return unless %state;
530 576
531 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use 577 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use
532 578
533 # status line and headers 579 # status line and headers
534 $state{handle}->push_read (line => $qr_nlnl, sub { 580 $state{read_response} = sub {
535 my $keepalive = pop;
536
537 for ("$_[1]") { 581 for ("$_[1]") {
538 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 582 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
539 583
540 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )? \015?\012/igxc 584 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/igxc
541 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" })); 585 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" }));
586
587 # 100 Continue handling
588 # should not happen as we don't send expect: 100-continue,
589 # but we handle it just in case.
590 # since we send the request body regardless, if we get an error
591 # we are out of-sync, which we currently do NOT handle correctly.
592 return $state{handle}->push_read (line => $qr_nlnl, $state{read_response})
593 if $2 eq 100;
542 594
543 push @pseudo, 595 push @pseudo,
544 HTTPVersion => $1, 596 HTTPVersion => $1,
545 Status => $2, 597 Status => $2,
546 Reason => $3, 598 Reason => $3,
547 ; 599 ;
548 600
549 # things seen, not parsed: 601 my $hdr = parse_hdr
550 # p3pP="NON CUR OTPi OUR NOR UNI"
551
552 $hdr{lc $1} .= ",$2"
553 while /\G
554 ([^:\000-\037]*):
555 [\011\040]*
556 ((?: [^\012]+ | \012[\011\040] )*)
557 \012
558 /gxc;
559
560 /\G$/
561 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Garbled response headers" })); 602 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Garbled response headers" }));
603
604 %hdr = (%$hdr, @pseudo);
562 } 605 }
563
564 # remove the "," prefix we added to all headers above
565 substr $_, 0, 1, ""
566 for values %hdr;
567
568 # patch in all pseudo headers
569 %hdr = (%hdr, @pseudo);
570 606
571 # redirect handling 607 # redirect handling
572 # microsoft and other shitheads don't give a shit for following standards, 608 # microsoft and other shitheads don't give a shit for following standards,
573 # try to support some common forms of broken Location headers. 609 # try to support some common forms of broken Location headers.
574 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) { 610 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
… …
602 $redirect = 1; 638 $redirect = 1;
603 } 639 }
604 } 640 }
605 641
606 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) 642 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
643 my $keepalive = pop;
644
607 $state{handle}->destroy if $state{handle}; 645 $state{handle}->destroy if $state{handle};
608 %state = (); 646 %state = ();
609 647
610 if (defined $_[1]) { 648 if (defined $_[1]) {
611 $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1]; 649 $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1];
… …
616 if ($arg{cookie_jar}) { 654 if ($arg{cookie_jar}) {
617 for ($hdr{"set-cookie"}) { 655 for ($hdr{"set-cookie"}) {
618 # parse NAME=VALUE 656 # parse NAME=VALUE
619 my @kv; 657 my @kv;
620 658
659 while (
660 m{
661 \G\s*
662 (?:
663 expires \s*=\s* ([A-Z][a-z][a-z],\ [^,;]+)
621 while (/\G\s* ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )/gcxs) { 664 | ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )
665 )
666 }gcxsi
667 ) {
622 my $name = $1; 668 my $name = $2;
623 my $value = $3; 669 my $value = $4;
624 670
625 unless ($value) { 671 unless (defined $name) {
672 # expires
673 $name = "expires";
626 $value = $2; 674 $value = $1;
675 } elsif (!defined $value) {
676 # quoted
677 $value = $3;
627 $value =~ s/\\(.)/$1/gs; 678 $value =~ s/\\(.)/$1/gs;
628 } 679 }
629 680
630 push @kv, $name => $value; 681 push @kv, lc $name, $value;
631 682
632 last unless /\G\s*;/gc; 683 last unless /\G\s*;/gc;
633 } 684 }
634 685
635 last unless @kv; 686 last unless @kv;
636 687
637 my $name = shift @kv; 688 my $name = shift @kv;
638 my %kv = (value => shift @kv, @kv); 689 my %kv = (value => shift @kv, @kv);
690
691 $kv{expires} ||= format_date (AE::now + $kv{"max-age"})
692 if exists $kv{"max-age"};
639 693
640 my $cdom; 694 my $cdom;
641 my $cpath = (delete $kv{path}) || "/"; 695 my $cpath = (delete $kv{path}) || "/";
642 696
643 if (exists $kv{domain}) { 697 if (exists $kv{domain}) {
… …
687 or (defined $len && !$len) 741 or (defined $len && !$len)
688 ) { 742 ) {
689 # no body 743 # no body
690 $finish->("", undef, undef, 1); 744 $finish->("", undef, undef, 1);
691 } else { 745 } else {
692 # body handling, four different code paths 746 # body handling, many different code paths
693 # for want_body_handle, on_body (2x), normal (2x) 747 # - no body expected
694 # we might read too much here, but it does not matter yet (no pipelining) 748 # - want_body_handle
749 # - te chunked
750 # - 2x length known (with or without on_body)
751 # - 2x length not known (with or without on_body)
695 if (!$redirect && $arg{want_body_handle}) { 752 if (!$redirect && $arg{want_body_handle}) {
696 $_[0]->on_eof (undef); 753 $_[0]->on_eof (undef);
697 $_[0]->on_error (undef); 754 $_[0]->on_error (undef);
698 $_[0]->on_read (undef); 755 $_[0]->on_read (undef);
699 756
700 $finish->(delete $state{handle}); 757 $finish->(delete $state{handle});
701 758
759 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
760 my $cl = 0;
761 my $body = undef;
762 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
763
764 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
765
766 my $read_chunk; $read_chunk = sub {
767 $_[1] =~ /^([0-9a-fA-F]+)/
768 or $finish->(undef, 599 => "Garbled chunked transfer encoding");
769
770 my $len = hex $1;
771
772 if ($len) {
773 $cl += $len;
774
775 $_[0]->push_read (chunk => $len, sub {
776 $on_body->($_[1], \%hdr)
777 or return $finish->(undef, 598 => "Request cancelled by on_body");
778
779 $_[0]->push_read (line => sub {
780 length $_[1]
781 and return $finish->(undef, 599 => "Garbled chunked transfer encoding");
782 $_[0]->push_read (line => $read_chunk);
783 });
784 });
785 } else {
786 $hdr{"content-length"} ||= $cl;
787
788 $_[0]->push_read (line => $qr_nlnl, sub {
789 if (length $_[1]) {
790 for ("$_[1]") {
791 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
792
793 my $hdr = parse_hdr
794 or return $finish->(undef, 599 => "Garbled response trailers");
795
796 %hdr = (%hdr, %$hdr);
797 }
798 }
799
800 $finish->($body, undef, undef, 1);
801 });
802 }
803 };
804
805 $_[0]->push_read (line => $read_chunk);
806
702 } elsif ($arg{on_body}) { 807 } elsif ($arg{on_body}) {
703 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) }); 808 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
809
704 if ($len) { 810 if ($len) {
705 $_[0]->on_read (sub { 811 $_[0]->on_read (sub {
706 $len -= length $_[0]{rbuf}; 812 $len -= length $_[0]{rbuf};
707 813
708 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 814 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
709 or $finish->(undef, 598 => "Request cancelled by on_body"); 815 or return $finish->(undef, 598 => "Request cancelled by on_body");
710 816
711 $len > 0 817 $len > 0
712 or $finish->("", undef, undef, 1); 818 or $finish->("", undef, undef, 1);
713 }); 819 });
714 } else { 820 } else {
… …
737 }); 843 });
738 $_[0]->on_read (sub { }); 844 $_[0]->on_read (sub { });
739 } 845 }
740 } 846 }
741 } 847 }
742 }); 848 };
849
850 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});
743 }; 851 };
744 852
745 # now handle proxy-CONNECT method 853 # now handle proxy-CONNECT method
746 if ($proxy && $uscheme eq "https") { 854 if ($proxy && $uscheme eq "https") {
747 # oh dear, we have to wrap it into a connect request 855 # oh dear, we have to wrap it into a connect request
… …
819Takes a POSIX timestamp (seconds since the epoch) and formats it as a HTTP 927Takes a POSIX timestamp (seconds since the epoch) and formats it as a HTTP
820Date (RFC 2616). 928Date (RFC 2616).
821 929
822=item $timestamp = AnyEvent::HTTP::parse_date $date 930=item $timestamp = AnyEvent::HTTP::parse_date $date
823 931
824Takes a HTTP Date (RFC 2616) and returns the corresponding POSIX 932Takes a HTTP Date (RFC 2616) or a Cookie date (netscape cookie spec) and
825timestamp, or C<undef> if the date cannot be parsed. 933returns the corresponding POSIX timestamp, or C<undef> if the date cannot
934be parsed.
826 935
827=item $AnyEvent::HTTP::MAX_RECURSE 936=item $AnyEvent::HTTP::MAX_RECURSE
828 937
829The default value for the C<recurse> request parameter (default: C<10>). 938The default value for the C<recurse> request parameter (default: C<10>).
830 939
… …
869sub parse_date($) { 978sub parse_date($) {
870 my ($date) = @_; 979 my ($date) = @_;
871 980
872 my ($d, $m, $y, $H, $M, $S); 981 my ($d, $m, $y, $H, $M, $S);
873 982
874 if ($date =~ /^[A-Z][a-z][a-z], ([0-9][0-9]) ([A-Z][a-z][a-z]) ([0-9][0-9][0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) { 983 if ($date =~ /^[A-Z][a-z][a-z], ([0-9][0-9])[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) {
875 # RFC 822/1123, required by RFC 2616 984 # RFC 822/1123, required by RFC 2616 (with " ")
985 # cookie dates (with "-")
986
876 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3, $4, $5, $6); 987 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3, $4, $5, $6);
877 988
878 } elsif ($date =~ /^[A-Z][a-z]+, ([0-9][0-9])-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) { 989 } elsif ($date =~ /^[A-Z][a-z]+, ([0-9][0-9])-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) {
879 # RFC 850 990 # RFC 850
880 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3 < 69 ? $3 + 2000 : $3 + 1900, $4, $5, $6); 991 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3 < 69 ? $3 + 2000 : $3 + 1900, $4, $5, $6);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines