AnyEvent-HTTP/HTTP.pm

=head1 NAME

AnyEvent::HTTP - simple but non-blocking HTTP/HTTPS client

=head1 SYNOPSIS

   use AnyEvent::HTTP;

=head1 DESCRIPTION

This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.

=head2 METHODS

=over 4

=cut

package AnyEvent::HTTP;

use strict;
no warnings;

use Carp;

use AnyEvent ();
use AnyEvent::Util ();
use AnyEvent::Socket ();
use AnyEvent::Handle ();

use base Exporter::;

our $VERSION = '1.0';

our @EXPORT = qw(http_get http_request);

our $USERAGENT          = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
our $MAX_RECURSE        =  10;
our $MAX_PERSISTENT     =   8;
our $PERSISTENT_TIMEOUT =   2;
our $TIMEOUT            = 300;

# changing these is evil
our $MAX_PERSISTENT_PER_HOST = 2;
our $MAX_PER_HOST       = 4; # not respected yet :(

our $PROXY;

my %KA_COUNT; # number of open keep-alive connections per host

=item http_get $url, key => value..., $cb->($data, $headers)

Executes an HTTP-GET request. See the http_request function for details on
additional parameters.

=item http_head $url, key => value..., $cb->($data, $headers)

Executes an HTTP-HEAD request. See the http_request function for details on
additional parameters.

=item http_post $url, $body, key => value..., $cb->($data, $headers)

Executes an HTTP-POST request with a request body of C<$bod>. See the
http_request function for details on additional parameters.

=item http_request $method => $url, key => value..., $cb->($data, $headers)

Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL
must be an absolute http or https URL.

The callback will be called with the response data as first argument
(or C<undef> if it wasn't available due to errors), and a hash-ref with
response headers as second argument.

All the headers in that hash are lowercased. In addition to the response
headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and
C<Reason> contain the three parts of the HTTP Status-Line of the same
name.

If an internal error occurs, such as not being able to resolve a hostname,
then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599>
and the C<Reason> pseudo-header will contain an error message.

A typical callback might look like this:

   sub {
      my ($body, $hdr) = @_;

      if ($hdr->{Status} =~ /^2/) {
         ... everything should be ok
      } else {
         print "error, $hdr->{Status} $hdr->{Reason}\n";
      }
   }

Additional parameters are key-value pairs, and are fully optional. They
include:

=over 4

=item recurse => $count (default: $MAX_RECURSE)

Whether to recurse requests or not, e.g. on redirects, authentication
retries and so on, and how often to do so.

=item headers => hashref

The request headers to use.

=item timeout => $seconds

The time-out to use for various stages - each connect attempt will reset
the timeout, as will read or write activity. Default timeout is 5 minutes.

=item proxy => [$host, $port[, $scheme]] or undef

Use the given http proxy for all requests. If not specified, then the
default proxy (as specified by C<$ENV{http_proxy}>) is used.

C<$scheme> must be either missing or C<http> for HTTP, or C<https> for
HTTPS.

=item body => $string

The request body, usually empty. Will be-sent as-is (future versions of
this module might offer more options).

=back

=back

=cut

sub http_request($$$;@) {
   my $cb = pop;
   my ($method, $url, %arg) = @_;

   my %hdr;

   $method = uc $method;

   if (my $hdr = delete $arg{headers}) {
      while (my ($k, $v) = each %$hdr) {
         $hdr{lc $k} = $v;
      }
   }

   my $proxy   = $arg{proxy}   || $PROXY;
   my $timeout = $arg{timeout} || $TIMEOUT;
   my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;

   $hdr{"user-agent"} ||= $USERAGENT;

   my ($host, $port, $path, $scheme);

   if ($proxy) {
      ($host, $port, $scheme) = @$proxy;
      $path = $url;
   } else {
      ($scheme, my $authority, $path, my $query, my $fragment) =
         $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;

      $port = $scheme eq "http"  ?  80
            : $scheme eq "https" ? 443
            : croak "$url: only http and https URLs supported";

      $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
         or croak "$authority: unparsable URL";

      $host = $1;
      $port = $2 if defined $2;

      $host =~ s/^\[(.*)\]$/$1/;
      $path .= "?$query" if length $query;

      $path = "/" unless $path;

      $hdr{host} = $host = lc $host;
   }

   $scheme = lc $scheme;

   my %state;

   $state{body} = delete $arg{body};

   $hdr{"content-length"} = length $state{body};

   $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
      $state{fh} = shift
         or return $cb->(undef, { Status => 599, Reason => "$!" });

      delete $state{connect_guard}; # reduce memory usage, save a tree

      # get handle
      $state{handle} = new AnyEvent::Handle
         fh => $state{fh},
         ($scheme eq "https" ? (tls => "connect") : ());

      # limit the number of persistent connections
      if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
         ++$KA_COUNT{$_[1]};
         $state{handle}{ka_count_guard} = AnyEvent::Util::guard { --$KA_COUNT{$_[1]} };
         $hdr{connection} = "keep-alive";
         delete $hdr{connection}; # keep-alive not yet supported
      } else {
         delete $hdr{connection};
      }

      # (re-)configure handle
      $state{handle}->timeout ($timeout);
      $state{handle}->on_error (sub {
         %state = ();
         $cb->(undef, { Status => 599, Reason => "$!" });
      });
      $state{handle}->on_eof (sub {
         %state = ();
         $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
      });

      # send request
      $state{handle}->push_write (
         "$method $path HTTP/1.0\015\012"
         . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
         . "\015\012"
         . (delete $state{body})
      );

      %hdr = (); # reduce memory usage, save a kitten

      # status line
      $state{handle}->push_read (line => qr/\015?\012/, sub {
         $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix
            or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])" }));

         my %hdr = ( # response headers
            HTTPVersion => ",$1",
            Status      => ",$2",
            Reason      => ",$3",
         );

         # headers, could be optimized a bit
         $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub {
            for ("$_[1]\012") {
               # we support spaces in field names, as lotus domino
               # creates them.
               $hdr{lc $1} .= ",$2"
                  while /\G
                        ([^:\000-\037]+):
                        [\011\040]*
                        ((?: [^\015\012]+ | \015?\012[\011\040] )*)
                        \015?\012
                     /gxc;

               /\G$/
                 or return $cb->(undef, { Status => 599, Reason => "garbled response headers" });
            }

            substr $_, 0, 1, ""
               for values %hdr;

            if ($method eq "HEAD") {
               %state = ();
               $cb->(undef, \%hdr);
            } else {
               if (exists $hdr{"content-length"}) {
                  $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
                     # could cache persistent connection now
                     if ($hdr{connection} =~ /\bkeep-alive\b/i) {
                        # but we don't, due to misdesigns, this is annoyingly complex
                     };

                     %state = ();
                     $cb->($_[1], \%hdr);
                  });
               } else {
                  # too bad, need to read until we get an error or EOF,
                  # no way to detect winged data.
                  $_[0]->on_error (sub {
                     %state = ();
                     $cb->($_[0]{rbuf}, \%hdr);
                  });
                  $_[0]->on_eof (undef);
                  $_[0]->on_read (sub { });
               }
            }
         });
      });
   }, sub {
      $timeout
   };

   defined wantarray && AnyEvent::Util::guard { %state = () }
}

