… | |
… | |
48 | use AnyEvent::Socket (); |
48 | use AnyEvent::Socket (); |
49 | use AnyEvent::Handle (); |
49 | use AnyEvent::Handle (); |
50 | |
50 | |
51 | use base Exporter::; |
51 | use base Exporter::; |
52 | |
52 | |
53 | our $VERSION = '1.05'; |
53 | our $VERSION = '1.12'; |
54 | |
54 | |
55 | our @EXPORT = qw(http_get http_post http_head http_request); |
55 | our @EXPORT = qw(http_get http_post http_head http_request); |
56 | |
56 | |
57 | our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; |
57 | our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; |
58 | our $MAX_RECURSE = 10; |
58 | our $MAX_RECURSE = 10; |
… | |
… | |
236 | sub _get_slot($$) { |
236 | sub _get_slot($$) { |
237 | push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; |
237 | push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; |
238 | |
238 | |
239 | _slot_schedule $_[0]; |
239 | _slot_schedule $_[0]; |
240 | } |
240 | } |
|
|
241 | |
|
|
242 | our $qr_nl = qr<\015?\012>; |
|
|
243 | our $qr_nlnl = qr<\015?\012\015?\012>; |
241 | |
244 | |
242 | sub http_request($$@) { |
245 | sub http_request($$@) { |
243 | my $cb = pop; |
246 | my $cb = pop; |
244 | my ($method, $url, %arg) = @_; |
247 | my ($method, $url, %arg) = @_; |
245 | |
248 | |
… | |
… | |
317 | } |
320 | } |
318 | |
321 | |
319 | my ($rhost, $rport, $rscheme, $rpath); # request host, port, path |
322 | my ($rhost, $rport, $rscheme, $rpath); # request host, port, path |
320 | |
323 | |
321 | if ($proxy) { |
324 | if ($proxy) { |
322 | ($rhost, $rport, $rscheme, $rpath) = (@$proxy, $url); |
325 | ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy); |
323 | |
326 | |
324 | # don't support https requests over https-proxy transport, |
327 | # don't support https requests over https-proxy transport, |
325 | # can't be done with tls as spec'ed. |
328 | # can't be done with tls as spec'ed, unless you double-encrypt. |
326 | $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https"; |
329 | $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https"; |
327 | } else { |
330 | } else { |
328 | ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); |
331 | ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); |
329 | } |
332 | } |
330 | |
333 | |
… | |
… | |
339 | return unless $state{connect_guard}; |
342 | return unless $state{connect_guard}; |
340 | |
343 | |
341 | $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { |
344 | $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { |
342 | $state{fh} = shift |
345 | $state{fh} = shift |
343 | or return $cb->(undef, { Status => 599, Reason => "$!", URL => $url }); |
346 | or return $cb->(undef, { Status => 599, Reason => "$!", URL => $url }); |
|
|
347 | pop; # free memory, save a tree |
344 | |
348 | |
345 | delete $state{connect_guard}; # reduce memory usage, save a tree |
349 | return unless delete $state{connect_guard}; |
346 | |
350 | |
347 | # get handle |
351 | # get handle |
348 | $state{handle} = new AnyEvent::Handle |
352 | $state{handle} = new AnyEvent::Handle |
349 | fh => $state{fh}; |
353 | fh => $state{fh}, |
|
|
354 | timeout => $timeout; |
350 | |
355 | |
351 | # limit the number of persistent connections |
356 | # limit the number of persistent connections |
|
|
357 | # keepalive not yet supported |
352 | if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { |
358 | if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { |
353 | ++$KA_COUNT{$_[1]}; |
359 | ++$KA_COUNT{$_[1]}; |
354 | $state{handle}{ka_count_guard} = AnyEvent::Util::guard { --$KA_COUNT{$_[1]} }; |
360 | $state{handle}{ka_count_guard} = AnyEvent::Util::guard { |
|
|
361 | --$KA_COUNT{$_[1]} |
|
|
362 | }; |
355 | $hdr{connection} = "keep-alive"; |
363 | $hdr{connection} = "keep-alive"; |
356 | delete $hdr{connection}; # keep-alive not yet supported |
|
|
357 | } else { |
364 | } else { |
358 | delete $hdr{connection}; |
365 | delete $hdr{connection}; |
359 | } |
366 | } |
360 | |
367 | |
361 | # (re-)configure handle |
368 | # (re-)configure handle |
362 | $state{handle}->timeout ($timeout); |
|
|
363 | $state{handle}->on_error (sub { |
369 | $state{handle}->on_error (sub { |
364 | my $errno = "$!"; |
370 | my $errno = "$!"; |
365 | %state = (); |
371 | %state = (); |
366 | $cb->(undef, { Status => 599, Reason => $errno, URL => $url }); |
372 | $cb->(undef, { Status => 599, Reason => $errno, URL => $url }); |
367 | }); |
373 | }); |
… | |
… | |
372 | |
378 | |
373 | $state{handle}->starttls ("connect") if $rscheme eq "https"; |
379 | $state{handle}->starttls ("connect") if $rscheme eq "https"; |
374 | |
380 | |
375 | # handle actual, non-tunneled, request |
381 | # handle actual, non-tunneled, request |
376 | my $handle_actual_request = sub { |
382 | my $handle_actual_request = sub { |
377 | $state{handle}->starttls ("connect") if $uscheme eq "https"; |
383 | $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; |
378 | |
384 | |
379 | # send request |
385 | # send request |
380 | $state{handle}->push_write ( |
386 | $state{handle}->push_write ( |
381 | "$method $rpath HTTP/1.0\015\012" |
387 | "$method $rpath HTTP/1.0\015\012" |
382 | . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr) |
388 | . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr) |
… | |
… | |
385 | ); |
391 | ); |
386 | |
392 | |
387 | %hdr = (); # reduce memory usage, save a kitten |
393 | %hdr = (); # reduce memory usage, save a kitten |
388 | |
394 | |
389 | # status line |
395 | # status line |
390 | $state{handle}->push_read (line => qr/\015?\012/, sub { |
396 | $state{handle}->push_read (line => $qr_nl, sub { |
391 | $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix |
397 | $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix |
392 | or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url })); |
398 | or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url })); |
393 | |
399 | |
394 | my %hdr = ( # response headers |
400 | my %hdr = ( # response headers |
395 | HTTPVersion => ",$1", |
401 | HTTPVersion => ",$1", |
… | |
… | |
397 | Reason => ",$3", |
403 | Reason => ",$3", |
398 | URL => ",$url" |
404 | URL => ",$url" |
399 | ); |
405 | ); |
400 | |
406 | |
401 | # headers, could be optimized a bit |
407 | # headers, could be optimized a bit |
402 | $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub { |
408 | $state{handle}->unshift_read (line => $qr_nlnl, sub { |
403 | for ("$_[1]\012") { |
409 | for ("$_[1]\012") { |
404 | y/\015//d; # weed out any \015, as they show up in the weirdest of places. |
410 | y/\015//d; # weed out any \015, as they show up in the weirdest of places. |
405 | |
411 | |
406 | # we support spaces in field names, as lotus domino |
412 | # we support spaces in field names, as lotus domino |
407 | # creates them (actually spaces around seperators |
413 | # creates them (actually spaces around seperators |
… | |
… | |
420 | |
426 | |
421 | substr $_, 0, 1, "" |
427 | substr $_, 0, 1, "" |
422 | for values %hdr; |
428 | for values %hdr; |
423 | |
429 | |
424 | my $finish = sub { |
430 | my $finish = sub { |
425 | # TODO: use destroy method, when/if available |
|
|
426 | #$state{handle}->destroy; |
431 | $state{handle}->destroy; |
427 | $state{handle}->on_eof (undef); |
|
|
428 | $state{handle}->on_error (undef); |
|
|
429 | %state = (); |
432 | %state = (); |
430 | |
433 | |
431 | # set-cookie processing |
434 | # set-cookie processing |
432 | if ($arg{cookie_jar}) { |
435 | if ($arg{cookie_jar}) { |
433 | for ($hdr{"set-cookie"}) { |
436 | for ($hdr{"set-cookie"}) { |
… | |
… | |
522 | }); |
525 | }); |
523 | } else { |
526 | } else { |
524 | # too bad, need to read until we get an error or EOF, |
527 | # too bad, need to read until we get an error or EOF, |
525 | # no way to detect winged data. |
528 | # no way to detect winged data. |
526 | $_[0]->on_error (sub { |
529 | $_[0]->on_error (sub { |
|
|
530 | # delete ought to be more efficient, as we would have to make |
|
|
531 | # a copy otherwise as $_[0] gets destroyed. |
527 | $finish->($_[0]{rbuf}, \%hdr); |
532 | $finish->(delete $_[0]{rbuf}, \%hdr); |
528 | }); |
533 | }); |
529 | $_[0]->on_eof (undef); |
534 | $_[0]->on_eof (undef); |
530 | $_[0]->on_read (sub { }); |
535 | $_[0]->on_read (sub { }); |
531 | } |
536 | } |
532 | } |
537 | } |
… | |
… | |
538 | if ($proxy && $uscheme eq "https") { |
543 | if ($proxy && $uscheme eq "https") { |
539 | # oh dear, we have to wrap it into a connect request |
544 | # oh dear, we have to wrap it into a connect request |
540 | |
545 | |
541 | # maybe re-use $uauthority with patched port? |
546 | # maybe re-use $uauthority with patched port? |
542 | $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); |
547 | $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); |
543 | $state{handle}->push_read (line => qr/\015?\012\015?\012/, sub { |
548 | $state{handle}->push_read (line => $qr_nlnl, sub { |
544 | $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix |
549 | $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix |
545 | or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid proxy connect response ($_[1])", URL => $url })); |
550 | or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid proxy connect response ($_[1])", URL => $url })); |
546 | |
551 | |
547 | if ($2 == 200) { |
552 | if ($2 == 200) { |
548 | $rpath = $upath; |
553 | $rpath = $upath; |
… | |
… | |
636 | =head1 AUTHOR |
641 | =head1 AUTHOR |
637 | |
642 | |
638 | Marc Lehmann <schmorp@schmorp.de> |
643 | Marc Lehmann <schmorp@schmorp.de> |
639 | http://home.schmorp.de/ |
644 | http://home.schmorp.de/ |
640 | |
645 | |
|
|
646 | With many thanks to Дмитрий Шалашов, who provided countless |
|
|
647 | testcases and bugreports. |
|
|
648 | |
641 | =cut |
649 | =cut |
642 | |
650 | |
643 | 1 |
651 | 1 |
644 | |
652 | |