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.102 by root, Sat Feb 19 06:46:14 2011 UTC vs.
Revision 1.113 by root, Sat Jan 12 15:41:35 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.04'; 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;
… …
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
… …
168they won't be sent at all). 168they won't be sent at all).
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
174Also, make sure that your headers names and values do not contain any
175embedded newlines.
173 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
… …
381 384
382Example: 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
383timeout of 30 seconds. 386timeout of 30 seconds.
384 387
385 http_request 388 http_request
386 GET => "https://www.google.com", 389 HEAD => "https://www.google.com",
387 headers => { "user-agent" => "MySearchClient 1.0" }, 390 headers => { "user-agent" => "MySearchClient 1.0" },
388 timeout => 30, 391 timeout => 30,
389 sub { 392 sub {
390 my ($body, $hdr) = @_; 393 my ($body, $hdr) = @_;
391 use Data::Dumper; 394 use Data::Dumper;
… …
773 if length $arg{body} || $method ne "GET"; 776 if length $arg{body} || $method ne "GET";
774 777
775 my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/; 778 my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/;
776 779
777 # 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
778 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : $idempotent; 781 my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent;
779 my $keepalive10 = exists $arg{keepalive10} ? $arg{keepalive10} : !$proxy; 782 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : !$proxy;
780 my $keptalive; # true if this is actually a recycled connection 783 my $was_persistent; # true if this is actually a recycled connection
781 784
782 # the key to use in the keepalive cache 785 # the key to use in the keepalive cache
783 my $ka_key = "$uhost\x00$arg{sessionid}"; 786 my $ka_key = "$uscheme\x00$uhost\x00$uport\x00$arg{sessionid}";
784 787
785 $hdr{connection} = ($keepalive ? $keepalive10 ? "keep-alive " : "" : "close ") . "Te"; #1.1 788 $hdr{connection} = ($persistent ? $keepalive ? "keep-alive " : "" : "close ") . "Te"; #1.1
786 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1 789 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
787 790
788 my %state = (connect_guard => 1); 791 my %state = (connect_guard => 1);
789 792
790 my $ae_error = 595; # connecting 793 my $ae_error = 595; # connecting
… …
874 } elsif ($status == 307) { 877 } elsif ($status == 307) {
875 $redirect = 1; 878 $redirect = 1;
876 } 879 }
877 } 880 }
878 881
879 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) 882 my $finish = sub { # ($data, $err_status, $err_reason[, $persistent])
880 if ($state{handle}) { 883 if ($state{handle}) {
881 # handle keepalive 884 # handle keepalive
882 if ( 885 if (
883 $keepalive 886 $persistent
884 && $_[3] 887 && $_[3]
885 && ($hdr{HTTPVersion} < 1.1 888 && ($hdr{HTTPVersion} < 1.1
886 ? $hdr{connection} =~ /\bkeep-?alive\b/i 889 ? $hdr{connection} =~ /\bkeep-?alive\b/i
887 : $hdr{connection} !~ /\bclose\b/i) 890 : $hdr{connection} !~ /\bclose\b/i)
888 ) { 891 ) {
… …
907 910
908 if ($redirect && exists $hdr{location}) { 911 if ($redirect && exists $hdr{location}) {
909 # we ignore any errors, as it is very common to receive 912 # we ignore any errors, as it is very common to receive
910 # Content-Length != 0 but no actual body 913 # Content-Length != 0 but no actual body
911 # we also access %hdr, as $_[1] might be an erro 914 # we also access %hdr, as $_[1] might be an erro
915 $state{recurse} =
912 http_request ( 916 http_request (
913 $method => $hdr{location}, 917 $method => $hdr{location},
914 %arg, 918 %arg,
915 recurse => $recurse - 1, 919 recurse => $recurse - 1,
916 Redirect => [$_[0], \%hdr], 920 Redirect => [$_[0], \%hdr],
921 sub {
922 %state = ();
917 $cb 923 &$cb
924 },
918 ); 925 );
919 } else { 926 } else {
920 $cb->($_[0], \%hdr); 927 $cb->($_[0], \%hdr);
921 } 928 }
922 }; 929 };
923 930
… …
955 my $body = ""; 962 my $body = "";
956 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 963 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
957 964
958 $state{read_chunk} = sub { 965 $state{read_chunk} = sub {
959 $_[1] =~ /^([0-9a-fA-F]+)/ 966 $_[1] =~ /^([0-9a-fA-F]+)/
960 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 967 or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
961 968
962 my $len = hex $1; 969 my $len = hex $1;
963 970
964 if ($len) { 971 if ($len) {
965 $cl += $len; 972 $cl += $len;
… …
1035 } 1042 }
1036 }; 1043 };
1037 1044
1038 # if keepalive is enabled, then the server closing the connection 1045 # if keepalive is enabled, then the server closing the connection
1039 # before a response can happen legally - we retry on idempotent methods. 1046 # before a response can happen legally - we retry on idempotent methods.
1040 if ($keptalive && $idempotent) { 1047 if ($was_persistent && $idempotent) {
1041 my $old_eof = $hdl->{on_eof}; 1048 my $old_eof = $hdl->{on_eof};
1042 $hdl->{on_eof} = sub { 1049 $hdl->{on_eof} = sub {
1043 _destroy_state %state; 1050 _destroy_state %state;
1044 1051
1052 %state = ();
1053 $state{recurse} =
1045 http_request ( 1054 http_request (
1046 $method => $url, 1055 $method => $url,
1047 %arg, 1056 %arg,
1057 recurse => $recurse - 1,
1048 keepalive => 0, 1058 keepalive => 0,
1059 sub {
1060 %state = ();
1049 $cb 1061 &$cb
1062 }
1050 ); 1063 );
1051 }; 1064 };
1052 $hdl->on_read (sub { 1065 $hdl->on_read (sub {
1053 return unless %state; 1066 return unless %state;
1054 1067
1055 # as soon as we receive something, a connection close 1068 # as soon as we receive something, a connection close
… …
1063 }; 1076 };
1064 1077
1065 my $prepare_handle = sub { 1078 my $prepare_handle = sub {
1066 my ($hdl) = $state{handle}; 1079 my ($hdl) = $state{handle};
1067 1080
1068 $hdl->timeout ($timeout);
1069 $hdl->on_error (sub { 1081 $hdl->on_error (sub {
1070 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] }; 1082 _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] };
1071 }); 1083 });
1072 $hdl->on_eof (sub { 1084 $hdl->on_eof (sub {
1073 _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" };
1074 }); 1086 });
1087 $hdl->timeout_reset;
1088 $hdl->timeout ($timeout);
1075 }; 1089 };
1076 1090
1077 # connected to proxy (or origin server) 1091 # connected to proxy (or origin server)
1078 my $connect_cb = sub { 1092 my $connect_cb = sub {
1079 my $fh = shift 1093 my $fh = shift
… …
1120 1134
1121 return unless $state{connect_guard}; 1135 return unless $state{connect_guard};
1122 1136
1123 # 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
1124 # 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).
1125 if ($keepalive && $KA_CACHE{$ka_key}) { 1139 if ($persistent && $KA_CACHE{$ka_key}) {
1126 $keptalive = 1; 1140 $was_persistent = 1;
1141
1127 $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#
1128 $prepare_handle->(); 1145 $prepare_handle->();
1146 $state{handle}->destroyed
1147 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
1129 $handle_actual_request->(); 1148 $handle_actual_request->();
1130 1149
1131 } else { 1150 } else {
1132 my $tcp_connect = $arg{tcp_connect} 1151 my $tcp_connect = $arg{tcp_connect}
1133 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; 1152 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
… …
1175Sets 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
1176string of the form C<http://host:port>, croaks otherwise. 1195string of the form C<http://host:port>, croaks otherwise.
1177 1196
1178To clear an already-set proxy, use C<undef>. 1197To clear an already-set proxy, use C<undef>.
1179 1198
1180When AnyEvent::HTTP is laoded for the first time it will query the 1199When AnyEvent::HTTP is loaded for the first time it will query the
1181default proxy from the operating system, currently by looking at 1200default proxy from the operating system, currently by looking at
1182C<$ENV{http_proxy>}. 1201C<$ENV{http_proxy>}.
1183 1202
1184=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end] 1203=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end]
1185 1204
… …
1235 1254
1236The default value for the C<recurse> request parameter (default: C<10>). 1255The default value for the C<recurse> request parameter (default: C<10>).
1237 1256
1238=item $AnyEvent::HTTP::TIMEOUT 1257=item $AnyEvent::HTTP::TIMEOUT
1239 1258
1240The default timeout for conenction operations (default: C<300>). 1259The default timeout for connection operations (default: C<300>).
1241 1260
1242=item $AnyEvent::HTTP::USERAGENT 1261=item $AnyEvent::HTTP::USERAGENT
1243 1262
1244The default value for the C<User-Agent> header (the default is 1263The default value for the C<User-Agent> header (the default is
1245C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 1264C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
… …
1310 # other formats fail in the loop below 1329 # other formats fail in the loop below
1311 1330
1312 for (0..11) { 1331 for (0..11) {
1313 if ($m eq $month[$_]) { 1332 if ($m eq $month[$_]) {
1314 require Time::Local; 1333 require Time::Local;
1315 return Time::Local::timegm ($S, $M, $H, $d, $_, $y); 1334 return eval { Time::Local::timegm ($S, $M, $H, $d, $_, $y) };
1316 } 1335 }
1317 } 1336 }
1318 1337
1319 undef 1338 undef
1320} 1339}
… …
1366 1385
1367 warn stat $fh; 1386 warn stat $fh;
1368 warn -s _; 1387 warn -s _;
1369 if (stat $fh and -s _) { 1388 if (stat $fh and -s _) {
1370 $ofs = -s _; 1389 $ofs = -s _;
1371 warn "-s is ", $ofs;#d# 1390 warn "-s is ", $ofs;
1372 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9]; 1391 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
1373 $hdr{"range"} = "bytes=$ofs-"; 1392 $hdr{"range"} = "bytes=$ofs-";
1374 } 1393 }
1375 1394
1376 http_get $url, 1395 http_get $url,

Diff Legend

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