sub http_get($$;@) {
   unshift @_, "GET";
   &http_request
}

sub http_head($$;@) {
   unshift @_, "HEAD";
   &http_request
}

sub http_post($$$;@) {
   unshift @_, "POST", "body";
   &http_request
}

=head2 GLOBAL FUNCTIONS AND VARIABLES

=over 4

=item AnyEvent::HTTP::set_proxy "proxy-url"

Sets the default proxy server to use. The proxy-url must begin with a
string of the form C<http://host:port> (optionally C<https:...>).

=item $AnyEvent::HTTP::MAX_RECURSE

The default value for the C<recurse> request parameter (default: C<10>).

=item $AnyEvent::HTTP::USERAGENT

The default value for the C<User-Agent> header (the default is
C<Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).

=item $AnyEvent::HTTP::MAX_PERSISTENT

The maximum number of persistent connections to keep open (default: 8).

Not implemented currently.

=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT

The maximum time to cache a persistent connection, in seconds (default: 2).

Not implemented currently.

=back

=cut

sub set_proxy($) {
   $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix;
}

# initialise proxy from environment
set_proxy $ENV{http_proxy};

=head1 SEE ALSO

L<AnyEvent>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1

Revision:	1.7
Committed:	Wed Jun 4 12:10:27 2008 UTC (15 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.6:	+2 -2 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	AnyEvent::HTTP - simple but non-blocking HTTP/HTTPS client
4
5	=head1 SYNOPSIS
6
7	use AnyEvent::HTTP;
8
9	=head1 DESCRIPTION
10
11	This module is an L<AnyEvent> user, you need to make sure that you use and
12	run a supported event loop.
13
14	=head2 METHODS
15
16	=over 4
17
18	=cut
19
20	package AnyEvent::HTTP;
21
22	use strict;
23	no warnings;
24
25	use Carp;
26
27	use AnyEvent ();
28	use AnyEvent::Util ();
29	use AnyEvent::Socket ();
30	use AnyEvent::Handle ();
31
32	use base Exporter::;
33
34	our $VERSION = '1.0';
35
36	our @EXPORT = qw(http_get http_request);
37
38	our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
39	our $MAX_RECURSE = 10;
40	our $MAX_PERSISTENT = 8;
41	our $PERSISTENT_TIMEOUT = 2;
42	our $TIMEOUT = 300;
43
44	# changing these is evil
45	our $MAX_PERSISTENT_PER_HOST = 2;
46	our $MAX_PER_HOST = 4; # not respected yet :(
47
48	our $PROXY;
49
50	my %KA_COUNT; # number of open keep-alive connections per host
51
52	=item http_get $url, key => value..., $cb->($data, $headers)
53
54	Executes an HTTP-GET request. See the http_request function for details on
55	additional parameters.
56
57	=item http_head $url, key => value..., $cb->($data, $headers)
58
59	Executes an HTTP-HEAD request. See the http_request function for details on
60	additional parameters.
61
62	=item http_post $url, $body, key => value..., $cb->($data, $headers)
63
64	Executes an HTTP-POST request with a request body of C<$bod>. See the
65	http_request function for details on additional parameters.
66
67	=item http_request $method => $url, key => value..., $cb->($data, $headers)
68
69	Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL
70	must be an absolute http or https URL.
71
72	The callback will be called with the response data as first argument
73	(or C<undef> if it wasn't available due to errors), and a hash-ref with
74	response headers as second argument.
75
76	All the headers in that hash are lowercased. In addition to the response
77	headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and
78	C<Reason> contain the three parts of the HTTP Status-Line of the same
79	name.
80
81	If an internal error occurs, such as not being able to resolve a hostname,
82	then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599>
83	and the C<Reason> pseudo-header will contain an error message.
84
85	A typical callback might look like this:
86
87	sub {
88	my ($body, $hdr) = @_;
89
90	if ($hdr->{Status} =~ /^2/) {
91	... everything should be ok
92	} else {
93	print "error, $hdr->{Status} $hdr->{Reason}\n";
94	}
95	}
96
97	Additional parameters are key-value pairs, and are fully optional. They
98	include:
99
100	=over 4
101
102	=item recurse => $count (default: $MAX_RECURSE)
103
104	Whether to recurse requests or not, e.g. on redirects, authentication
105	retries and so on, and how often to do so.
106
107	=item headers => hashref
108
109	The request headers to use.
110
111	=item timeout => $seconds
112
113	The time-out to use for various stages - each connect attempt will reset
114	the timeout, as will read or write activity. Default timeout is 5 minutes.
115
116	=item proxy => [$host, $port[, $scheme]] or undef
117
118	Use the given http proxy for all requests. If not specified, then the
119	default proxy (as specified by C<$ENV{http_proxy}>) is used.
120
121	C<$scheme> must be either missing or C<http> for HTTP, or C<https> for
122	HTTPS.
123
124	=item body => $string
125
126	The request body, usually empty. Will be-sent as-is (future versions of
127	this module might offer more options).
128
129	=back
130
131	=back
132
133	=cut
134
135	sub http_request($$$;@) {
136	my $cb = pop;
137	my ($method, $url, %arg) = @_;
138
139	my %hdr;
140
141	$method = uc $method;
142
143	if (my $hdr = delete $arg{headers}) {
144	while (my ($k, $v) = each %$hdr) {
145	$hdr{lc $k} = $v;
146	}
147	}
148
149	my $proxy = $arg{proxy} \|\| $PROXY;
150	my $timeout = $arg{timeout} \|\| $TIMEOUT;
151	my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
152
153	$hdr{"user-agent"} \|\|= $USERAGENT;
154
155	my ($host, $port, $path, $scheme);
156
157	if ($proxy) {
158	($host, $port, $scheme) = @$proxy;
159	$path = $url;
160	} else {
161	($scheme, my $authority, $path, my $query, my $fragment) =
162	$url =~ m\|(?:([^:/?#]+):)?(?://([^/?#]))?([^?#])(?:\?([^#]))?(?:#(.))?\|;
163
164	$port = $scheme eq "http" ? 80
165	: $scheme eq "https" ? 443
166	: croak "$url: only http and https URLs supported";
167
168	$authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
169	or croak "$authority: unparsable URL";
170
171	$host = $1;
172	$port = $2 if defined $2;
173
174	$host =~ s/^\[(.*)\]$/$1/;
175	$path .= "?$query" if length $query;
176
177	$path = "/" unless $path;
178
179	$hdr{host} = $host = lc $host;
180	}
181
182	$scheme = lc $scheme;
183
184	my %state;
185
186	$state{body} = delete $arg{body};
187
188	$hdr{"content-length"} = length $state{body};
189
190	$state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
191	$state{fh} = shift
192	or return $cb->(undef, { Status => 599, Reason => "$!" });
193
194	delete $state{connect_guard}; # reduce memory usage, save a tree
195
196	# get handle
197	$state{handle} = new AnyEvent::Handle
198	fh => $state{fh},
199	($scheme eq "https" ? (tls => "connect") : ());
200
201	# limit the number of persistent connections
202	if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
203	++$KA_COUNT{$_[1]};
204	$state{handle}{ka_count_guard} = AnyEvent::Util::guard { --$KA_COUNT{$_[1]} };
205	$hdr{connection} = "keep-alive";
206	delete $hdr{connection}; # keep-alive not yet supported
207	} else {
208	delete $hdr{connection};
209	}
210
211	# (re-)configure handle
212	$state{handle}->timeout ($timeout);
213	$state{handle}->on_error (sub {
214	%state = ();
215	$cb->(undef, { Status => 599, Reason => "$!" });
216	});
217	$state{handle}->on_eof (sub {
218	%state = ();
219	$cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
220	});
221
222	# send request
223	$state{handle}->push_write (
224	"$method $path HTTP/1.0\015\012"
225	. (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
226	. "\015\012"
227	. (delete $state{body})
228	);
229
230	%hdr = (); # reduce memory usage, save a kitten
231
232	# status line
233	$state{handle}->push_read (line => qr/\015?\012/, sub {
234	$_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix
235	or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])" }));
236
237	my %hdr = ( # response headers
238	HTTPVersion => ",$1",
239	Status => ",$2",
240	Reason => ",$3",
241	);
242
243	# headers, could be optimized a bit
244	$state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub {
245	for ("$_[1]\012") {
246	# we support spaces in field names, as lotus domino
247	# creates them.
248	$hdr{lc $1} .= ",$2"
249	while /\G
250	([^:\000-\037]+):
251	[\011\040]*
252	((?: [^\015\012]+ \| \015?\012[\011\040] )*)
253	\015?\012
254	/gxc;
255
256	/\G$/
257	or return $cb->(undef, { Status => 599, Reason => "garbled response headers" });
258	}
259
260	substr $_, 0, 1, ""
261	for values %hdr;
262
263	if ($method eq "HEAD") {
264	%state = ();
265	$cb->(undef, \%hdr);
266	} else {
267	if (exists $hdr{"content-length"}) {
268	$_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
269	# could cache persistent connection now
270	if ($hdr{connection} =~ /\bkeep-alive\b/i) {
271	# but we don't, due to misdesigns, this is annoyingly complex
272	};
273
274	%state = ();
275	$cb->($_[1], \%hdr);
276	});
277	} else {
278	# too bad, need to read until we get an error or EOF,
279	# no way to detect winged data.
280	$_[0]->on_error (sub {
281	%state = ();
282	$cb->($_[0]{rbuf}, \%hdr);
283	});
284	$_[0]->on_eof (undef);
285	$_[0]->on_read (sub { });
286	}
287	}
288	});
289	});
290	}, sub {
291	$timeout
292	};
293
294	defined wantarray && AnyEvent::Util::guard { %state = () }
295	}
296
297	sub http_get($$;@) {
298	unshift @_, "GET";
299	&http_request
300	}
301
302	sub http_head($$;@) {
303	unshift @_, "HEAD";
304	&http_request
305	}
306
307	sub http_post($$$;@) {
308	unshift @_, "POST", "body";
309	&http_request
310	}
311
312	=head2 GLOBAL FUNCTIONS AND VARIABLES
313
314	=over 4
315
316	=item AnyEvent::HTTP::set_proxy "proxy-url"
317
318	Sets the default proxy server to use. The proxy-url must begin with a
319	string of the form C<http://host:port> (optionally C<https:...>).
320
321	=item $AnyEvent::HTTP::MAX_RECURSE
322
323	The default value for the C<recurse> request parameter (default: C<10>).
324
325	=item $AnyEvent::HTTP::USERAGENT
326
327	The default value for the C<User-Agent> header (the default is
328	C<Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
329
330	=item $AnyEvent::HTTP::MAX_PERSISTENT
331
332	The maximum number of persistent connections to keep open (default: 8).
333
334	Not implemented currently.
335
336	=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
337
338	The maximum time to cache a persistent connection, in seconds (default: 2).
339
340	Not implemented currently.
341
342	=back
343
344	=cut
345
346	sub set_proxy($) {
347	$PROXY = [$2, $3 \|\| 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix;
348	}
349
350	# initialise proxy from environment
351	set_proxy $ENV{http_proxy};
352
353	=head1 SEE ALSO
354
355	L<AnyEvent>.
356
357	=head1 AUTHOR
358
359	Marc Lehmann <schmorp@schmorp.de>
360	http://home.schmorp.de/
361
362	=cut
363
364	1
365