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.41 by root, Sun Jul 5 23:50:59 2009 UTC vs.
Revision 1.59 by root, Wed Dec 29 23:59:36 2010 UTC

… …
41use strict; 41use strict;
42no warnings; 42no warnings;
43 43
44use Errno (); 44use Errno ();
45 45
46use AnyEvent 4.452 (); 46use AnyEvent 5.0 ();
47use AnyEvent::Util (); 47use AnyEvent::Util ();
48use AnyEvent::Socket ();
49use AnyEvent::Handle (); 48use AnyEvent::Handle ();
50 49
51use base Exporter::; 50use base Exporter::;
52 51
53our $VERSION = '1.12'; 52our $VERSION = '1.46';
54 53
55our @EXPORT = qw(http_get http_post http_head http_request); 54our @EXPORT = qw(http_get http_post http_head http_request);
56 55
57our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 56our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
58our $MAX_RECURSE = 10; 57our $MAX_RECURSE = 10;
59our $MAX_PERSISTENT = 8; 58our $MAX_PERSISTENT = 8;
60our $PERSISTENT_TIMEOUT = 2; 59our $PERSISTENT_TIMEOUT = 2;
61our $TIMEOUT = 300; 60our $TIMEOUT = 300;
62 61
63# changing these is evil 62# changing these is evil
64our $MAX_PERSISTENT_PER_HOST = 2; 63our $MAX_PERSISTENT_PER_HOST = 0;
65our $MAX_PER_HOST = 4; 64our $MAX_PER_HOST = 4;
66 65
67our $PROXY; 66our $PROXY;
68our $ACTIVE = 0; 67our $ACTIVE = 0;
69 68
… …
92must be an absolute http or https URL. 91must be an absolute http or https URL.
93 92
94When called in void context, nothing is returned. In other contexts, 93When called in void context, nothing is returned. In other contexts,
95C<http_request> returns a "cancellation guard" - you have to keep the 94C<http_request> returns a "cancellation guard" - you have to keep the
96object 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
97destroyed before the callbakc is called, the request will be cancelled. 96destroyed before the callback is called, the request will be cancelled.
98 97
99The callback will be called with the response data as first argument 98The callback will be called with the response body data as first argument
100(or C<undef> if it wasn't available due to errors), and a hash-ref with 99(or C<undef> if an error occured), and a hash-ref with response headers as
101response headers as second argument. 100second argument.
102 101
103All 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
104headers, the "pseudo-headers" C<HTTPVersion>, C<Status> and C<Reason> 103headers, the "pseudo-headers" (uppercase to avoid clashing with possible
104response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the
105contain the three parts of the HTTP Status-Line of the same name. The 105three parts of the HTTP Status-Line of the same name.
106
106pseudo-header C<URL> contains the original URL (which can differ from the 107The pseudo-header C<URL> contains the actual URL (which can differ from
107requested URL when following redirects). 108the requested URL when following redirects - for example, you might get
109an error that your URL scheme is not supported even though your URL is a
110valid http URL because it redirected to an ftp URL, in which case you can
111look at the URL pseudo header).
112
113The pseudo-header C<Redirect> only exists when the request was a result
114of an internal redirect. In that case it is an array reference with
115the C<($data, $headers)> from the redirect response. Note that this
116response could in turn be the result of a redirect itself, and C<<
117$headers->{Redirect}[1]{Redirect} >> will then contain the original
118response, and so on.
108 119
109If the server sends a header multiple times, then their contents will be 120If the server sends a header multiple times, then their contents will be
110joined together with a comma (C<,>), as per the HTTP spec. 121joined together with a comma (C<,>), as per the HTTP spec.
111 122
112If an internal error occurs, such as not being able to resolve a hostname, 123If an internal error occurs, such as not being able to resolve a hostname,
… …
138 149
139=item headers => hashref 150=item headers => hashref
140 151
141The request headers to use. Currently, C<http_request> may provide its 152The request headers to use. Currently, C<http_request> may provide its
142own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers 153own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers
143and will provide defaults for C<User-Agent:> and C<Referer:>. 154and will provide defaults for C<User-Agent:> and C<Referer:> (this can be
155suppressed by using C<undef> for these headers in which case they won't be
156sent at all).
144 157
145=item timeout => $seconds 158=item timeout => $seconds
146 159
147The time-out to use for various stages - each connect attempt will reset 160The time-out to use for various stages - each connect attempt will reset
148the timeout, as will read or write activity. Default timeout is 5 minutes. 161the timeout, as will read or write activity, i.e. this is not an overall
162timeout.
163
164Default timeout is 5 minutes.
149 165
150=item proxy => [$host, $port[, $scheme]] or undef 166=item proxy => [$host, $port[, $scheme]] or undef
151 167
152Use the given http proxy for all requests. If not specified, then the 168Use the given http proxy for all requests. If not specified, then the
153default proxy (as specified by C<$ENV{http_proxy}>) is used. 169default proxy (as specified by C<$ENV{http_proxy}>) is used.
154 170
155C<$scheme> must be either missing or C<http> for HTTP, or C<https> for 171C<$scheme> must be either missing, C<http> for HTTP or C<https> for
156HTTPS. 172HTTPS.
157 173
158=item body => $string 174=item body => $string
159 175
160The request body, usually empty. Will be-sent as-is (future versions of 176The request body, usually empty. Will be-sent as-is (future versions of
… …
186verification) TLS context. 202verification) TLS context.
187 203
188The default for this option is C<low>, which could be interpreted as "give 204The default for this option is C<low>, which could be interpreted as "give
189me the page, no matter what". 205me the page, no matter what".
190 206
207=item on_prepare => $callback->($fh)
208
209In rare cases you need to "tune" the socket before it is used to
210connect (for exmaple, to bind it on a given IP address). This parameter
211overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
212and behaves exactly the same way (e.g. it has to provide a
213timeout). See the description for the C<$prepare_cb> argument of
214C<AnyEvent::Socket::tcp_connect> for details.
215
216=item tcp_connect => $callback->($host, $service, $connect_cb, $prepare_cb)
217
218In even rarer cases you want total control over how AnyEvent::HTTP
219establishes connections. Normally it uses L<AnyEvent::Socket::tcp_connect>
220to do this, but you can provide your own C<tcp_connect> function -
221obviously, it has to follow the same calling conventions.
222
223There are probably lots of weird uses for this function, starting from
224tracing the hosts C<http_request> actually tries to connect, to (inexact
225but fast) host => IP address caching or even socks protocol support.
226
191=item on_header => $callback->($hdr) 227=item on_header => $callback->($headers)
192 228
193When specified, this callback will be called with the header hash as soon 229When specified, this callback will be called with the header hash as soon
194as headers have been successfully received from the remote server (not on 230as headers have been successfully received from the remote server (not on
195locally-generated errors). 231locally-generated errors).
196 232
… …
200 236
201This callback is useful, among other things, to quickly reject unwanted 237This callback is useful, among other things, to quickly reject unwanted
202content, which, if it is supposed to be rare, can be faster than first 238content, which, if it is supposed to be rare, can be faster than first
203doing a C<HEAD> request. 239doing a C<HEAD> request.
204 240
241Example: cancel the request unless the content-type is "text/html".
242
243 on_header => sub {
244 $_[0]{"content-type"} =~ /^text\/html\s*(?:;|$)/
245 },
246
205=item on_body => $callback->($data, $hdr) 247=item on_body => $callback->($partial_body, $headers)
206 248
207When specified, all body data will be "filtered" through this callback. 249When specified, all body data will be passed to this callback instead of
250to the completion callback. The completion callback will get the empty
251string instead of the body data.
208 252
209The callback will incrementally receive body data, and is supposed to 253It has to return either true (in which case AnyEvent::HTTP will continue),
210return it or a modified version of it (empty strings are valid returns). 254or false, in which case AnyEvent::HTTP will cancel the download (and call
255the completion callback with an error code of C<598>).
211 256
212If the callback returns C<undef>, then the request will be cancelled. 257This callback is useful when the data is too large to be held in memory
213 258(so the callback writes it to a file) or when only some information should
214This callback is useful when you want to do some processing on the data, 259be extracted, or when the body should be processed incrementally.
215or the data is too large to be held in memory (so the callback writes it
216to a file and returns the empty string) and so on.
217 260
218It is usually preferred over doing your own body handling via 261It is usually preferred over doing your own body handling via
219C<want_body_handle>. 262C<want_body_handle>, but in case of streaming APIs, where HTTP is
263only used to create a connection, C<want_body_handle> is the better
264alternative, as it allows you to install your own event handler, reducing
265resource usage.
220 266
221=item want_body_handle => $enable 267=item want_body_handle => $enable
222 268
223When enabled (default is disabled), the behaviour of AnyEvent::HTTP 269When enabled (default is disabled), the behaviour of AnyEvent::HTTP
224changes considerably: after parsing the headers, and instead of 270changes considerably: after parsing the headers, and instead of
… …
236This is useful with some push-type services, where, after the initial 282This is useful with some push-type services, where, after the initial
237headers, an interactive protocol is used (typical example would be the 283headers, an interactive protocol is used (typical example would be the
238push-style twitter API which starts a JSON/XML stream). 284push-style twitter API which starts a JSON/XML stream).
239 285
240If you think you need this, first have a look at C<on_body>, to see if 286If you think you need this, first have a look at C<on_body>, to see if
241that doesn'T solve your problem in a better way. 287that doesn't solve your problem in a better way.
242 288
243=back 289=back
244 290
245Example: make a simple HTTP GET request for http://www.nethype.de/ 291Example: make a simple HTTP GET request for http://www.nethype.de/
246 292
… …
302 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 348 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
303 349
304 _slot_schedule $_[0]; 350 _slot_schedule $_[0];
305} 351}
306 352
307our $qr_nl = qr<\015?\012>; 353our $qr_nlnl = qr{(?<![^\012])\015?\012};
308our $qr_nlnl = qr<\015?\012\015?\012>;
309 354
310our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 }; 355our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 };
311our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" }; 356our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
312 357
313sub http_request($$@) { 358sub http_request($$@) {
… …
325 while (my ($k, $v) = each %$hdr) { 370 while (my ($k, $v) = each %$hdr) {
326 $hdr{lc $k} = $v; 371 $hdr{lc $k} = $v;
327 } 372 }
328 } 373 }
329 374
375 # pseudo headers for all subsequent responses
376 my @pseudo = (URL => $url);
377 push @pseudo, Redirect => delete $arg{Redirect} if exists $arg{Redirect};
378
330 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE; 379 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
331 380
332 return $cb->(undef, { Status => 599, Reason => "Too many redirections", URL => $url }) 381 return $cb->(undef, { Status => 599, Reason => "Too many redirections", @pseudo })
333 if $recurse < 0; 382 if $recurse < 0;
334 383
335 my $proxy = $arg{proxy} || $PROXY; 384 my $proxy = $arg{proxy} || $PROXY;
336 my $timeout = $arg{timeout} || $TIMEOUT; 385 my $timeout = $arg{timeout} || $TIMEOUT;
337 386
338 my ($uscheme, $uauthority, $upath, $query, $fragment) = 387 my ($uscheme, $uauthority, $upath, $query, $fragment) =
339 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 388 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|;
340 389
341 $uscheme = lc $uscheme; 390 $uscheme = lc $uscheme;
342 391
343 my $uport = $uscheme eq "http" ? 80 392 my $uport = $uscheme eq "http" ? 80
344 : $uscheme eq "https" ? 443 393 : $uscheme eq "https" ? 443
345 : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", URL => $url }); 394 : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", @pseudo });
346 395
347 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 396 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
348 or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", URL => $url }); 397 or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", @pseudo });
349 398
350 my $uhost = $1; 399 my $uhost = $1;
351 $uport = $2 if defined $2; 400 $uport = $2 if defined $2;
352 401
402 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
403 unless exists $hdr{host};
404
353 $uhost =~ s/^\[(.*)\]$/$1/; 405 $uhost =~ s/^\[(.*)\]$/$1/;
354 $upath .= "?$query" if length $query; 406 $upath .= $query if length $query;
355 407
356 $upath =~ s%^/?%/%; 408 $upath =~ s%^/?%/%;
357 409
358 # cookie processing 410 # cookie processing
359 if (my $jar = $arg{cookie_jar}) { 411 if (my $jar = $arg{cookie_jar}) {
… …
389 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path 441 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path
390 442
391 if ($proxy) { 443 if ($proxy) {
392 ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy); 444 ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy);
393 445
446 $rscheme = "http" unless defined $rscheme;
447
394 # don't support https requests over https-proxy transport, 448 # don't support https requests over https-proxy transport,
395 # can't be done with tls as spec'ed, unless you double-encrypt. 449 # can't be done with tls as spec'ed, unless you double-encrypt.
396 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https"; 450 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https";
397 } else { 451 } else {
398 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); 452 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
399 } 453 }
400 454
401 $hdr{"user-agent"} ||= $USERAGENT; 455 # leave out fragment and query string, just a heuristic
402 $hdr{referer} ||= "$uscheme://$uauthority$upath"; # leave out fragment and query string, just a heuristic 456 $hdr{referer} ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer};
457 $hdr{"user-agent"} ||= $USERAGENT unless exists $hdr{"user-agent"};
403 458
404 $hdr{host} = "$uhost:$uport";
405 $hdr{"content-length"} = length $arg{body}; 459 $hdr{"content-length"} = length $arg{body}
460 if length $arg{body} || $method ne "GET";
406 461
407 my %state = (connect_guard => 1); 462 my %state = (connect_guard => 1);
408 463
409 _get_slot $uhost, sub { 464 _get_slot $uhost, sub {
410 $state{slot_guard} = shift; 465 $state{slot_guard} = shift;
411 466
412 return unless $state{connect_guard}; 467 return unless $state{connect_guard};
413 468
414 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { 469 my $tcp_connect = $arg{tcp_connect}
470 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
471
472 $state{connect_guard} = $tcp_connect->(
473 $rhost,
474 $rport,
475 sub {
415 $state{fh} = shift 476 $state{fh} = shift
477 or do {
478 my $err = "$!";
479 %state = ();
416 or return (%state = (), $cb->(undef, { Status => 599, Reason => "$!", URL => $url })); 480 return $cb->(undef, { Status => 599, Reason => $err, @pseudo });
481 };
482
417 pop; # free memory, save a tree 483 pop; # free memory, save a tree
418 484
419 return unless delete $state{connect_guard}; 485 return unless delete $state{connect_guard};
420 486
421 # get handle 487 # get handle
422 $state{handle} = new AnyEvent::Handle 488 $state{handle} = new AnyEvent::Handle
423 fh => $state{fh}, 489 fh => $state{fh},
490 peername => $rhost,
491 tls_ctx => $arg{tls_ctx},
492 # these need to be reconfigured on keepalive handles
424 timeout => $timeout, 493 timeout => $timeout,
425 peername => $rhost, 494 on_error => sub {
426 tls_ctx => $arg{tls_ctx}; 495 %state = ();
496 $cb->(undef, { Status => 599, Reason => $_[2], @pseudo });
497 },
498 on_eof => sub {
499 %state = ();
500 $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo });
501 },
502 ;
427 503
428 # limit the number of persistent connections 504 # limit the number of persistent connections
429 # keepalive not yet supported 505 # keepalive not yet supported
430 if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { 506# if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
431 ++$KA_COUNT{$_[1]}; 507# ++$KA_COUNT{$_[1]};
432 $state{handle}{ka_count_guard} = AnyEvent::Util::guard { 508# $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
433 --$KA_COUNT{$_[1]} 509# --$KA_COUNT{$_[1]}
434 }; 510# };
435 $hdr{connection} = "keep-alive"; 511# $hdr{connection} = "keep-alive";
436 } else { 512# } else {
437 delete $hdr{connection}; 513 delete $hdr{connection};
438 } 514# }
439 515
440 # (re-)configure handle
441 $state{handle}->on_error (sub {
442 %state = ();
443 $cb->(undef, { Status => 599, Reason => $_[2], URL => $url });
444 });
445 $state{handle}->on_eof (sub {
446 %state = ();
447 $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", URL => $url });
448 });
449
450 $state{handle}->starttls ("connect") if $rscheme eq "https"; 516 $state{handle}->starttls ("connect") if $rscheme eq "https";
451 517
452 # handle actual, non-tunneled, request 518 # handle actual, non-tunneled, request
453 my $handle_actual_request = sub { 519 my $handle_actual_request = sub {
454 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 520 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
455 521
456 # send request 522 # send request
457 $state{handle}->push_write ( 523 $state{handle}->push_write (
458 "$method $rpath HTTP/1.0\015\012" 524 "$method $rpath HTTP/1.0\015\012"
459 . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr) 525 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
460 . "\015\012" 526 . "\015\012"
461 . (delete $arg{body}) 527 . (delete $arg{body})
462 );
463
464 %hdr = (); # reduce memory usage, save a kitten
465
466 # status line
467 $state{handle}->push_read (line => $qr_nl, sub {
468 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
469 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response ($_[1])", URL => $url }));
470
471 my %hdr = ( # response headers
472 HTTPVersion => ",$1",
473 Status => ",$2",
474 Reason => ",$3",
475 URL => ",$url"
476 ); 528 );
477 529
478 # headers, could be optimized a bit 530 # return if error occured during push_write()
531 return unless %state;
532
533 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use
534
535 # status line and headers
479 $state{handle}->unshift_read (line => $qr_nlnl, sub { 536 $state{handle}->push_read (line => $qr_nlnl, sub {
480 for ("$_[1]\012") { 537 for ("$_[1]") {
481 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 538 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
539
540 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )? \015?\012/igxc
541 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response", @pseudo }));
542
543 push @pseudo,
544 HTTPVersion => $1,
545 Status => $2,
546 Reason => $3,
547 ;
482 548
483 # things seen, not parsed: 549 # things seen, not parsed:
484 # p3pP="NON CUR OTPi OUR NOR UNI" 550 # p3pP="NON CUR OTPi OUR NOR UNI"
485 551
486 $hdr{lc $1} .= ",$2" 552 $hdr{lc $1} .= ",$2"
487 while /\G 553 while /\G
488 ([^:\000-\037]+): 554 ([^:\000-\037]*):
489 [\011\040]* 555 [\011\040]*
490 ((?: [^\012]+ | \012[\011\040] )*) 556 ((?: [^\012]+ | \012[\011\040] )*)
491 \012 557 \012
492 /gxc; 558 /gxc;
493 559
494 /\G$/ 560 /\G$/
495 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", URL => $url })); 561 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", @pseudo }));
496 } 562 }
497 563
564 # remove the "," prefix we added to all headers above
498 substr $_, 0, 1, "" 565 substr $_, 0, 1, ""
499 for values %hdr; 566 for values %hdr;
567
568 # patch in all pseudo headers
569 %hdr = (%hdr, @pseudo);
500 570
501 # redirect handling 571 # redirect handling
502 # microsoft and other shitheads don't give a shit for following standards, 572 # microsoft and other shitheads don't give a shit for following standards,
503 # try to support some common forms of broken Location headers. 573 # try to support some common forms of broken Location headers.
504 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) { 574 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
… …
515 } 585 }
516 586
517 my $redirect; 587 my $redirect;
518 588
519 if ($recurse) { 589 if ($recurse) {
520 if ($hdr{Status} =~ /^30[12]$/ && $method ne "POST") { 590 my $status = $hdr{Status};
521 # apparently, mozilla et al. just change POST to GET here 591
522 # more research is needed before we do the same 592 # industry standard is to redirect POST as GET for
523 $redirect = 1; 593 # 301, 302 and 303, in contrast to http/1.0 and 1.1.
524 } elsif ($hdr{Status} == 303) { 594 # also, the UA should ask the user for 301 and 307 and POST,
595 # industry standard seems to be to simply follow.
596 # we go with the industry standard.
597 if ($status == 301 or $status == 302 or $status == 303) {
525 # even http/1.1 is unclear on how to mutate the method 598 # HTTP/1.1 is unclear on how to mutate the method
526 $method = "GET" unless $method eq "HEAD"; 599 $method = "GET" unless $method eq "HEAD";
527 $redirect = 1; 600 $redirect = 1;
528 } elsif ($hdr{Status} == 307 && $method =~ /^(?:GET|HEAD)$/) { 601 } elsif ($status == 307) {
529 $redirect = 1; 602 $redirect = 1;
530 } 603 }
531 } 604 }
532 605
533 my $finish = sub { 606 my $finish = sub {
… …
582 655
583 redo if /\G\s*,/gc; 656 redo if /\G\s*,/gc;
584 } 657 }
585 } 658 }
586 659
587 if ($redirect) { 660 if ($redirect && exists $hdr{location}) {
588 # we ignore any errors, as it is very common to receive 661 # we ignore any errors, as it is very common to receive
589 # Content-Length != 0 but no actual body 662 # Content-Length != 0 but no actual body
590 # we also access %hdr, as $_[1] might be an erro 663 # we also access %hdr, as $_[1] might be an erro
591 http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb); 664 http_request (
665 $method => $hdr{location},
666 %arg,
667 recurse => $recurse - 1,
668 Redirect => \@_,
669 $cb);
592 } else { 670 } else {
593 $cb->($_[0], $_[1]); 671 $cb->($_[0], $_[1]);
594 } 672 }
595 }; 673 };
596 674
597 my $len = $hdr{"content-length"}; 675 my $len = $hdr{"content-length"};
598 676
599 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 677 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
600 $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", URL => $url }); 678 $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", @pseudo });
601 } elsif ( 679 } elsif (
602 $hdr{Status} =~ /^(?:1..|204|304)$/ 680 $hdr{Status} =~ /^(?:1..|[23]04)$/
603 or $method eq "HEAD" 681 or $method eq "HEAD"
604 or (defined $len && !$len) 682 or (defined $len && !$len)
605 ) { 683 ) {
606 # no body 684 # no body
607 $finish->("", \%hdr); 685 $finish->("", \%hdr);
608 } else { 686 } else {
609 # body handling, four different code paths 687 # body handling, four different code paths
610 # for want_body_handle, on_body (2x), normal (2x) 688 # for want_body_handle, on_body (2x), normal (2x)
611 # we might read too much here, but it does not matter yet (no pers. connections) 689 # we might read too much here, but it does not matter yet (no pers. connections)
612 if (!$redirect && $arg{want_body_handle}) { 690 if (!$redirect && $arg{want_body_handle}) {
613 $_[0]->on_eof (undef); 691 $_[0]->on_eof (undef);
614 $_[0]->on_error (undef); 692 $_[0]->on_error (undef);
615 $_[0]->on_read (undef); 693 $_[0]->on_read (undef);
616 694
617 $finish->(delete $state{handle}, \%hdr); 695 $finish->(delete $state{handle}, \%hdr);
618 696
619 } elsif ($arg{on_body}) { 697 } elsif ($arg{on_body}) {
620 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); 698 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) });
621 if ($len) { 699 if ($len) {
622 $_[0]->on_eof (undef); 700 $_[0]->on_eof (undef);
623 $_[0]->on_read (sub { 701 $_[0]->on_read (sub {
624 $len -= length $_[0]{rbuf}; 702 $len -= length $_[0]{rbuf};
625 703
626 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 704 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
627 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); 705 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo });
628 706
629 $len > 0 707 $len > 0
630 or $finish->("", \%hdr); 708 or $finish->("", \%hdr);
631 }); 709 });
632 } else { 710 } else {
633 $_[0]->on_eof (sub { 711 $_[0]->on_eof (sub {
634 $finish->("", \%hdr); 712 $finish->("", \%hdr);
635 }); 713 });
636 $_[0]->on_read (sub { 714 $_[0]->on_read (sub {
637 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 715 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
638 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); 716 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo });
639 }); 717 });
640 } 718 }
641 } else { 719 } else {
642 $_[0]->on_eof (undef); 720 $_[0]->on_eof (undef);
643 721
644 if ($len) { 722 if ($len) {
645 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); 723 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) });
646 $_[0]->on_read (sub { 724 $_[0]->on_read (sub {
647 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr) 725 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr)
648 if $len <= length $_[0]{rbuf}; 726 if $len <= length $_[0]{rbuf};
649 }); 727 });
650 } else { 728 } else {
651 $_[0]->on_error (sub { 729 $_[0]->on_error (sub {
652 $! == Errno::EPIPE 730 ($! == Errno::EPIPE || !$!)
653 ? $finish->(delete $_[0]{rbuf}, \%hdr) 731 ? $finish->(delete $_[0]{rbuf}, \%hdr)
654 : $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }); 732 : $finish->(undef, { Status => 599, Reason => $_[2], @pseudo });
655 }); 733 });
656 $_[0]->on_read (sub { }); 734 $_[0]->on_read (sub { });
657 } 735 }
658 } 736 }
659 } 737 }
660 }); 738 });
661 }); 739 };
662 };
663 740
664 # now handle proxy-CONNECT method 741 # now handle proxy-CONNECT method
665 if ($proxy && $uscheme eq "https") { 742 if ($proxy && $uscheme eq "https") {
666 # oh dear, we have to wrap it into a connect request 743 # oh dear, we have to wrap it into a connect request
667 744
668 # maybe re-use $uauthority with patched port? 745 # maybe re-use $uauthority with patched port?
669 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); 746 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012");
670 $state{handle}->push_read (line => $qr_nlnl, sub { 747 $state{handle}->push_read (line => $qr_nlnl, sub {
671 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 748 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
672 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", URL => $url })); 749 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", @pseudo }));
673 750
674 if ($2 == 200) { 751 if ($2 == 200) {
675 $rpath = $upath; 752 $rpath = $upath;
676 &$handle_actual_request; 753 &$handle_actual_request;
677 } else { 754 } else {
678 %state = (); 755 %state = ();
679 $cb->(undef, { Status => $2, Reason => $3, URL => $url }); 756 $cb->(undef, { Status => $2, Reason => $3, @pseudo });
757 }
680 } 758 });
681 });
682 } else { 759 } else {
683 &$handle_actual_request; 760 &$handle_actual_request;
761 }
762
684 } 763 },
685 764 $arg{on_prepare} || sub { $timeout }
686 }, sub {
687 $timeout
688 }; 765 );
689 }; 766 };
690 767
691 defined wantarray && AnyEvent::Util::guard { %state = () } 768 defined wantarray && AnyEvent::Util::guard { %state = () }
692} 769}
693 770
… …
707 &http_request 784 &http_request
708} 785}
709 786
710=back 787=back
711 788
789=head2 DNS CACHING
790
791AnyEvent::HTTP uses the AnyEvent::Socket::tcp_connect function for
792the actual connection, which in turn uses AnyEvent::DNS to resolve
793hostnames. The latter is a simple stub resolver and does no caching
794on its own. If you want DNS caching, you currently have to provide
795your own default resolver (by storing a suitable resolver object in
796C<$AnyEvent::DNS::RESOLVER>).
797
712=head2 GLOBAL FUNCTIONS AND VARIABLES 798=head2 GLOBAL FUNCTIONS AND VARIABLES
713 799
714=over 4 800=over 4
715 801
716=item AnyEvent::HTTP::set_proxy "proxy-url" 802=item AnyEvent::HTTP::set_proxy "proxy-url"
717 803
718Sets the default proxy server to use. The proxy-url must begin with a 804Sets the default proxy server to use. The proxy-url must begin with a
719string of the form C<http://host:port> (optionally C<https:...>). 805string of the form C<http://host:port> (optionally C<https:...>), croaks
806otherwise.
807
808To clear an already-set proxy, use C<undef>.
720 809
721=item $AnyEvent::HTTP::MAX_RECURSE 810=item $AnyEvent::HTTP::MAX_RECURSE
722 811
723The default value for the C<recurse> request parameter (default: C<10>). 812The default value for the C<recurse> request parameter (default: C<10>).
724 813
725=item $AnyEvent::HTTP::USERAGENT 814=item $AnyEvent::HTTP::USERAGENT
726 815
727The default value for the C<User-Agent> header (the default is 816The default value for the C<User-Agent> header (the default is
728C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 817C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
729 818
730=item $AnyEvent::HTTP::MAX_PERSISTENT 819=item $AnyEvent::HTTP::MAX_PER_HOST
731 820
732The maximum number of persistent connections to keep open (default: 8). 821The maximum number of concurrent connections to the same host (identified
822by the hostname). If the limit is exceeded, then the additional requests
823are queued until previous connections are closed.
733 824
734Not implemented currently. 825The default value for this is C<4>, and it is highly advisable to not
735 826increase it.
736=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
737
738The maximum time to cache a persistent connection, in seconds (default: 2).
739
740Not implemented currently.
741 827
742=item $AnyEvent::HTTP::ACTIVE 828=item $AnyEvent::HTTP::ACTIVE
743 829
744The number of active connections. This is not the number of currently 830The number of active connections. This is not the number of currently
745running requests, but the number of currently open and non-idle TCP 831running requests, but the number of currently open and non-idle TCP
… …
748=back 834=back
749 835
750=cut 836=cut
751 837
752sub set_proxy($) { 838sub set_proxy($) {
839 if (length $_[0]) {
753 $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix; 840 $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix
841 or Carp::croak "$_[0]: invalid proxy URL";
842 $PROXY = [$2, $3 || 3128, $1]
843 } else {
844 undef $PROXY;
845 }
754} 846}
755 847
756# initialise proxy from environment 848# initialise proxy from environment
849eval {
757set_proxy $ENV{http_proxy}; 850 set_proxy $ENV{http_proxy};
851};
758 852
759=head1 SEE ALSO 853=head1 SEE ALSO
760 854
761L<AnyEvent>. 855L<AnyEvent>.
762 856

Diff Legend

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