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.95 by root, Wed Jan 12 03:30:05 2011 UTC vs.
Revision 1.122 by root, Fri May 8 17:28:39 2015 UTC

… …
46use AnyEvent::Util (); 46use AnyEvent::Util ();
47use AnyEvent::Handle (); 47use AnyEvent::Handle ();
48 48
49use base Exporter::; 49use base Exporter::;
50 50
51our $VERSION = '2.02'; 51our $VERSION = 2.21;
52 52
53our @EXPORT = qw(http_get http_post http_head http_request); 53our @EXPORT = qw(http_get http_post http_head http_request);
54 54
55our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 55our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
56our $MAX_RECURSE = 10; 56our $MAX_RECURSE = 10;
… …
89C<http_request> returns a "cancellation guard" - you have to keep the 89C<http_request> returns a "cancellation guard" - you have to keep the
90object at least alive until the callback get called. If the object gets 90object at least alive until the callback get called. If the object gets
91destroyed before the callback is called, the request will be cancelled. 91destroyed before the callback is called, the request will be cancelled.
92 92
93The callback will be called with the response body data as first argument 93The callback will be called with the response body data as first argument
94(or C<undef> if an error occured), and a hash-ref with response headers 94(or C<undef> if an error occurred), and a hash-ref with response headers
95(and trailers) as second argument. 95(and trailers) as second argument.
96 96
97All the headers in that hash are lowercased. In addition to the response 97All the headers in that hash are lowercased. In addition to the response
98headers, the "pseudo-headers" (uppercase to avoid clashing with possible 98headers, the "pseudo-headers" (uppercase to avoid clashing with possible
99response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the 99response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the
… …
123C<590>-C<599> and the C<Reason> pseudo-header will contain an error 123C<590>-C<599> and the C<Reason> pseudo-header will contain an error
124message. Currently the following status codes are used: 124message. Currently the following status codes are used:
125 125
126=over 4 126=over 4
127 127
128=item 595 - errors during connection etsbalishment, proxy handshake. 128=item 595 - errors during connection establishment, proxy handshake.
129 129
130=item 596 - errors during TLS negotiation, request sending and header processing. 130=item 596 - errors during TLS negotiation, request sending and header processing.
131 131
132=item 597 - errors during body receiving or processing. 132=item 597 - errors during body receiving or processing.
133 133
… …
154 154
155=over 4 155=over 4
156 156
157=item recurse => $count (default: $MAX_RECURSE) 157=item recurse => $count (default: $MAX_RECURSE)
158 158
159Whether to recurse requests or not, e.g. on redirects, authentication 159Whether to recurse requests or not, e.g. on redirects, authentication and
160retries and so on, and how often to do so. 160other retries and so on, and how often to do so.
161
162Only redirects to http and https URLs are supported. While most common
163redirection forms are handled entirely within this module, some require
164the use of the optional L<URI> module. If it is required but missing, then
165the request will fail with an error.
161 166
162=item headers => hashref 167=item headers => hashref
163 168
164The request headers to use. Currently, C<http_request> may provide its own 169The request headers to use. Currently, C<http_request> may provide its own
165C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and 170C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and
… …
169 174
170You really should provide your own C<User-Agent:> header value that is 175You really should provide your own C<User-Agent:> header value that is
171appropriate for your program - I wouldn't be surprised if the default 176appropriate for your program - I wouldn't be surprised if the default
172AnyEvent string gets blocked by webservers sooner or later. 177AnyEvent string gets blocked by webservers sooner or later.
173 178
179Also, make sure that your headers names and values do not contain any
180embedded newlines.
181
174=item timeout => $seconds 182=item timeout => $seconds
175 183
176The time-out to use for various stages - each connect attempt will reset 184The time-out to use for various stages - each connect attempt will reset
177the timeout, as will read or write activity, i.e. this is not an overall 185the timeout, as will read or write activity, i.e. this is not an overall
178timeout. 186timeout.
179 187
180Default timeout is 5 minutes. 188Default timeout is 5 minutes.
181 189
182=item proxy => [$host, $port[, $scheme]] or undef 190=item proxy => [$host, $port[, $scheme]] or undef
183 191
184Use the given http proxy for all requests. If not specified, then the 192Use the given http proxy for all requests, or no proxy if C<undef> is
185default proxy (as specified by C<$ENV{http_proxy}>) is used. 193used.
186 194
187C<$scheme> must be either missing or must be C<http> for HTTP. 195C<$scheme> must be either missing or must be C<http> for HTTP.
196
197If not specified, then the default proxy is used (see
198C<AnyEvent::HTTP::set_proxy>).
188 199
189=item body => $string 200=item body => $string
190 201
191The request body, usually empty. Will be sent as-is (future versions of 202The request body, usually empty. Will be sent as-is (future versions of
192this module might offer more options). 203this module might offer more options).
… …
236context) - only connections using the same unique ID will be reused. 247context) - only connections using the same unique ID will be reused.
237 248
238=item on_prepare => $callback->($fh) 249=item on_prepare => $callback->($fh)
239 250
240In rare cases you need to "tune" the socket before it is used to 251In rare cases you need to "tune" the socket before it is used to
241connect (for exmaple, to bind it on a given IP address). This parameter 252connect (for example, to bind it on a given IP address). This parameter
242overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect> 253overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
243and behaves exactly the same way (e.g. it has to provide a 254and behaves exactly the same way (e.g. it has to provide a
244timeout). See the description for the C<$prepare_cb> argument of 255timeout). See the description for the C<$prepare_cb> argument of
245C<AnyEvent::Socket::tcp_connect> for details. 256C<AnyEvent::Socket::tcp_connect> for details.
246 257
… …
378 389
379Example: do a HTTP HEAD request on https://www.google.com/, use a 390Example: do a HTTP HEAD request on https://www.google.com/, use a
380timeout of 30 seconds. 391timeout of 30 seconds.
381 392
382 http_request 393 http_request
383 GET => "https://www.google.com", 394 HEAD => "https://www.google.com",
384 headers => { "user-agent" => "MySearchClient 1.0" }, 395 headers => { "user-agent" => "MySearchClient 1.0" },
385 timeout => 30, 396 timeout => 30,
386 sub { 397 sub {
387 my ($body, $hdr) = @_; 398 my ($body, $hdr) = @_;
388 use Data::Dumper; 399 use Data::Dumper;
… …
529 while ( 540 while (
530 m{ 541 m{
531 \G\s* 542 \G\s*
532 (?: 543 (?:
533 expires \s*=\s* ([A-Z][a-z][a-z]+,\ [^,;]+) 544 expires \s*=\s* ([A-Z][a-z][a-z]+,\ [^,;]+)
534 | ([^=;,[:space:]]+) (?: \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) ) )? 545 | ([^=;,[:space:]]+) (?: \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^;,[:space:]]*) ) )?
535 ) 546 )
536 }gcxsi 547 }gcxsi
537 ) { 548 ) {
538 my $name = $2; 549 my $name = $2;
539 my $value = $4; 550 my $value = $4;
… …
683 694
684 $cb->(undef, $hdr); 695 $cb->(undef, $hdr);
685 () 696 ()
686} 697}
687 698
699our %IDEMPOTENT = (
700 DELETE => 1,
701 GET => 1,
702 HEAD => 1,
703 OPTIONS => 1,
704 PUT => 1,
705 TRACE => 1,
706
707 ACL => 1,
708 "BASELINE-CONTROL" => 1,
709 BIND => 1,
710 CHECKIN => 1,
711 CHECKOUT => 1,
712 COPY => 1,
713 LABEL => 1,
714 LINK => 1,
715 MERGE => 1,
716 MKACTIVITY => 1,
717 MKCALENDAR => 1,
718 MKCOL => 1,
719 MKREDIRECTREF => 1,
720 MKWORKSPACE => 1,
721 MOVE => 1,
722 ORDERPATCH => 1,
723 PROPFIND => 1,
724 PROPPATCH => 1,
725 REBIND => 1,
726 REPORT => 1,
727 SEARCH => 1,
728 UNBIND => 1,
729 UNCHECKOUT => 1,
730 UNLINK => 1,
731 UNLOCK => 1,
732 UPDATE => 1,
733 UPDATEREDIRECTREF => 1,
734 "VERSION-CONTROL" => 1,
735);
736
688sub http_request($$@) { 737sub http_request($$@) {
689 my $cb = pop; 738 my $cb = pop;
690 my ($method, $url, %arg) = @_; 739 my ($method, $url, %arg) = @_;
691 740
692 my %hdr; 741 my %hdr;
… …
709 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE; 758 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
710 759
711 return $cb->(undef, { @pseudo, Status => 599, Reason => "Too many redirections" }) 760 return $cb->(undef, { @pseudo, Status => 599, Reason => "Too many redirections" })
712 if $recurse < 0; 761 if $recurse < 0;
713 762
714 my $proxy = $arg{proxy} || $PROXY; 763 my $proxy = exists $arg{proxy} ? $arg{proxy} : $PROXY;
715 my $timeout = $arg{timeout} || $TIMEOUT; 764 my $timeout = $arg{timeout} || $TIMEOUT;
716 765
717 my ($uscheme, $uauthority, $upath, $query, undef) = # ignore fragment 766 my ($uscheme, $uauthority, $upath, $query, undef) = # ignore fragment
718 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|; 767 $url =~ m|^([^:]+):(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?$|;
719 768
720 $uscheme = lc $uscheme; 769 $uscheme = lc $uscheme;
721 770
722 my $uport = $uscheme eq "http" ? 80 771 my $uport = $uscheme eq "http" ? 80
723 : $uscheme eq "https" ? 443 772 : $uscheme eq "https" ? 443
… …
767 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"}; 816 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"};
768 817
769 $hdr{"content-length"} = length $arg{body} 818 $hdr{"content-length"} = length $arg{body}
770 if length $arg{body} || $method ne "GET"; 819 if length $arg{body} || $method ne "GET";
771 820
772 my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/; 821 my $idempotent = $IDEMPOTENT{$method};
773 822
774 # default value for keepalive is true iff the request is for an idempotent method 823 # default value for keepalive is true iff the request is for an idempotent method
775 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : $idempotent; 824 my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent;
776 my $keepalive10 = exists $arg{keepalive10} ? $arg{keepalive10} : !$proxy; 825 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : !$proxy;
777 my $keptalive; # true if this is actually a recycled connection 826 my $was_persistent; # true if this is actually a recycled connection
778 827
779 # the key to use in the keepalive cache 828 # the key to use in the keepalive cache
780 my $ka_key = "$uhost\x00$arg{sessionid}"; 829 my $ka_key = "$uscheme\x00$uhost\x00$uport\x00$arg{sessionid}";
781 830
782 $hdr{connection} = ($keepalive ? $keepalive10 ? "keep-alive " : "" : "close ") . "Te"; #1.1 831 $hdr{connection} = ($persistent ? $keepalive ? "keep-alive, " : "" : "close, ") . "Te"; #1.1
783 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1 832 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
784 833
785 my %state = (connect_guard => 1); 834 my %state = (connect_guard => 1);
786 835
787 my $ae_error = 595; # connecting 836 my $ae_error = 595; # connecting
… …
797 # send request 846 # send request
798 $hdl->push_write ( 847 $hdl->push_write (
799 "$method $rpath HTTP/1.1\015\012" 848 "$method $rpath HTTP/1.1\015\012"
800 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr) 849 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
801 . "\015\012" 850 . "\015\012"
802 . (delete $arg{body}) 851 . $arg{body}
803 ); 852 );
804 853
805 # return if error occured during push_write() 854 # return if error occurred during push_write()
806 return unless %state; 855 return unless %state;
807 856
808 # reduce memory usage, save a kitten, also re-use it for the response headers. 857 # reduce memory usage, save a kitten, also re-use it for the response headers.
809 %hdr = (); 858 %hdr = ();
810 859
… …
837 886
838 %hdr = (%$hdr, @pseudo); 887 %hdr = (%$hdr, @pseudo);
839 } 888 }
840 889
841 # redirect handling 890 # redirect handling
842 # microsoft and other shitheads don't give a shit for following standards, 891 # relative uri handling forced by microsoft and other shitheads.
843 # try to support some common forms of broken Location headers. 892 # we give our best and fall back to URI if available.
844 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) { 893 if (exists $hdr{location}) {
894 my $loc = $hdr{location};
895
896 if ($loc =~ m%^//%) { # //
897 $loc = "$rscheme:$loc";
898
899 } elsif ($loc eq "") {
900 $loc = $url;
901
902 } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple"
845 $hdr{location} =~ s/^\.\/+//; 903 $loc =~ s/^\.\/+//;
846 904
905 if ($loc !~ m%^[.?#]%) {
847 my $url = "$rscheme://$uhost:$uport"; 906 my $prefix = "$rscheme://$uhost:$uport";
848 907
849 unless ($hdr{location} =~ s/^\///) { 908 unless ($loc =~ s/^\///) {
850 $url .= $upath; 909 $prefix .= $upath;
851 $url =~ s/\/[^\/]*$//; 910 $prefix =~ s/\/[^\/]*$//;
911 }
912
913 $loc = "$prefix/$loc";
914
915 } elsif (eval { require URI }) { # uri
916 $loc = URI->new_abs ($loc, $url)->as_string;
917
918 } else {
919 return _error %state, $cb, { @pseudo, Status => 599, Reason => "Cannot parse Location (URI module missing)" };
920 #$hdr{Status} = 599;
921 #$hdr{Reason} = "Unparsable Redirect (URI module missing)";
922 #$recurse = 0;
923 }
852 } 924 }
853 925
854 $hdr{location} = "$url/$hdr{location}"; 926 $hdr{location} = $loc;
855 } 927 }
856 928
857 my $redirect; 929 my $redirect;
858 930
859 if ($recurse) { 931 if ($recurse) {
… …
861 933
862 # industry standard is to redirect POST as GET for 934 # industry standard is to redirect POST as GET for
863 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1. 935 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1.
864 # also, the UA should ask the user for 301 and 307 and POST, 936 # also, the UA should ask the user for 301 and 307 and POST,
865 # industry standard seems to be to simply follow. 937 # industry standard seems to be to simply follow.
866 # we go with the industry standard. 938 # we go with the industry standard. 308 is defined
939 # by rfc7538
867 if ($status == 301 or $status == 302 or $status == 303) { 940 if ($status == 301 or $status == 302 or $status == 303) {
941 $redirect = 1;
868 # HTTP/1.1 is unclear on how to mutate the method 942 # HTTP/1.1 is unclear on how to mutate the method
869 $method = "GET" unless $method eq "HEAD"; 943 unless ($method eq "HEAD") {
870 $redirect = 1; 944 $method = "GET";
945 delete $arg{body};
946 }
871 } elsif ($status == 307) { 947 } elsif ($status == 307 or $status == 308) {
872 $redirect = 1; 948 $redirect = 1;
873 } 949 }
874 } 950 }
875 951
876 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) 952 my $finish = sub { # ($data, $err_status, $err_reason[, $persistent])
877 if ($state{handle}) { 953 if ($state{handle}) {
878 # handle keepalive 954 # handle keepalive
879 if ( 955 if (
880 $keepalive 956 $persistent
881 && $_[3] 957 && $_[3]
882 && ($hdr{HTTPVersion} < 1.1 958 && ($hdr{HTTPVersion} < 1.1
883 ? $hdr{connection} =~ /\bkeep-?alive\b/i 959 ? $hdr{connection} =~ /\bkeep-?alive\b/i
884 : $hdr{connection} !~ /\bclose\b/i) 960 : $hdr{connection} !~ /\bclose\b/i)
885 ) { 961 ) {
… …
904 980
905 if ($redirect && exists $hdr{location}) { 981 if ($redirect && exists $hdr{location}) {
906 # we ignore any errors, as it is very common to receive 982 # we ignore any errors, as it is very common to receive
907 # Content-Length != 0 but no actual body 983 # Content-Length != 0 but no actual body
908 # we also access %hdr, as $_[1] might be an erro 984 # we also access %hdr, as $_[1] might be an erro
985 $state{recurse} =
909 http_request ( 986 http_request (
910 $method => $hdr{location}, 987 $method => $hdr{location},
911 %arg, 988 %arg,
912 recurse => $recurse - 1, 989 recurse => $recurse - 1,
913 Redirect => [$_[0], \%hdr], 990 Redirect => [$_[0], \%hdr],
991 sub {
992 %state = ();
914 $cb 993 &$cb
994 },
915 ); 995 );
916 } else { 996 } else {
917 $cb->($_[0], \%hdr); 997 $cb->($_[0], \%hdr);
918 } 998 }
919 }; 999 };
920 1000
… …
952 my $body = ""; 1032 my $body = "";
953 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 1033 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
954 1034
955 $state{read_chunk} = sub { 1035 $state{read_chunk} = sub {
956 $_[1] =~ /^([0-9a-fA-F]+)/ 1036 $_[1] =~ /^([0-9a-fA-F]+)/
957 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 1037 or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
958 1038
959 my $len = hex $1; 1039 my $len = hex $1;
960 1040
961 if ($len) { 1041 if ($len) {
962 $cl += $len; 1042 $cl += $len;
… …
1032 } 1112 }
1033 }; 1113 };
1034 1114
1035 # if keepalive is enabled, then the server closing the connection 1115 # if keepalive is enabled, then the server closing the connection
1036 # before a response can happen legally - we retry on idempotent methods. 1116 # before a response can happen legally - we retry on idempotent methods.
1037 if ($keptalive && $idempotent) { 1117 if ($was_persistent && $idempotent) {
1038 my $old_eof = $hdl->{on_eof}; 1118 my $old_eof = $hdl->{on_eof};
1039 $hdl->{on_eof} = sub { 1119 $hdl->{on_eof} = sub {
1040 _destroy_state %state; 1120 _destroy_state %state;
1041 1121
1122 %state = ();
1123 $state{recurse} =
1042 http_request ( 1124 http_request (
1043 $method => $url, 1125 $method => $url,
1044 %arg, 1126 %arg,
1127 recurse => $recurse - 1,
1045 keepalive => 0, 1128 keepalive => 0,
1129 sub {
1130 %state = ();
1046 $cb 1131 &$cb
1132 }
1047 ); 1133 );
1048 }; 1134 };
1049 $hdl->on_read (sub { 1135 $hdl->on_read (sub {
1050 return unless %state; 1136 return unless %state;
1051 1137
1052 # as soon as we receive something, a connection close 1138 # as soon as we receive something, a connection close
… …
1060 }; 1146 };
1061 1147
1062 my $prepare_handle = sub { 1148 my $prepare_handle = sub {
1063 my ($hdl) = $state{handle}; 1149 my ($hdl) = $state{handle};
1064 1150
1065 $hdl->timeout ($timeout);
1066 $hdl->on_error (sub { 1151 $hdl->on_error (sub {
1067 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] }; 1152 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] };
1068 }); 1153 });
1069 $hdl->on_eof (sub { 1154 $hdl->on_eof (sub {
1070 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" }; 1155 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" };
1071 }); 1156 });
1157 $hdl->timeout_reset;
1158 $hdl->timeout ($timeout);
1072 }; 1159 };
1073 1160
1074 # connected to proxy (or origin server) 1161 # connected to proxy (or origin server)
1075 my $connect_cb = sub { 1162 my $connect_cb = sub {
1076 my $fh = shift 1163 my $fh = shift
… …
1092 1179
1093 # now handle proxy-CONNECT method 1180 # now handle proxy-CONNECT method
1094 if ($proxy && $uscheme eq "https") { 1181 if ($proxy && $uscheme eq "https") {
1095 # oh dear, we have to wrap it into a connect request 1182 # oh dear, we have to wrap it into a connect request
1096 1183
1184 my $auth = exists $hdr{"proxy-authorization"}
1185 ? "proxy-authorization: " . (delete $hdr{"proxy-authorization"}) . "\015\012"
1186 : "";
1187
1097 # maybe re-use $uauthority with patched port? 1188 # maybe re-use $uauthority with patched port?
1098 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012"); 1189 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012$auth\015\012");
1099 $state{handle}->push_read (line => $qr_nlnl, sub { 1190 $state{handle}->push_read (line => $qr_nlnl, sub {
1100 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 1191 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
1101 or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" }; 1192 or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" };
1102 1193
1103 if ($2 == 200) { 1194 if ($2 == 200) {
… …
1106 } else { 1197 } else {
1107 _error %state, $cb, { @pseudo, Status => $2, Reason => $3 }; 1198 _error %state, $cb, { @pseudo, Status => $2, Reason => $3 };
1108 } 1199 }
1109 }); 1200 });
1110 } else { 1201 } else {
1202 delete $hdr{"proxy-authorization"} unless $proxy;
1203
1111 $handle_actual_request->(); 1204 $handle_actual_request->();
1112 } 1205 }
1113 }; 1206 };
1114 1207
1115 _get_slot $uhost, sub { 1208 _get_slot $uhost, sub {
… …
1117 1210
1118 return unless $state{connect_guard}; 1211 return unless $state{connect_guard};
1119 1212
1120 # try to use an existing keepalive connection, but only if we, ourselves, plan 1213 # try to use an existing keepalive connection, but only if we, ourselves, plan
1121 # on a keepalive request (in theory, this should be a separate config option). 1214 # on a keepalive request (in theory, this should be a separate config option).
1122 if ($keepalive && $KA_CACHE{$ka_key}) { 1215 if ($persistent && $KA_CACHE{$ka_key}) {
1123 $keptalive = 1; 1216 $was_persistent = 1;
1217
1124 $state{handle} = ka_fetch $ka_key; 1218 $state{handle} = ka_fetch $ka_key;
1219 $state{handle}->destroyed
1220 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
1125 $prepare_handle->(); 1221 $prepare_handle->();
1222 $state{handle}->destroyed
1223 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
1126 $handle_actual_request->(); 1224 $handle_actual_request->();
1127 1225
1128 } else { 1226 } else {
1129 my $tcp_connect = $arg{tcp_connect} 1227 my $tcp_connect = $arg{tcp_connect}
1130 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; 1228 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
… …
1172Sets the default proxy server to use. The proxy-url must begin with a 1270Sets the default proxy server to use. The proxy-url must begin with a
1173string of the form C<http://host:port>, croaks otherwise. 1271string of the form C<http://host:port>, croaks otherwise.
1174 1272
1175To clear an already-set proxy, use C<undef>. 1273To clear an already-set proxy, use C<undef>.
1176 1274
1275When AnyEvent::HTTP is loaded for the first time it will query the
1276default proxy from the operating system, currently by looking at
1277C<$ENV{http_proxy>}.
1278
1177=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end] 1279=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end]
1178 1280
1179Remove all cookies from the cookie jar that have been expired. If 1281Remove all cookies from the cookie jar that have been expired. If
1180C<$session_end> is given and true, then additionally remove all session 1282C<$session_end> is given and true, then additionally remove all session
1181cookies. 1283cookies.
1182 1284
1183You should call this function (with a true C<$session_end>) before you 1285You should call this function (with a true C<$session_end>) before you
1184save cookies to disk, and you should call this function after loading them 1286save cookies to disk, and you should call this function after loading them
1185again. If you have a long-running program you can additonally call this 1287again. If you have a long-running program you can additionally call this
1186function from time to time. 1288function from time to time.
1187 1289
1188A cookie jar is initially an empty hash-reference that is managed by this 1290A cookie jar is initially an empty hash-reference that is managed by this
1189module. It's format is subject to change, but currently it is like this: 1291module. Its format is subject to change, but currently it is as follows:
1190 1292
1191The key C<version> has to contain C<1>, otherwise the hash gets 1293The key C<version> has to contain C<1>, otherwise the hash gets
1192emptied. All other keys are hostnames or IP addresses pointing to 1294emptied. All other keys are hostnames or IP addresses pointing to
1193hash-references. The key for these inner hash references is the 1295hash-references. The key for these inner hash references is the
1194server path for which this cookie is meant, and the values are again 1296server path for which this cookie is meant, and the values are again
1195hash-references. The keys of those hash-references is the cookie name, and 1297hash-references. Each key of those hash-references is a cookie name, and
1196the value, you guessed it, is another hash-reference, this time with the 1298the value, you guessed it, is another hash-reference, this time with the
1197key-value pairs from the cookie, except for C<expires> and C<max-age>, 1299key-value pairs from the cookie, except for C<expires> and C<max-age>,
1198which have been replaced by a C<_expires> key that contains the cookie 1300which have been replaced by a C<_expires> key that contains the cookie
1199expiry timestamp. 1301expiry timestamp. Session cookies are indicated by not having an
1302C<_expires> key.
1200 1303
1201Here is an example of a cookie jar with a single cookie, so you have a 1304Here is an example of a cookie jar with a single cookie, so you have a
1202chance of understanding the above paragraph: 1305chance of understanding the above paragraph:
1203 1306
1204 { 1307 {
… …
1228 1331
1229The default value for the C<recurse> request parameter (default: C<10>). 1332The default value for the C<recurse> request parameter (default: C<10>).
1230 1333
1231=item $AnyEvent::HTTP::TIMEOUT 1334=item $AnyEvent::HTTP::TIMEOUT
1232 1335
1233The default timeout for conenction operations (default: C<300>). 1336The default timeout for connection operations (default: C<300>).
1234 1337
1235=item $AnyEvent::HTTP::USERAGENT 1338=item $AnyEvent::HTTP::USERAGENT
1236 1339
1237The default value for the C<User-Agent> header (the default is 1340The default value for the C<User-Agent> header (the default is
1238C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 1341C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
1239 1342
1240=item $AnyEvent::HTTP::MAX_PER_HOST 1343=item $AnyEvent::HTTP::MAX_PER_HOST
1241 1344
1242The maximum number of concurrent connections to the same host (identified 1345The maximum number of concurrent connections to the same host (identified
1243by the hostname). If the limit is exceeded, then the additional requests 1346by the hostname). If the limit is exceeded, then additional requests
1244are queued until previous connections are closed. Both persistent and 1347are queued until previous connections are closed. Both persistent and
1245non-persistent connections are counted in this limit. 1348non-persistent connections are counted in this limit.
1246 1349
1247The default value for this is C<4>, and it is highly advisable to not 1350The default value for this is C<4>, and it is highly advisable to not
1248increase it much. 1351increase it much.
1249 1352
1250For comparison: the RFC's recommend 4 non-persistent or 2 persistent 1353For comparison: the RFC's recommend 4 non-persistent or 2 persistent
1251connections, older browsers used 2, newers (such as firefox 3) typically 1354connections, older browsers used 2, newer ones (such as firefox 3)
1252use 6, and Opera uses 8 because like, they have the fastest browser and 1355typically use 6, and Opera uses 8 because like, they have the fastest
1253give a shit for everybody else on the planet. 1356browser and give a shit for everybody else on the planet.
1254 1357
1255=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT 1358=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
1256 1359
1257The time after which idle persistent conenctions get closed by 1360The time after which idle persistent connections get closed by
1258AnyEvent::HTTP (default: C<3>). 1361AnyEvent::HTTP (default: C<3>).
1259 1362
1260=item $AnyEvent::HTTP::ACTIVE 1363=item $AnyEvent::HTTP::ACTIVE
1261 1364
1262The number of active connections. This is not the number of currently 1365The number of active connections. This is not the number of currently
… …
1303 # other formats fail in the loop below 1406 # other formats fail in the loop below
1304 1407
1305 for (0..11) { 1408 for (0..11) {
1306 if ($m eq $month[$_]) { 1409 if ($m eq $month[$_]) {
1307 require Time::Local; 1410 require Time::Local;
1308 return Time::Local::timegm ($S, $M, $H, $d, $_, $y); 1411 return eval { Time::Local::timegm ($S, $M, $H, $d, $_, $y) };
1309 } 1412 }
1310 } 1413 }
1311 1414
1312 undef 1415 undef
1313} 1416}
… …
1327 set_proxy $ENV{http_proxy}; 1430 set_proxy $ENV{http_proxy};
1328}; 1431};
1329 1432
1330=head2 SHOWCASE 1433=head2 SHOWCASE
1331 1434
1332This section contaisn some more elaborate "real-world" examples or code 1435This section contains some more elaborate "real-world" examples or code
1333snippets. 1436snippets.
1334 1437
1335=head2 HTTP/1.1 FILE DOWNLOAD 1438=head2 HTTP/1.1 FILE DOWNLOAD
1336 1439
1337Downloading files with HTTP cna be quite tricky, especially when something 1440Downloading files with HTTP can be quite tricky, especially when something
1338goes wrong and you want tor esume. 1441goes wrong and you want to resume.
1339 1442
1340Here is a function that initiates and resumes a download. It uses the 1443Here is a function that initiates and resumes a download. It uses the
1341last modified time to check for file content changes, and works with many 1444last modified time to check for file content changes, and works with many
1342HTTP/1.0 servers as well, and usually falls back to a complete re-download 1445HTTP/1.0 servers as well, and usually falls back to a complete re-download
1343on older servers. 1446on older servers.
1344 1447
1345It calls the completion callback with either C<undef>, which means a 1448It calls the completion callback with either C<undef>, which means a
1346nonretryable error occured, C<0> when the download was partial and should 1449nonretryable error occurred, C<0> when the download was partial and should
1347be retried, and C<1> if it was successful. 1450be retried, and C<1> if it was successful.
1348 1451
1349 use AnyEvent::HTTP; 1452 use AnyEvent::HTTP;
1350 1453
1351 sub download($$$) { 1454 sub download($$$) {
… …
1359 1462
1360 warn stat $fh; 1463 warn stat $fh;
1361 warn -s _; 1464 warn -s _;
1362 if (stat $fh and -s _) { 1465 if (stat $fh and -s _) {
1363 $ofs = -s _; 1466 $ofs = -s _;
1364 warn "-s is ", $ofs;#d# 1467 warn "-s is ", $ofs;
1365 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9]; 1468 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
1366 $hdr{"range"} = "bytes=$ofs-"; 1469 $hdr{"range"} = "bytes=$ofs-";
1367 } 1470 }
1368 1471
1369 http_get $url, 1472 http_get $url,

Diff Legend

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