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.66 by root, Fri Dec 31 06:18:30 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";
… …
440 if (my $jar = $arg{cookie_jar}) { 452 if (my $jar = $arg{cookie_jar}) {
441 %$jar = () if $jar->{version} != 1; 453 %$jar = () if $jar->{version} != 1;
442 454
443 my @cookie; 455 my @cookie;
444 456
445 while (my ($chost, $v) = each %$jar) { 457 while (my ($chost, $paths) = each %$jar) {
446 if ($chost =~ /^\./) { 458 if ($chost =~ /^\./) {
447 next unless $chost eq substr $uhost, -length $chost; 459 next unless $chost eq substr $uhost, -length $chost;
448 } elsif ($chost =~ /\./) { 460 } elsif ($chost =~ /\./) {
449 next unless $chost eq $uhost; 461 next unless $chost eq $uhost;
450 } else { 462 } else {
451 next; 463 next;
452 } 464 }
453 465
454 while (my ($cpath, $v) = each %$v) { 466 while (my ($cpath, $cookies) = each %$paths) {
455 next unless $cpath eq substr $upath, 0, length $cpath; 467 next unless $cpath eq substr $upath, 0, length $cpath;
456 468
457 while (my ($k, $v) = each %$v) { 469 while (my ($cookie, $kv) = each %$cookies) {
458 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
459 my $value = $v->{value}; 479 my $value = $kv->{value};
460 $value =~ s/([\\"])/\\$1/g; 480 $value =~ s/([\\"])/\\$1/g;
461 push @cookie, "$k=\"$value\""; 481 push @cookie, "$cookie=\"$value\"";
462 } 482 }
463 } 483 }
464 } 484 }
465 485
466 $hdr{cookie} = join "; ", @cookie 486 $hdr{cookie} = join "; ", @cookie
… …
486 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"}; 506 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"};
487 507
488 $hdr{"content-length"} = length $arg{body} 508 $hdr{"content-length"} = length $arg{body}
489 if length $arg{body} || $method ne "GET"; 509 if length $arg{body} || $method ne "GET";
490 510
491 $hdr{connection} = "close TE"; 511 $hdr{connection} = "close TE"; #1.1
492 $hdr{te} = "trailers" unless exists $hdr{te}; 512 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
493 513
494 my %state = (connect_guard => 1); 514 my %state = (connect_guard => 1);
495 515
496 _get_slot $uhost, sub { 516 _get_slot $uhost, sub {
497 $state{slot_guard} = shift; 517 $state{slot_guard} = shift;
… …
533# ++$KA_COUNT{$_[1]}; 553# ++$KA_COUNT{$_[1]};
534# $state{handle}{ka_count_guard} = AnyEvent::Util::guard { 554# $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
535# --$KA_COUNT{$_[1]} 555# --$KA_COUNT{$_[1]}
536# }; 556# };
537# $hdr{connection} = "keep-alive"; 557# $hdr{connection} = "keep-alive";
538# } else {
539# delete $hdr{connection};
540# } 558# }
541 559
542 $state{handle}->starttls ("connect") if $rscheme eq "https"; 560 $state{handle}->starttls ("connect") if $rscheme eq "https";
543 561
544 # handle actual, non-tunneled, request 562 # handle actual, non-tunneled, request
… …
557 return unless %state; 575 return unless %state;
558 576
559 %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
560 578
561 # status line and headers 579 # status line and headers
562 $state{handle}->push_read (line => $qr_nlnl, sub { 580 $state{read_response} = sub {
563 my $keepalive = pop;
564
565 for ("$_[1]") { 581 for ("$_[1]") {
566 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.
567 583
568 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/igxc 584 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/igxc
569 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;
570 594
571 push @pseudo, 595 push @pseudo,
572 HTTPVersion => $1, 596 HTTPVersion => $1,
573 Status => $2, 597 Status => $2,
574 Reason => $3, 598 Reason => $3,
… …
614 $redirect = 1; 638 $redirect = 1;
615 } 639 }
616 } 640 }
617 641
618 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) 642 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
643 my $keepalive = pop;
644
619 $state{handle}->destroy if $state{handle}; 645 $state{handle}->destroy if $state{handle};
620 %state = (); 646 %state = ();
621 647
622 if (defined $_[1]) { 648 if (defined $_[1]) {
623 $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1]; 649 $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1];
… …
628 if ($arg{cookie_jar}) { 654 if ($arg{cookie_jar}) {
629 for ($hdr{"set-cookie"}) { 655 for ($hdr{"set-cookie"}) {
630 # parse NAME=VALUE 656 # parse NAME=VALUE
631 my @kv; 657 my @kv;
632 658
659 while (
660 m{
661 \G\s*
662 (?:
663 expires \s*=\s* ([A-Z][a-z][a-z],\ [^,;]+)
633 while (/\G\s* ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )/gcxs) { 664 | ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )
665 )
666 }gcxsi
667 ) {
634 my $name = $1; 668 my $name = $2;
635 my $value = $3; 669 my $value = $4;
636 670
637 unless ($value) { 671 unless (defined $name) {
672 # expires
673 $name = "expires";
638 $value = $2; 674 $value = $1;
675 } elsif (!defined $value) {
676 # quoted
677 $value = $3;
639 $value =~ s/\\(.)/$1/gs; 678 $value =~ s/\\(.)/$1/gs;
640 } 679 }
641 680
642 push @kv, $name => $value; 681 push @kv, lc $name, $value;
643 682
644 last unless /\G\s*;/gc; 683 last unless /\G\s*;/gc;
645 } 684 }
646 685
647 last unless @kv; 686 last unless @kv;
648 687
649 my $name = shift @kv; 688 my $name = shift @kv;
650 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"};
651 693
652 my $cdom; 694 my $cdom;
653 my $cpath = (delete $kv{path}) || "/"; 695 my $cpath = (delete $kv{path}) || "/";
654 696
655 if (exists $kv{domain}) { 697 if (exists $kv{domain}) {
… …
712 $_[0]->on_error (undef); 754 $_[0]->on_error (undef);
713 $_[0]->on_read (undef); 755 $_[0]->on_read (undef);
714 756
715 $finish->(delete $state{handle}); 757 $finish->(delete $state{handle});
716 758
717 } elsif ($hdr{"transfer-encoding"} =~ /chunked/) { 759 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
760 my $cl = 0;
718 my $body = undef; 761 my $body = undef;
719 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 762 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
720 763
721 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) }); 764 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
722 765
723 my $read_chunk; $read_chunk = sub { 766 my $read_chunk; $read_chunk = sub {
724 warn $_[1];#d#
725 $_[1] =~ /^([0-9a-fA-F]+)/ 767 $_[1] =~ /^([0-9a-fA-F]+)/
726 or $finish->(undef, 599 => "Garbled chunked transfer encoding"); 768 or $finish->(undef, 599 => "Garbled chunked transfer encoding");
727 769
728 my $len = hex $1; 770 my $len = hex $1;
729 771
730 if ($len) { 772 if ($len) {
773 $cl += $len;
774
731 $_[0]->push_read (chunk => hex $1, sub { 775 $_[0]->push_read (chunk => $len, sub {
732 $on_body->($_[1], \%hdr) 776 $on_body->($_[1], \%hdr)
733 or return $finish->(undef, 598 => "Request cancelled by on_body"); 777 or return $finish->(undef, 598 => "Request cancelled by on_body");
734 778
735 $_[0]->push_read (line => sub { 779 $_[0]->push_read (line => sub {
736 length $_[1] 780 length $_[1]
737 and return $finish->(undef, 599 => "Garbled chunked transfer encoding"); 781 and return $finish->(undef, 599 => "Garbled chunked transfer encoding");
738 $_[0]->push_read (line => $read_chunk); 782 $_[0]->push_read (line => $read_chunk);
739 }); 783 });
740 }); 784 });
741 } else { 785 } else {
786 $hdr{"content-length"} ||= $cl;
787
742 $_[0]->push_read (line => $qr_nlnl, sub { 788 $_[0]->push_read (line => $qr_nlnl, sub {
743 if (length $_[1]) { 789 if (length $_[1]) {
744 for ("$_[1]") { 790 for ("$_[1]") {
745 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 791 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
746 792
… …
797 }); 843 });
798 $_[0]->on_read (sub { }); 844 $_[0]->on_read (sub { });
799 } 845 }
800 } 846 }
801 } 847 }
802 }); 848 };
849
850 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});
803 }; 851 };
804 852
805 # now handle proxy-CONNECT method 853 # now handle proxy-CONNECT method
806 if ($proxy && $uscheme eq "https") { 854 if ($proxy && $uscheme eq "https") {
807 # oh dear, we have to wrap it into a connect request 855 # oh dear, we have to wrap it into a connect request
… …
879Takes 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
880Date (RFC 2616). 928Date (RFC 2616).
881 929
882=item $timestamp = AnyEvent::HTTP::parse_date $date 930=item $timestamp = AnyEvent::HTTP::parse_date $date
883 931
884Takes a HTTP Date (RFC 2616) and returns the corresponding POSIX 932Takes a HTTP Date (RFC 2616) or a Cookie date (netscape cookie spec) and
885timestamp, or C<undef> if the date cannot be parsed. 933returns the corresponding POSIX timestamp, or C<undef> if the date cannot
934be parsed.
886 935
887=item $AnyEvent::HTTP::MAX_RECURSE 936=item $AnyEvent::HTTP::MAX_RECURSE
888 937
889The default value for the C<recurse> request parameter (default: C<10>). 938The default value for the C<recurse> request parameter (default: C<10>).
890 939
… …
929sub parse_date($) { 978sub parse_date($) {
930 my ($date) = @_; 979 my ($date) = @_;
931 980
932 my ($d, $m, $y, $H, $M, $S); 981 my ($d, $m, $y, $H, $M, $S);
933 982
934 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$/) {
935 # RFC 822/1123, required by RFC 2616 984 # RFC 822/1123, required by RFC 2616 (with " ")
985 # cookie dates (with "-")
986
936 ($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);
937 988
938 } 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$/) {
939 # RFC 850 990 # RFC 850
940 ($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