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.101 by root, Wed Feb 16 16:34:34 2011 UTC vs.
Revision 1.115 by root, Fri Jan 18 22:55:39 2013 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.03'; 51our $VERSION = '2.15';
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;
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 161
162=item headers => hashref 162=item headers => hashref
163 163
164The request headers to use. Currently, C<http_request> may provide its own 164The request headers to use. Currently, C<http_request> may provide its own
165C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and 165C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and
169 169
170You really should provide your own C<User-Agent:> header value that is 170You really should provide your own C<User-Agent:> header value that is
171appropriate for your program - I wouldn't be surprised if the default 171appropriate for your program - I wouldn't be surprised if the default
172AnyEvent string gets blocked by webservers sooner or later. 172AnyEvent string gets blocked by webservers sooner or later.
173 173
174Also, make sure that your headers names and values do not contain any
175embedded newlines.
176
174=item timeout => $seconds 177=item timeout => $seconds
175 178
176The time-out to use for various stages - each connect attempt will reset 179The 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 180the timeout, as will read or write activity, i.e. this is not an overall
178timeout. 181timeout.
179 182
180Default timeout is 5 minutes. 183Default timeout is 5 minutes.
181 184
182=item proxy => [$host, $port[, $scheme]] or undef 185=item proxy => [$host, $port[, $scheme]] or undef
183 186
184Use the given http proxy for all requests. If not specified, then the 187Use 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. 188used.
186 189
187C<$scheme> must be either missing or must be C<http> for HTTP. 190C<$scheme> must be either missing or must be C<http> for HTTP.
191
192If not specified, then the default proxy is used (see
193C<AnyEvent::HTTP::set_proxy>).
188 194
189=item body => $string 195=item body => $string
190 196
191The request body, usually empty. Will be sent as-is (future versions of 197The request body, usually empty. Will be sent as-is (future versions of
192this module might offer more options). 198this module might offer more options).
378 384
379Example: do a HTTP HEAD request on https://www.google.com/, use a 385Example: do a HTTP HEAD request on https://www.google.com/, use a
380timeout of 30 seconds. 386timeout of 30 seconds.
381 387
382 http_request 388 http_request
383 GET => "https://www.google.com", 389 HEAD => "https://www.google.com",
384 headers => { "user-agent" => "MySearchClient 1.0" }, 390 headers => { "user-agent" => "MySearchClient 1.0" },
385 timeout => 30, 391 timeout => 30,
386 sub { 392 sub {
387 my ($body, $hdr) = @_; 393 my ($body, $hdr) = @_;
388 use Data::Dumper; 394 use Data::Dumper;
709 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE; 715 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
710 716
711 return $cb->(undef, { @pseudo, Status => 599, Reason => "Too many redirections" }) 717 return $cb->(undef, { @pseudo, Status => 599, Reason => "Too many redirections" })
712 if $recurse < 0; 718 if $recurse < 0;
713 719
714 my $proxy = $arg{proxy} || $PROXY; 720 my $proxy = exists $arg{proxy} ? $arg{proxy} : $PROXY;
715 my $timeout = $arg{timeout} || $TIMEOUT; 721 my $timeout = $arg{timeout} || $TIMEOUT;
716 722
717 my ($uscheme, $uauthority, $upath, $query, undef) = # ignore fragment 723 my ($uscheme, $uauthority, $upath, $query, undef) = # ignore fragment
718 $url =~ m|^([^:]+):(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?$|; 724 $url =~ m|^([^:]+):(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?$|;
719 725
770 if length $arg{body} || $method ne "GET"; 776 if length $arg{body} || $method ne "GET";
771 777
772 my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/; 778 my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/;
773 779
774 # default value for keepalive is true iff the request is for an idempotent method 780 # default value for keepalive is true iff the request is for an idempotent method
775 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : $idempotent; 781 my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent;
776 my $keepalive10 = exists $arg{keepalive10} ? $arg{keepalive10} : !$proxy; 782 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : !$proxy;
777 my $keptalive; # true if this is actually a recycled connection 783 my $was_persistent; # true if this is actually a recycled connection
778 784
779 # the key to use in the keepalive cache 785 # the key to use in the keepalive cache
780 my $ka_key = "$uhost\x00$arg{sessionid}"; 786 my $ka_key = "$uscheme\x00$uhost\x00$uport\x00$arg{sessionid}";
781 787
782 $hdr{connection} = ($keepalive ? $keepalive10 ? "keep-alive " : "" : "close ") . "Te"; #1.1 788 $hdr{connection} = ($persistent ? $keepalive ? "keep-alive " : "" : "close ") . "Te"; #1.1
783 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1 789 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
784 790
785 my %state = (connect_guard => 1); 791 my %state = (connect_guard => 1);
786 792
787 my $ae_error = 595; # connecting 793 my $ae_error = 595; # connecting
871 } elsif ($status == 307) { 877 } elsif ($status == 307) {
872 $redirect = 1; 878 $redirect = 1;
873 } 879 }
874 } 880 }
875 881
876 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) 882 my $finish = sub { # ($data, $err_status, $err_reason[, $persistent])
877 if ($state{handle}) { 883 if ($state{handle}) {
878 # handle keepalive 884 # handle keepalive
879 if ( 885 if (
880 $keepalive 886 $persistent
881 && $_[3] 887 && $_[3]
882 && ($hdr{HTTPVersion} < 1.1 888 && ($hdr{HTTPVersion} < 1.1
883 ? $hdr{connection} =~ /\bkeep-?alive\b/i 889 ? $hdr{connection} =~ /\bkeep-?alive\b/i
884 : $hdr{connection} !~ /\bclose\b/i) 890 : $hdr{connection} !~ /\bclose\b/i)
885 ) { 891 ) {
904 910
905 if ($redirect && exists $hdr{location}) { 911 if ($redirect && exists $hdr{location}) {
906 # we ignore any errors, as it is very common to receive 912 # we ignore any errors, as it is very common to receive
907 # Content-Length != 0 but no actual body 913 # Content-Length != 0 but no actual body
908 # we also access %hdr, as $_[1] might be an erro 914 # we also access %hdr, as $_[1] might be an erro
915 $state{recurse} =
909 http_request ( 916 http_request (
910 $method => $hdr{location}, 917 $method => $hdr{location},
911 %arg, 918 %arg,
912 recurse => $recurse - 1, 919 recurse => $recurse - 1,
913 Redirect => [$_[0], \%hdr], 920 Redirect => [$_[0], \%hdr],
921 sub {
922 %state = ();
914 $cb 923 &$cb
924 },
915 ); 925 );
916 } else { 926 } else {
917 $cb->($_[0], \%hdr); 927 $cb->($_[0], \%hdr);
918 } 928 }
919 }; 929 };
920 930
952 my $body = ""; 962 my $body = "";
953 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 963 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
954 964
955 $state{read_chunk} = sub { 965 $state{read_chunk} = sub {
956 $_[1] =~ /^([0-9a-fA-F]+)/ 966 $_[1] =~ /^([0-9a-fA-F]+)/
957 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 967 or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
958 968
959 my $len = hex $1; 969 my $len = hex $1;
960 970
961 if ($len) { 971 if ($len) {
962 $cl += $len; 972 $cl += $len;
1032 } 1042 }
1033 }; 1043 };
1034 1044
1035 # if keepalive is enabled, then the server closing the connection 1045 # if keepalive is enabled, then the server closing the connection
1036 # before a response can happen legally - we retry on idempotent methods. 1046 # before a response can happen legally - we retry on idempotent methods.
1037 if ($keptalive && $idempotent) { 1047 if ($was_persistent && $idempotent) {
1038 my $old_eof = $hdl->{on_eof}; 1048 my $old_eof = $hdl->{on_eof};
1039 $hdl->{on_eof} = sub { 1049 $hdl->{on_eof} = sub {
1040 _destroy_state %state; 1050 _destroy_state %state;
1041 1051
1052 %state = ();
1053 $state{recurse} =
1042 http_request ( 1054 http_request (
1043 $method => $url, 1055 $method => $url,
1044 %arg, 1056 %arg,
1057 recurse => $recurse - 1,
1045 keepalive => 0, 1058 keepalive => 0,
1059 sub {
1060 %state = ();
1046 $cb 1061 &$cb
1062 }
1047 ); 1063 );
1048 }; 1064 };
1049 $hdl->on_read (sub { 1065 $hdl->on_read (sub {
1050 return unless %state; 1066 return unless %state;
1051 1067
1052 # as soon as we receive something, a connection close 1068 # as soon as we receive something, a connection close
1060 }; 1076 };
1061 1077
1062 my $prepare_handle = sub { 1078 my $prepare_handle = sub {
1063 my ($hdl) = $state{handle}; 1079 my ($hdl) = $state{handle};
1064 1080
1065 $hdl->timeout ($timeout);
1066 $hdl->on_error (sub { 1081 $hdl->on_error (sub {
1067 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] }; 1082 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] };
1068 }); 1083 });
1069 $hdl->on_eof (sub { 1084 $hdl->on_eof (sub {
1070 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" }; 1085 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" };
1071 }); 1086 });
1087 $hdl->timeout_reset;
1088 $hdl->timeout ($timeout);
1072 }; 1089 };
1073 1090
1074 # connected to proxy (or origin server) 1091 # connected to proxy (or origin server)
1075 my $connect_cb = sub { 1092 my $connect_cb = sub {
1076 my $fh = shift 1093 my $fh = shift
1117 1134
1118 return unless $state{connect_guard}; 1135 return unless $state{connect_guard};
1119 1136
1120 # try to use an existing keepalive connection, but only if we, ourselves, plan 1137 # 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). 1138 # on a keepalive request (in theory, this should be a separate config option).
1122 if ($keepalive && $KA_CACHE{$ka_key}) { 1139 if ($persistent && $KA_CACHE{$ka_key}) {
1123 $keptalive = 1; 1140 $was_persistent = 1;
1141
1124 $state{handle} = ka_fetch $ka_key; 1142 $state{handle} = ka_fetch $ka_key;
1143 $state{handle}->destroyed
1144 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
1125 $prepare_handle->(); 1145 $prepare_handle->();
1146 $state{handle}->destroyed
1147 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
1126 $handle_actual_request->(); 1148 $handle_actual_request->();
1127 1149
1128 } else { 1150 } else {
1129 my $tcp_connect = $arg{tcp_connect} 1151 my $tcp_connect = $arg{tcp_connect}
1130 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; 1152 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
1172Sets the default proxy server to use. The proxy-url must begin with a 1194Sets the default proxy server to use. The proxy-url must begin with a
1173string of the form C<http://host:port>, croaks otherwise. 1195string of the form C<http://host:port>, croaks otherwise.
1174 1196
1175To clear an already-set proxy, use C<undef>. 1197To clear an already-set proxy, use C<undef>.
1176 1198
1199When AnyEvent::HTTP is loaded for the first time it will query the
1200default proxy from the operating system, currently by looking at
1201C<$ENV{http_proxy>}.
1202
1177=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end] 1203=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end]
1178 1204
1179Remove all cookies from the cookie jar that have been expired. If 1205Remove all cookies from the cookie jar that have been expired. If
1180C<$session_end> is given and true, then additionally remove all session 1206C<$session_end> is given and true, then additionally remove all session
1181cookies. 1207cookies.
1190 1216
1191The key C<version> has to contain C<1>, otherwise the hash gets 1217The key C<version> has to contain C<1>, otherwise the hash gets
1192emptied. All other keys are hostnames or IP addresses pointing to 1218emptied. All other keys are hostnames or IP addresses pointing to
1193hash-references. The key for these inner hash references is the 1219hash-references. The key for these inner hash references is the
1194server path for which this cookie is meant, and the values are again 1220server 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 1221hash-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 1222the 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>, 1223key-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 1224which have been replaced by a C<_expires> key that contains the cookie
1199expiry timestamp. 1225expiry timestamp. Session cookies are indicated by not having an
1226C<_expires> key.
1200 1227
1201Here is an example of a cookie jar with a single cookie, so you have a 1228Here is an example of a cookie jar with a single cookie, so you have a
1202chance of understanding the above paragraph: 1229chance of understanding the above paragraph:
1203 1230
1204 { 1231 {
1228 1255
1229The default value for the C<recurse> request parameter (default: C<10>). 1256The default value for the C<recurse> request parameter (default: C<10>).
1230 1257
1231=item $AnyEvent::HTTP::TIMEOUT 1258=item $AnyEvent::HTTP::TIMEOUT
1232 1259
1233The default timeout for conenction operations (default: C<300>). 1260The default timeout for connection operations (default: C<300>).
1234 1261
1235=item $AnyEvent::HTTP::USERAGENT 1262=item $AnyEvent::HTTP::USERAGENT
1236 1263
1237The default value for the C<User-Agent> header (the default is 1264The 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)>). 1265C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
1303 # other formats fail in the loop below 1330 # other formats fail in the loop below
1304 1331
1305 for (0..11) { 1332 for (0..11) {
1306 if ($m eq $month[$_]) { 1333 if ($m eq $month[$_]) {
1307 require Time::Local; 1334 require Time::Local;
1308 return Time::Local::timegm ($S, $M, $H, $d, $_, $y); 1335 return eval { Time::Local::timegm ($S, $M, $H, $d, $_, $y) };
1309 } 1336 }
1310 } 1337 }
1311 1338
1312 undef 1339 undef
1313} 1340}
1359 1386
1360 warn stat $fh; 1387 warn stat $fh;
1361 warn -s _; 1388 warn -s _;
1362 if (stat $fh and -s _) { 1389 if (stat $fh and -s _) {
1363 $ofs = -s _; 1390 $ofs = -s _;
1364 warn "-s is ", $ofs;#d# 1391 warn "-s is ", $ofs;
1365 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9]; 1392 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
1366 $hdr{"range"} = "bytes=$ofs-"; 1393 $hdr{"range"} = "bytes=$ofs-";
1367 } 1394 }
1368 1395
1369 http_get $url, 1396 http_get $url,

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines