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.120 by root, Sun Jun 8 23:36:36 2014 UTC vs.
Revision 1.127 by root, Sun Aug 28 09:31:29 2016 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.21; 51our $VERSION = 2.23;
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;
… …
194 194
195C<$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 196
197If not specified, then the default proxy is used (see 197If not specified, then the default proxy is used (see
198C<AnyEvent::HTTP::set_proxy>). 198C<AnyEvent::HTTP::set_proxy>).
199
200Currently, if your proxy requires authorization, you have to specify an
201appropriate "Proxy-Authorization" header in every request.
199 202
200=item body => $string 203=item body => $string
201 204
202The request body, usually empty. Will be sent as-is (future versions of 205The request body, usually empty. Will be sent as-is (future versions of
203this module might offer more options). 206this module might offer more options).
… …
770 773
771 my $uport = $uscheme eq "http" ? 80 774 my $uport = $uscheme eq "http" ? 80
772 : $uscheme eq "https" ? 443 775 : $uscheme eq "https" ? 443
773 : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" }); 776 : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" });
774 777
775 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 778 $uauthority =~ /^(?: .*\@ )? ([^\@]+?) (?: : (\d+) )?$/x
776 or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" }); 779 or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" });
777 780
778 my $uhost = lc $1; 781 my $uhost = lc $1;
779 $uport = $2 if defined $2; 782 $uport = $2 if defined $2;
780 783
… …
892 # we give our best and fall back to URI if available. 895 # we give our best and fall back to URI if available.
893 if (exists $hdr{location}) { 896 if (exists $hdr{location}) {
894 my $loc = $hdr{location}; 897 my $loc = $hdr{location};
895 898
896 if ($loc =~ m%^//%) { # // 899 if ($loc =~ m%^//%) { # //
897 $loc = "$rscheme:$loc"; 900 $loc = "$uscheme:$loc";
898 901
899 } elsif ($loc eq "") { 902 } elsif ($loc eq "") {
900 $loc = $url; 903 $loc = $url;
901 904
902 } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple" 905 } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple"
903 $loc =~ s/^\.\/+//; 906 $loc =~ s/^\.\/+//;
904 907
905 if ($loc !~ m%^[.?#]%) { 908 if ($loc !~ m%^[.?#]%) {
906 my $prefix = "$rscheme://$uhost:$uport"; 909 my $prefix = "$uscheme://$uhost:$uport";
907 910
908 unless ($loc =~ s/^\///) { 911 unless ($loc =~ s/^\///) {
909 $prefix .= $upath; 912 $prefix .= $upath;
910 $prefix =~ s/\/[^\/]*$//; 913 $prefix =~ s/\/[^\/]*$//;
911 } 914 }
… …
934 # industry standard is to redirect POST as GET for 937 # industry standard is to redirect POST as GET for
935 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1. 938 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1.
936 # also, the UA should ask the user for 301 and 307 and POST, 939 # also, the UA should ask the user for 301 and 307 and POST,
937 # industry standard seems to be to simply follow. 940 # industry standard seems to be to simply follow.
938 # we go with the industry standard. 308 is defined 941 # we go with the industry standard. 308 is defined
939 # by rfc7238 942 # by rfc7538
940 if ($status == 301 or $status == 302 or $status == 303) { 943 if ($status == 301 or $status == 302 or $status == 303) {
944 $redirect = 1;
941 # HTTP/1.1 is unclear on how to mutate the method 945 # HTTP/1.1 is unclear on how to mutate the method
942 $method = "GET" unless $method eq "HEAD"; 946 unless ($method eq "HEAD") {
943 $redirect = 1; 947 $method = "GET";
948 delete $arg{body};
949 }
944 } elsif ($status == 307 or $status == 308) { 950 } elsif ($status == 307 or $status == 308) {
945 $redirect = 1; 951 $redirect = 1;
946 } 952 }
947 } 953 }
948 954
… …
1117 _destroy_state %state; 1123 _destroy_state %state;
1118 1124
1119 %state = (); 1125 %state = ();
1120 $state{recurse} = 1126 $state{recurse} =
1121 http_request ( 1127 http_request (
1122 $method => $url, 1128 $method => $url,
1123 %arg, 1129 %arg,
1124 recurse => $recurse - 1, 1130 recurse => $recurse - 1,
1125 keepalive => 0, 1131 persistent => 0,
1126 sub { 1132 sub {
1127 %state = (); 1133 %state = ();
1128 &$cb 1134 &$cb
1129 } 1135 }
1130 ); 1136 );
… …
1176 1182
1177 # now handle proxy-CONNECT method 1183 # now handle proxy-CONNECT method
1178 if ($proxy && $uscheme eq "https") { 1184 if ($proxy && $uscheme eq "https") {
1179 # oh dear, we have to wrap it into a connect request 1185 # oh dear, we have to wrap it into a connect request
1180 1186
1187 my $auth = exists $hdr{"proxy-authorization"}
1188 ? "proxy-authorization: " . (delete $hdr{"proxy-authorization"}) . "\015\012"
1189 : "";
1190
1181 # maybe re-use $uauthority with patched port? 1191 # maybe re-use $uauthority with patched port?
1182 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012"); 1192 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012$auth\015\012");
1183 $state{handle}->push_read (line => $qr_nlnl, sub { 1193 $state{handle}->push_read (line => $qr_nlnl, sub {
1184 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 1194 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
1185 or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" }; 1195 or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" };
1186 1196
1187 if ($2 == 200) { 1197 if ($2 == 200) {
… …
1190 } else { 1200 } else {
1191 _error %state, $cb, { @pseudo, Status => $2, Reason => $3 }; 1201 _error %state, $cb, { @pseudo, Status => $2, Reason => $3 };
1192 } 1202 }
1193 }); 1203 });
1194 } else { 1204 } else {
1205 delete $hdr{"proxy-authorization"} unless $proxy;
1206
1195 $handle_actual_request->(); 1207 $handle_actual_request->();
1196 } 1208 }
1197 }; 1209 };
1198 1210
1199 _get_slot $uhost, sub { 1211 _get_slot $uhost, sub {
… …
1277save cookies to disk, and you should call this function after loading them 1289save cookies to disk, and you should call this function after loading them
1278again. If you have a long-running program you can additionally call this 1290again. If you have a long-running program you can additionally call this
1279function from time to time. 1291function from time to time.
1280 1292
1281A cookie jar is initially an empty hash-reference that is managed by this 1293A cookie jar is initially an empty hash-reference that is managed by this
1282module. It's format is subject to change, but currently it is like this: 1294module. Its format is subject to change, but currently it is as follows:
1283 1295
1284The key C<version> has to contain C<1>, otherwise the hash gets 1296The key C<version> has to contain C<1>, otherwise the hash gets
1285emptied. All other keys are hostnames or IP addresses pointing to 1297emptied. All other keys are hostnames or IP addresses pointing to
1286hash-references. The key for these inner hash references is the 1298hash-references. The key for these inner hash references is the
1287server path for which this cookie is meant, and the values are again 1299server path for which this cookie is meant, and the values are again
… …
1332C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 1344C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
1333 1345
1334=item $AnyEvent::HTTP::MAX_PER_HOST 1346=item $AnyEvent::HTTP::MAX_PER_HOST
1335 1347
1336The maximum number of concurrent connections to the same host (identified 1348The maximum number of concurrent connections to the same host (identified
1337by the hostname). If the limit is exceeded, then the additional requests 1349by the hostname). If the limit is exceeded, then additional requests
1338are queued until previous connections are closed. Both persistent and 1350are queued until previous connections are closed. Both persistent and
1339non-persistent connections are counted in this limit. 1351non-persistent connections are counted in this limit.
1340 1352
1341The default value for this is C<4>, and it is highly advisable to not 1353The default value for this is C<4>, and it is highly advisable to not
1342increase it much. 1354increase it much.
… …
1449 or die "$file: $!"; 1461 or die "$file: $!";
1450 1462
1451 my %hdr; 1463 my %hdr;
1452 my $ofs = 0; 1464 my $ofs = 0;
1453 1465
1454 warn stat $fh;
1455 warn -s _;
1456 if (stat $fh and -s _) { 1466 if (stat $fh and -s _) {
1457 $ofs = -s _; 1467 $ofs = -s _;
1458 warn "-s is ", $ofs; 1468 warn "-s is ", $ofs;
1459 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9]; 1469 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
1460 $hdr{"range"} = "bytes=$ofs-"; 1470 $hdr{"range"} = "bytes=$ofs-";
… …
1488 my (undef, $hdr) = @_; 1498 my (undef, $hdr) = @_;
1489 1499
1490 my $status = $hdr->{Status}; 1500 my $status = $hdr->{Status};
1491 1501
1492 if (my $time = AnyEvent::HTTP::parse_date $hdr->{"last-modified"}) { 1502 if (my $time = AnyEvent::HTTP::parse_date $hdr->{"last-modified"}) {
1493 utime $fh, $time, $time; 1503 utime $time, $time, $fh;
1494 } 1504 }
1495 1505
1496 if ($status == 200 || $status == 206 || $status == 416) { 1506 if ($status == 200 || $status == 206 || $status == 416) {
1497 # download ok || resume ok || file already fully downloaded 1507 # download ok || resume ok || file already fully downloaded
1498 $cb->(1, $hdr); 1508 $cb->(1, $hdr);

Diff Legend

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