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.45 by root, Fri Jul 17 16:56:36 2009 UTC vs.
Revision 1.52 by root, Sat Sep 26 10:13:12 2009 UTC

41use strict; 41use strict;
42no warnings; 42no warnings;
43 43
44use Errno (); 44use Errno ();
45 45
46use AnyEvent 4.8 (); 46use AnyEvent 5.0 ();
47use AnyEvent::Util (); 47use AnyEvent::Util ();
48use AnyEvent::Socket (); 48use AnyEvent::Socket ();
49use AnyEvent::Handle (); 49use AnyEvent::Handle ();
50 50
51use base Exporter::; 51use base Exporter::;
52 52
53our $VERSION = '1.4'; 53our $VERSION = '1.43';
54 54
55our @EXPORT = qw(http_get http_post http_head http_request); 55our @EXPORT = qw(http_get http_post http_head http_request);
56 56
57our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 57our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
58our $MAX_RECURSE = 10; 58our $MAX_RECURSE = 10;
138 138
139=item headers => hashref 139=item headers => hashref
140 140
141The request headers to use. Currently, C<http_request> may provide its 141The request headers to use. Currently, C<http_request> may provide its
142own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers 142own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers
143and will provide defaults for C<User-Agent:> and C<Referer:>. 143and will provide defaults for C<User-Agent:> and C<Referer:> (this can be
144suppressed by using C<undef> for these headers in which case they won't be
145sent at all).
144 146
145=item timeout => $seconds 147=item timeout => $seconds
146 148
147The time-out to use for various stages - each connect attempt will reset 149The 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. 150the timeout, as will read or write activity, i.e. this is not an overall
151timeout.
152
153Default timeout is 5 minutes.
149 154
150=item proxy => [$host, $port[, $scheme]] or undef 155=item proxy => [$host, $port[, $scheme]] or undef
151 156
152Use the given http proxy for all requests. If not specified, then the 157Use the given http proxy for all requests. If not specified, then the
153default proxy (as specified by C<$ENV{http_proxy}>) is used. 158default proxy (as specified by C<$ENV{http_proxy}>) is used.
154 159
155C<$scheme> must be either missing or C<http> for HTTP, or C<https> for 160C<$scheme> must be either missing, C<http> for HTTP or C<https> for
156HTTPS. 161HTTPS.
157 162
158=item body => $string 163=item body => $string
159 164
160The request body, usually empty. Will be-sent as-is (future versions of 165The request body, usually empty. Will be-sent as-is (future versions of
185verification, highest compatibility) and high-security (CA and common-name 190verification, highest compatibility) and high-security (CA and common-name
186verification) TLS context. 191verification) TLS context.
187 192
188The default for this option is C<low>, which could be interpreted as "give 193The default for this option is C<low>, which could be interpreted as "give
189me the page, no matter what". 194me the page, no matter what".
195
196=item on_prepare => $callback->($fh)
197
198In rare cases you need to "tune" the socket before it is used to
199connect (for exmaple, to bind it on a given IP address). This parameter
200overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
201and behaves exactly the same way (e.g. it has to provide a
202timeout). See the description for the C<$prepare_cb> argument of
203C<AnyEvent::Socket::tcp_connect> for details.
190 204
191=item on_header => $callback->($headers) 205=item on_header => $callback->($headers)
192 206
193When specified, this callback will be called with the header hash as soon 207When specified, this callback will be called with the header hash as soon
194as headers have been successfully received from the remote server (not on 208as headers have been successfully received from the remote server (not on
312 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 326 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
313 327
314 _slot_schedule $_[0]; 328 _slot_schedule $_[0];
315} 329}
316 330
317our $qr_nl = qr<\015?\012>; 331our $qr_nl = qr{\015?\012};
318our $qr_nlnl = qr<\015?\012\015?\012>; 332our $qr_nlnl = qr{(?<![^\012])\015?\012};
319 333
320our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 }; 334our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 };
321our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" }; 335our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
322 336
323sub http_request($$@) { 337sub http_request($$@) {
401 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path 415 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path
402 416
403 if ($proxy) { 417 if ($proxy) {
404 ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy); 418 ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy);
405 419
420 $rscheme = "http" unless defined $rscheme;
421
406 # don't support https requests over https-proxy transport, 422 # don't support https requests over https-proxy transport,
407 # can't be done with tls as spec'ed, unless you double-encrypt. 423 # can't be done with tls as spec'ed, unless you double-encrypt.
408 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https"; 424 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https";
409 } else { 425 } else {
410 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); 426 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
411 } 427 }
412 428
413 $hdr{"user-agent"} ||= $USERAGENT; 429 # leave out fragment and query string, just a heuristic
414 $hdr{referer} ||= "$uscheme://$uauthority$upath"; # leave out fragment and query string, just a heuristic 430 $hdr{referer} ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer};
431 $hdr{"user-agent"} ||= $USERAGENT unless exists $hdr{"user-agent"};
415 432
416 $hdr{"content-length"} = length $arg{body}; 433 $hdr{"content-length"} = length $arg{body};
417 434
418 my %state = (connect_guard => 1); 435 my %state = (connect_guard => 1);
419 436
470 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 487 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
471 488
472 # send request 489 # send request
473 $state{handle}->push_write ( 490 $state{handle}->push_write (
474 "$method $rpath HTTP/1.0\015\012" 491 "$method $rpath HTTP/1.0\015\012"
475 . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr) 492 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
476 . "\015\012" 493 . "\015\012"
477 . (delete $arg{body}) 494 . (delete $arg{body})
478 ); 495 );
479 496
480 %hdr = (); # reduce memory usage, save a kitten 497 %hdr = (); # reduce memory usage, save a kitten
491 URL => ",$url" 508 URL => ",$url"
492 ); 509 );
493 510
494 # headers, could be optimized a bit 511 # headers, could be optimized a bit
495 $state{handle}->unshift_read (line => $qr_nlnl, sub { 512 $state{handle}->unshift_read (line => $qr_nlnl, sub {
496 for ("$_[1]\012") { 513 for ("$_[1]") {
497 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 514 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
498 515
499 # things seen, not parsed: 516 # things seen, not parsed:
500 # p3pP="NON CUR OTPi OUR NOR UNI" 517 # p3pP="NON CUR OTPi OUR NOR UNI"
501 518
598 615
599 redo if /\G\s*,/gc; 616 redo if /\G\s*,/gc;
600 } 617 }
601 } 618 }
602 619
603 if ($redirect) { 620 if ($redirect && exists $hdr{location}) {
604 # we ignore any errors, as it is very common to receive 621 # we ignore any errors, as it is very common to receive
605 # Content-Length != 0 but no actual body 622 # Content-Length != 0 but no actual body
606 # we also access %hdr, as $_[1] might be an erro 623 # we also access %hdr, as $_[1] might be an erro
607 http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb); 624 http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb);
608 } else { 625 } else {
697 }); 714 });
698 } else { 715 } else {
699 &$handle_actual_request; 716 &$handle_actual_request;
700 } 717 }
701 718
702 }, sub { 719 }, $arg{on_prepare} || sub { $timeout };
703 $timeout
704 };
705 }; 720 };
706 721
707 defined wantarray && AnyEvent::Util::guard { %state = () } 722 defined wantarray && AnyEvent::Util::guard { %state = () }
708} 723}
709 724
730=over 4 745=over 4
731 746
732=item AnyEvent::HTTP::set_proxy "proxy-url" 747=item AnyEvent::HTTP::set_proxy "proxy-url"
733 748
734Sets the default proxy server to use. The proxy-url must begin with a 749Sets the default proxy server to use. The proxy-url must begin with a
735string of the form C<http://host:port> (optionally C<https:...>). 750string of the form C<http://host:port> (optionally C<https:...>), croaks
751otherwise.
752
753To clear an already-set proxy, use C<undef>.
736 754
737=item $AnyEvent::HTTP::MAX_RECURSE 755=item $AnyEvent::HTTP::MAX_RECURSE
738 756
739The default value for the C<recurse> request parameter (default: C<10>). 757The default value for the C<recurse> request parameter (default: C<10>).
740 758
743The default value for the C<User-Agent> header (the default is 761The default value for the C<User-Agent> header (the default is
744C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 762C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
745 763
746=item $AnyEvent::HTTP::MAX_PER_HOST 764=item $AnyEvent::HTTP::MAX_PER_HOST
747 765
748The maximum number of concurrent conenctions to the same host (identified 766The maximum number of concurrent connections to the same host (identified
749by the hostname). If the limit is exceeded, then the additional requests 767by the hostname). If the limit is exceeded, then the additional requests
750are queued until previous connections are closed. 768are queued until previous connections are closed.
751 769
752The default value for this is C<4>, and it is highly advisable to not 770The default value for this is C<4>, and it is highly advisable to not
753increase it. 771increase it.
761=back 779=back
762 780
763=cut 781=cut
764 782
765sub set_proxy($) { 783sub set_proxy($) {
784 if (length $_[0]) {
766 $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix; 785 $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix
786 or Carp::croak "$_[0]: invalid proxy URL";
787 $PROXY = [$2, $3 || 3128, $1]
788 } else {
789 undef $PROXY;
790 }
767} 791}
768 792
769# initialise proxy from environment 793# initialise proxy from environment
794eval {
770set_proxy $ENV{http_proxy}; 795 set_proxy $ENV{http_proxy};
796};
771 797
772=head1 SEE ALSO 798=head1 SEE ALSO
773 799
774L<AnyEvent>. 800L<AnyEvent>.
775 801

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines