This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
878cce89d8fb2ea02ff3b630e49de23597106957
[perl5.git] / cpan / HTTP-Tiny / lib / HTTP / Tiny.pm
1 # vim: ts=4 sts=4 sw=4 et:
2 package HTTP::Tiny;
3 use strict;
4 use warnings;
5 # ABSTRACT: A small, simple, correct HTTP/1.1 client
6
7 our $VERSION = '0.054';
8
9 use Carp ();
10
11 #pod =method new
12 #pod
13 #pod     $http = HTTP::Tiny->new( %attributes );
14 #pod
15 #pod This constructor returns a new HTTP::Tiny object.  Valid attributes include:
16 #pod
17 #pod =for :list
18 #pod * C<agent> —
19 #pod     A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.
20 #pod * C<cookie_jar> —
21 #pod     An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods
22 #pod * C<default_headers> —
23 #pod     A hashref of default headers to apply to requests
24 #pod * C<local_address> —
25 #pod     The local IP address to bind to
26 #pod * C<keep_alive> —
27 #pod     Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
28 #pod * C<max_redirect> —
29 #pod     Maximum number of redirects allowed (defaults to 5)
30 #pod * C<max_size> —
31 #pod     Maximum response size (only when not using a data callback).  If defined, responses larger than this will return an exception.
32 #pod * C<http_proxy> —
33 #pod     URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)
34 #pod * C<https_proxy> —
35 #pod     URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)
36 #pod * C<proxy> —
37 #pod     URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)
38 #pod * C<no_proxy> —
39 #pod     List of domain suffixes that should not be proxied.  Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)
40 #pod * C<timeout> —
41 #pod     Request timeout in seconds (default is 60)
42 #pod * C<verify_SSL> —
43 #pod     A boolean that indicates whether to validate the SSL certificate of an C<https> —
44 #pod     connection (default is false)
45 #pod * C<SSL_options> —
46 #pod     A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
47 #pod
48 #pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
49 #pod prevent getting the corresponding proxies from the environment.
50 #pod
51 #pod Exceptions from C<max_size>, C<timeout> or other errors will result in a
52 #pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
53 #pod content field in the response will contain the text of the exception.
54 #pod
55 #pod The C<keep_alive> parameter enables a persistent connection, but only to a
56 #pod single destination scheme, host and port.  Also, if any connection-relevant
57 #pod attributes are modified, or if the process ID or thread ID change, the
58 #pod persistent connection will be dropped.  If you want persistent connections
59 #pod across multiple destinations, use multiple HTTP::Tiny objects.
60 #pod
61 #pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
62 #pod
63 #pod =cut
64
65 my @attributes;
66 BEGIN {
67     @attributes = qw(
68         cookie_jar default_headers http_proxy https_proxy keep_alive
69         local_address max_redirect max_size proxy no_proxy timeout
70         SSL_options verify_SSL
71     );
72     my %persist_ok = map {; $_ => 1 } qw(
73         cookie_jar default_headers max_redirect max_size
74     );
75     no strict 'refs';
76     no warnings 'uninitialized';
77     for my $accessor ( @attributes ) {
78         *{$accessor} = sub {
79             @_ > 1
80                 ? do {
81                     delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
82                     $_[0]->{$accessor} = $_[1]
83                 }
84                 : $_[0]->{$accessor};
85         };
86     }
87 }
88
89 sub agent {
90     my($self, $agent) = @_;
91     if( @_ > 1 ){
92         $self->{agent} =
93             (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
94     }
95     return $self->{agent};
96 }
97
98 sub new {
99     my($class, %args) = @_;
100
101     my $self = {
102         max_redirect => 5,
103         timeout      => 60,
104         keep_alive   => 1,
105         verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
106         no_proxy     => $ENV{no_proxy},
107     };
108
109     bless $self, $class;
110
111     $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
112
113     for my $key ( @attributes ) {
114         $self->{$key} = $args{$key} if exists $args{$key}
115     }
116
117     $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
118
119     $self->_set_proxies;
120
121     return $self;
122 }
123
124 sub _set_proxies {
125     my ($self) = @_;
126
127     # get proxies from %ENV only if not provided; explicit undef will disable
128     # getting proxies from the environment
129
130     # generic proxy
131     if (! exists $self->{proxy} ) {
132         $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
133     }
134
135     if ( defined $self->{proxy} ) {
136         $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
137     }
138     else {
139         delete $self->{proxy};
140     }
141
142     # http proxy
143     if (! exists $self->{http_proxy} ) {
144         # under CGI, bypass HTTP_PROXY as request sets it from Proxy header
145         local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
146         $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
147     }
148
149     if ( defined $self->{http_proxy} ) {
150         $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
151         $self->{_has_proxy}{http} = 1;
152     }
153     else {
154         delete $self->{http_proxy};
155     }
156
157     # https proxy
158     if (! exists $self->{https_proxy} ) {
159         $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
160     }
161
162     if ( $self->{https_proxy} ) {
163         $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
164         $self->{_has_proxy}{https} = 1;
165     }
166     else {
167         delete $self->{https_proxy};
168     }
169
170     # Split no_proxy to array reference if not provided as such
171     unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
172         $self->{no_proxy} =
173             (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
174     }
175
176     return;
177 }
178
179 #pod =method get|head|put|post|delete
180 #pod
181 #pod     $response = $http->get($url);
182 #pod     $response = $http->get($url, \%options);
183 #pod     $response = $http->head($url);
184 #pod
185 #pod These methods are shorthand for calling C<request()> for the given method.  The
186 #pod URL must have unsafe characters escaped and international domain names encoded.
187 #pod See C<request()> for valid options and a description of the response.
188 #pod
189 #pod The C<success> field of the response will be true if the status code is 2XX.
190 #pod
191 #pod =cut
192
193 for my $sub_name ( qw/get head put post delete/ ) {
194     my $req_method = uc $sub_name;
195     no strict 'refs';
196     eval <<"HERE"; ## no critic
197     sub $sub_name {
198         my (\$self, \$url, \$args) = \@_;
199         \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
200         or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
201         return \$self->request('$req_method', \$url, \$args || {});
202     }
203 HERE
204 }
205
206 #pod =method post_form
207 #pod
208 #pod     $response = $http->post_form($url, $form_data);
209 #pod     $response = $http->post_form($url, $form_data, \%options);
210 #pod
211 #pod This method executes a C<POST> request and sends the key/value pairs from a
212 #pod form data hash or array reference to the given URL with a C<content-type> of
213 #pod C<application/x-www-form-urlencoded>.  If data is provided as an array
214 #pod reference, the order is preserved; if provided as a hash reference, the terms
215 #pod are sorted on key and value for consistency.  See documentation for the
216 #pod C<www_form_urlencode> method for details on the encoding.
217 #pod
218 #pod The URL must have unsafe characters escaped and international domain names
219 #pod encoded.  See C<request()> for valid options and a description of the response.
220 #pod Any C<content-type> header or content in the options hashref will be ignored.
221 #pod
222 #pod The C<success> field of the response will be true if the status code is 2XX.
223 #pod
224 #pod =cut
225
226 sub post_form {
227     my ($self, $url, $data, $args) = @_;
228     (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
229         or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
230
231     my $headers = {};
232     while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
233         $headers->{lc $key} = $value;
234     }
235     delete $args->{headers};
236
237     return $self->request('POST', $url, {
238             %$args,
239             content => $self->www_form_urlencode($data),
240             headers => {
241                 %$headers,
242                 'content-type' => 'application/x-www-form-urlencoded'
243             },
244         }
245     );
246 }
247
248 #pod =method mirror
249 #pod
250 #pod     $response = $http->mirror($url, $file, \%options)
251 #pod     if ( $response->{success} ) {
252 #pod         print "$file is up to date\n";
253 #pod     }
254 #pod
255 #pod Executes a C<GET> request for the URL and saves the response body to the file
256 #pod name provided.  The URL must have unsafe characters escaped and international
257 #pod domain names encoded.  If the file already exists, the request will include an
258 #pod C<If-Modified-Since> header with the modification timestamp of the file.  You
259 #pod may specify a different C<If-Modified-Since> header yourself in the C<<
260 #pod $options->{headers} >> hash.
261 #pod
262 #pod The C<success> field of the response will be true if the status code is 2XX
263 #pod or if the status code is 304 (unmodified).
264 #pod
265 #pod If the file was modified and the server response includes a properly
266 #pod formatted C<Last-Modified> header, the file modification time will
267 #pod be updated accordingly.
268 #pod
269 #pod =cut
270
271 sub mirror {
272     my ($self, $url, $file, $args) = @_;
273     @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
274       or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
275     if ( -e $file and my $mtime = (stat($file))[9] ) {
276         $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
277     }
278     my $tempfile = $file . int(rand(2**31));
279
280     require Fcntl;
281     sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
282        or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
283     binmode $fh;
284     $args->{data_callback} = sub { print {$fh} $_[0] };
285     my $response = $self->request('GET', $url, $args);
286     close $fh
287         or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
288
289     if ( $response->{success} ) {
290         rename $tempfile, $file
291             or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
292         my $lm = $response->{headers}{'last-modified'};
293         if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
294             utime $mtime, $mtime, $file;
295         }
296     }
297     $response->{success} ||= $response->{status} eq '304';
298     unlink $tempfile;
299     return $response;
300 }
301
302 #pod =method request
303 #pod
304 #pod     $response = $http->request($method, $url);
305 #pod     $response = $http->request($method, $url, \%options);
306 #pod
307 #pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
308 #pod 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
309 #pod international domain names encoded.
310 #pod
311 #pod If the URL includes a "user:password" stanza, they will be used for Basic-style
312 #pod authorization headers.  (Authorization headers will not be included in a
313 #pod redirected request.) For example:
314 #pod
315 #pod     $http->request('GET', 'http://Aladdin:open sesame@example.com/');
316 #pod
317 #pod If the "user:password" stanza contains reserved characters, they must
318 #pod be percent-escaped:
319 #pod
320 #pod     $http->request('GET', 'http://john%40example.com:password@example.com/');
321 #pod
322 #pod A hashref of options may be appended to modify the request.
323 #pod
324 #pod Valid options are:
325 #pod
326 #pod =for :list
327 #pod * C<headers> —
328 #pod     A hashref containing headers to include with the request.  If the value for
329 #pod     a header is an array reference, the header will be output multiple times with
330 #pod     each value in the array.  These headers over-write any default headers.
331 #pod * C<content> —
332 #pod     A scalar to include as the body of the request OR a code reference
333 #pod     that will be called iteratively to produce the body of the request
334 #pod * C<trailer_callback> —
335 #pod     A code reference that will be called if it exists to provide a hashref
336 #pod     of trailing headers (only used with chunked transfer-encoding)
337 #pod * C<data_callback> —
338 #pod     A code reference that will be called for each chunks of the response
339 #pod     body received.
340 #pod
341 #pod The C<Host> header is generated from the URL in accordance with RFC 2616.  It
342 #pod is a fatal error to specify C<Host> in the C<headers> option.  Other headers
343 #pod may be ignored or overwritten if necessary for transport compliance.
344 #pod
345 #pod If the C<content> option is a code reference, it will be called iteratively
346 #pod to provide the content body of the request.  It should return the empty
347 #pod string or undef when the iterator is exhausted.
348 #pod
349 #pod If the C<content> option is the empty string, no C<content-type> or
350 #pod C<content-length> headers will be generated.
351 #pod
352 #pod If the C<data_callback> option is provided, it will be called iteratively until
353 #pod the entire response body is received.  The first argument will be a string
354 #pod containing a chunk of the response body, the second argument will be the
355 #pod in-progress response hash reference, as described below.  (This allows
356 #pod customizing the action of the callback based on the C<status> or C<headers>
357 #pod received prior to the content body.)
358 #pod
359 #pod The C<request> method returns a hashref containing the response.  The hashref
360 #pod will have the following keys:
361 #pod
362 #pod =for :list
363 #pod * C<success> —
364 #pod     Boolean indicating whether the operation returned a 2XX status code
365 #pod * C<url> —
366 #pod     URL that provided the response. This is the URL of the request unless
367 #pod     there were redirections, in which case it is the last URL queried
368 #pod     in a redirection chain
369 #pod * C<status> —
370 #pod     The HTTP status code of the response
371 #pod * C<reason> —
372 #pod     The response phrase returned by the server
373 #pod * C<content> —
374 #pod     The body of the response.  If the response does not have any content
375 #pod     or if a data callback is provided to consume the response body,
376 #pod     this will be the empty string
377 #pod * C<headers> —
378 #pod     A hashref of header fields.  All header field names will be normalized
379 #pod     to be lower case. If a header is repeated, the value will be an arrayref;
380 #pod     it will otherwise be a scalar string containing the value
381 #pod
382 #pod On an exception during the execution of the request, the C<status> field will
383 #pod contain 599, and the C<content> field will contain the text of the exception.
384 #pod
385 #pod =cut
386
387 my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
388
389 sub request {
390     my ($self, $method, $url, $args) = @_;
391     @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
392       or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
393     $args ||= {}; # we keep some state in this during _request
394
395     # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
396     my $response;
397     for ( 0 .. 1 ) {
398         $response = eval { $self->_request($method, $url, $args) };
399         last unless $@ && $idempotent{$method}
400             && $@ =~ m{^(?:Socket closed|Unexpected end)};
401     }
402
403     if (my $e = $@) {
404         # maybe we got a response hash thrown from somewhere deep
405         if ( ref $e eq 'HASH' && exists $e->{status} ) {
406             return $e;
407         }
408
409         # otherwise, stringify it
410         $e = "$e";
411         $response = {
412             url     => $url,
413             success => q{},
414             status  => 599,
415             reason  => 'Internal Exception',
416             content => $e,
417             headers => {
418                 'content-type'   => 'text/plain',
419                 'content-length' => length $e,
420             }
421         };
422     }
423     return $response;
424 }
425
426 #pod =method www_form_urlencode
427 #pod
428 #pod     $params = $http->www_form_urlencode( $data );
429 #pod     $response = $http->get("http://example.com/query?$params");
430 #pod
431 #pod This method converts the key/value pairs from a data hash or array reference
432 #pod into a C<x-www-form-urlencoded> string.  The keys and values from the data
433 #pod reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
434 #pod array reference, the key will be repeated with each of the values of the array
435 #pod reference.  If data is provided as a hash reference, the key/value pairs in the
436 #pod resulting string will be sorted by key and value for consistent ordering.
437 #pod
438 #pod =cut
439
440 sub www_form_urlencode {
441     my ($self, $data) = @_;
442     (@_ == 2 && ref $data)
443         or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
444     (ref $data eq 'HASH' || ref $data eq 'ARRAY')
445         or Carp::croak("form data must be a hash or array reference\n");
446
447     my @params = ref $data eq 'HASH' ? %$data : @$data;
448     @params % 2 == 0
449         or Carp::croak("form data reference must have an even number of terms\n");
450
451     my @terms;
452     while( @params ) {
453         my ($key, $value) = splice(@params, 0, 2);
454         if ( ref $value eq 'ARRAY' ) {
455             unshift @params, map { $key => $_ } @$value;
456         }
457         else {
458             push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
459         }
460     }
461
462     return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
463 }
464
465 #--------------------------------------------------------------------------#
466 # private methods
467 #--------------------------------------------------------------------------#
468
469 my %DefaultPort = (
470     http => 80,
471     https => 443,
472 );
473
474 sub _agent {
475     my $class = ref($_[0]) || $_[0];
476     (my $default_agent = $class) =~ s{::}{-}g;
477     return $default_agent . "/" . $class->VERSION;
478 }
479
480 sub _request {
481     my ($self, $method, $url, $args) = @_;
482
483     my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
484
485     my $request = {
486         method    => $method,
487         scheme    => $scheme,
488         host      => $host,
489         port      => $port,
490         host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
491         uri       => $path_query,
492         headers   => {},
493     };
494
495     # We remove the cached handle so it is not reused in the case of redirect.
496     # If all is well, it will be recached at the end of _request.  We only
497     # reuse for the same scheme, host and port
498     my $handle = delete $self->{handle};
499     if ( $handle ) {
500         unless ( $handle->can_reuse( $scheme, $host, $port ) ) {
501             $handle->close;
502             undef $handle;
503         }
504     }
505     $handle ||= $self->_open_handle( $request, $scheme, $host, $port );
506
507     $self->_prepare_headers_and_cb($request, $args, $url, $auth);
508     $handle->write_request($request);
509
510     my $response;
511     do { $response = $handle->read_response_header }
512         until (substr($response->{status},0,1) ne '1');
513
514     $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
515
516     if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
517         $handle->close;
518         return $self->_request(@redir_args, $args);
519     }
520
521     my $known_message_length;
522     if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
523         # response has no message body
524         $known_message_length = 1;
525     }
526     else {
527         my $data_cb = $self->_prepare_data_cb($response, $args);
528         $known_message_length = $handle->read_body($data_cb, $response);
529     }
530
531     if ( $self->{keep_alive}
532         && $known_message_length
533         && $response->{protocol} eq 'HTTP/1.1'
534         && ($response->{headers}{connection} || '') ne 'close'
535     ) {
536         $self->{handle} = $handle;
537     }
538     else {
539         $handle->close;
540     }
541
542     $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
543     $response->{url} = $url;
544     return $response;
545 }
546
547 sub _open_handle {
548     my ($self, $request, $scheme, $host, $port) = @_;
549
550     my $handle  = HTTP::Tiny::Handle->new(
551         timeout         => $self->{timeout},
552         SSL_options     => $self->{SSL_options},
553         verify_SSL      => $self->{verify_SSL},
554         local_address   => $self->{local_address},
555         keep_alive      => $self->{keep_alive}
556     );
557
558     if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
559         return $self->_proxy_connect( $request, $handle );
560     }
561     else {
562         return $handle->connect($scheme, $host, $port);
563     }
564 }
565
566 sub _proxy_connect {
567     my ($self, $request, $handle) = @_;
568
569     my @proxy_vars;
570     if ( $request->{scheme} eq 'https' ) {
571         Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
572         @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
573         if ( $proxy_vars[0] eq 'https' ) {
574             Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
575         }
576     }
577     else {
578         Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
579         @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
580     }
581
582     my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
583
584     if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
585         $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
586     }
587
588     $handle->connect($p_scheme, $p_host, $p_port);
589
590     if ($request->{scheme} eq 'https') {
591         $self->_create_proxy_tunnel( $request, $handle );
592     }
593     else {
594         # non-tunneled proxy requires absolute URI
595         $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
596     }
597
598     return $handle;
599 }
600
601 sub _split_proxy {
602     my ($self, $type, $proxy) = @_;
603
604     my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
605
606     unless(
607         defined($scheme) && length($scheme) && length($host) && length($port)
608         && $path_query eq '/'
609     ) {
610         Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
611     }
612
613     return ($scheme, $host, $port, $auth);
614 }
615
616 sub _create_proxy_tunnel {
617     my ($self, $request, $handle) = @_;
618
619     $handle->_assert_ssl;
620
621     my $agent = exists($request->{headers}{'user-agent'})
622         ? $request->{headers}{'user-agent'} : $self->{agent};
623
624     my $connect_request = {
625         method    => 'CONNECT',
626         uri       => "$request->{host}:$request->{port}",
627         headers   => {
628             host => "$request->{host}:$request->{port}",
629             'user-agent' => $agent,
630         }
631     };
632
633     if ( $request->{headers}{'proxy-authorization'} ) {
634         $connect_request->{headers}{'proxy-authorization'} =
635             delete $request->{headers}{'proxy-authorization'};
636     }
637
638     $handle->write_request($connect_request);
639     my $response;
640     do { $response = $handle->read_response_header }
641         until (substr($response->{status},0,1) ne '1');
642
643     # if CONNECT failed, throw the response so it will be
644     # returned from the original request() method;
645     unless (substr($response->{status},0,1) eq '2') {
646         die $response;
647     }
648
649     # tunnel established, so start SSL handshake
650     $handle->start_ssl( $request->{host} );
651
652     return;
653 }
654
655 sub _prepare_headers_and_cb {
656     my ($self, $request, $args, $url, $auth) = @_;
657
658     for ($self->{default_headers}, $args->{headers}) {
659         next unless defined;
660         while (my ($k, $v) = each %$_) {
661             $request->{headers}{lc $k} = $v;
662         }
663     }
664
665     if (exists $request->{headers}{'host'}) {
666         die(qq/The 'Host' header must not be provided as header option\n/);
667     }
668
669     $request->{headers}{'host'}         = $request->{host_port};
670     $request->{headers}{'user-agent'} ||= $self->{agent};
671     $request->{headers}{'connection'}   = "close"
672         unless $self->{keep_alive};
673
674     if ( defined $args->{content} ) {
675         if (ref $args->{content} eq 'CODE') {
676             $request->{headers}{'content-type'} ||= "application/octet-stream";
677             $request->{headers}{'transfer-encoding'} = 'chunked'
678               unless $request->{headers}{'content-length'}
679                   || $request->{headers}{'transfer-encoding'};
680             $request->{cb} = $args->{content};
681         }
682         elsif ( length $args->{content} ) {
683             my $content = $args->{content};
684             if ( $] ge '5.008' ) {
685                 utf8::downgrade($content, 1)
686                     or die(qq/Wide character in request message body\n/);
687             }
688             $request->{headers}{'content-type'} ||= "application/octet-stream";
689             $request->{headers}{'content-length'} = length $content
690               unless $request->{headers}{'content-length'}
691                   || $request->{headers}{'transfer-encoding'};
692             $request->{cb} = sub { substr $content, 0, length $content, '' };
693         }
694         $request->{trailer_cb} = $args->{trailer_callback}
695             if ref $args->{trailer_callback} eq 'CODE';
696     }
697
698     ### If we have a cookie jar, then maybe add relevant cookies
699     if ( $self->{cookie_jar} ) {
700         my $cookies = $self->cookie_jar->cookie_header( $url );
701         $request->{headers}{cookie} = $cookies if length $cookies;
702     }
703
704     # if we have Basic auth parameters, add them
705     if ( length $auth && ! defined $request->{headers}{authorization} ) {
706         $self->_add_basic_auth_header( $request, 'authorization' => $auth );
707     }
708
709     return;
710 }
711
712 sub _add_basic_auth_header {
713     my ($self, $request, $header, $auth) = @_;
714     require MIME::Base64;
715     $request->{headers}{$header} =
716         "Basic " . MIME::Base64::encode_base64($auth, "");
717     return;
718 }
719
720 sub _prepare_data_cb {
721     my ($self, $response, $args) = @_;
722     my $data_cb = $args->{data_callback};
723     $response->{content} = '';
724
725     if (!$data_cb || $response->{status} !~ /^2/) {
726         if (defined $self->{max_size}) {
727             $data_cb = sub {
728                 $_[1]->{content} .= $_[0];
729                 die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
730                   if length $_[1]->{content} > $self->{max_size};
731             };
732         }
733         else {
734             $data_cb = sub { $_[1]->{content} .= $_[0] };
735         }
736     }
737     return $data_cb;
738 }
739
740 sub _update_cookie_jar {
741     my ($self, $url, $response) = @_;
742
743     my $cookies = $response->{headers}->{'set-cookie'};
744     return unless defined $cookies;
745
746     my @cookies = ref $cookies ? @$cookies : $cookies;
747
748     $self->cookie_jar->add( $url, $_ ) for @cookies;
749
750     return;
751 }
752
753 sub _validate_cookie_jar {
754     my ($class, $jar) = @_;
755
756     # duck typing
757     for my $method ( qw/add cookie_header/ ) {
758         Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
759             unless ref($jar) && ref($jar)->can($method);
760     }
761
762     return;
763 }
764
765 sub _maybe_redirect {
766     my ($self, $request, $response, $args) = @_;
767     my $headers = $response->{headers};
768     my ($status, $method) = ($response->{status}, $request->{method});
769     if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
770         and $headers->{location}
771         and ++$args->{redirects} <= $self->{max_redirect}
772     ) {
773         my $location = ($headers->{location} =~ /^\//)
774             ? "$request->{scheme}://$request->{host_port}$headers->{location}"
775             : $headers->{location} ;
776         return (($status eq '303' ? 'GET' : $method), $location);
777     }
778     return;
779 }
780
781 sub _split_url {
782     my $url = pop;
783
784     # URI regex adapted from the URI module
785     my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
786       or die(qq/Cannot parse URL: '$url'\n/);
787
788     $scheme     = lc $scheme;
789     $path_query = "/$path_query" unless $path_query =~ m<\A/>;
790
791     my $auth = '';
792     if ( (my $i = index $host, '@') != -1 ) {
793         # user:pass@host
794         $auth = substr $host, 0, $i, ''; # take up to the @ for auth
795         substr $host, 0, 1, '';          # knock the @ off the host
796
797         # userinfo might be percent escaped, so recover real auth info
798         $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
799     }
800     my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
801              : $scheme eq 'http'                  ? 80
802              : $scheme eq 'https'                 ? 443
803              : undef;
804
805     return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
806 }
807
808 # Date conversions adapted from HTTP::Date
809 my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
810 my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
811 sub _http_date {
812     my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
813     return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
814         substr($DoW,$wday*4,3),
815         $mday, substr($MoY,$mon*4,3), $year+1900,
816         $hour, $min, $sec
817     );
818 }
819
820 sub _parse_http_date {
821     my ($self, $str) = @_;
822     require Time::Local;
823     my @tl_parts;
824     if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
825         @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
826     }
827     elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
828         @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
829     }
830     elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
831         @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
832     }
833     return eval {
834         my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
835         $t < 0 ? undef : $t;
836     };
837 }
838
839 # URI escaping adapted from URI::Escape
840 # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
841 # perl 5.6 ready UTF-8 encoding adapted from JSON::PP
842 my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
843 $escapes{' '}="+";
844 my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
845
846 sub _uri_escape {
847     my ($self, $str) = @_;
848     if ( $] ge '5.008' ) {
849         utf8::encode($str);
850     }
851     else {
852         $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
853             if ( length $str == do { use bytes; length $str } );
854         $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
855     }
856     $str =~ s/($unsafe_char)/$escapes{$1}/ge;
857     return $str;
858 }
859
860 package
861     HTTP::Tiny::Handle; # hide from PAUSE/indexers
862 use strict;
863 use warnings;
864
865 use Errno      qw[EINTR EPIPE];
866 use IO::Socket qw[SOCK_STREAM];
867
868 # PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
869 # behavior if someone is unable to boostrap CPAN from a new perl install; it is
870 # not intended for general, per-client use and may be removed in the future
871 my $SOCKET_CLASS =
872     $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
873     eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
874     'IO::Socket::INET';
875
876 sub BUFSIZE () { 32768 } ## no critic
877
878 my $Printable = sub {
879     local $_ = shift;
880     s/\r/\\r/g;
881     s/\n/\\n/g;
882     s/\t/\\t/g;
883     s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
884     $_;
885 };
886
887 my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
888
889 sub new {
890     my ($class, %args) = @_;
891     return bless {
892         rbuf             => '',
893         timeout          => 60,
894         max_line_size    => 16384,
895         max_header_lines => 64,
896         verify_SSL       => 0,
897         SSL_options      => {},
898         %args
899     }, $class;
900 }
901
902 sub connect {
903     @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
904     my ($self, $scheme, $host, $port) = @_;
905
906     if ( $scheme eq 'https' ) {
907         $self->_assert_ssl;
908     }
909     elsif ( $scheme ne 'http' ) {
910       die(qq/Unsupported URL scheme '$scheme'\n/);
911     }
912     $self->{fh} = $SOCKET_CLASS->new(
913         PeerHost  => $host,
914         PeerPort  => $port,
915         $self->{local_address} ?
916             ( LocalAddr => $self->{local_address} ) : (),
917         Proto     => 'tcp',
918         Type      => SOCK_STREAM,
919         Timeout   => $self->{timeout},
920         KeepAlive => !!$self->{keep_alive}
921     ) or die(qq/Could not connect to '$host:$port': $@\n/);
922
923     binmode($self->{fh})
924       or die(qq/Could not binmode() socket: '$!'\n/);
925
926     $self->start_ssl($host) if $scheme eq 'https';
927
928     $self->{scheme} = $scheme;
929     $self->{host} = $host;
930     $self->{port} = $port;
931     $self->{pid} = $$;
932     $self->{tid} = _get_tid();
933
934     return $self;
935 }
936
937 sub start_ssl {
938     my ($self, $host) = @_;
939
940     # As this might be used via CONNECT after an SSL session
941     # to a proxy, we shut down any existing SSL before attempting
942     # the handshake
943     if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
944         unless ( $self->{fh}->stop_SSL ) {
945             my $ssl_err = IO::Socket::SSL->errstr;
946             die(qq/Error halting prior SSL connection: $ssl_err/);
947         }
948     }
949
950     my $ssl_args = $self->_ssl_args($host);
951     IO::Socket::SSL->start_SSL(
952         $self->{fh},
953         %$ssl_args,
954         SSL_create_ctx_callback => sub {
955             my $ctx = shift;
956             Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
957         },
958     );
959
960     unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
961         my $ssl_err = IO::Socket::SSL->errstr;
962         die(qq/SSL connection failed for $host: $ssl_err\n/);
963     }
964 }
965
966 sub close {
967     @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
968     my ($self) = @_;
969     CORE::close($self->{fh})
970       or die(qq/Could not close socket: '$!'\n/);
971 }
972
973 sub write {
974     @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
975     my ($self, $buf) = @_;
976
977     if ( $] ge '5.008' ) {
978         utf8::downgrade($buf, 1)
979             or die(qq/Wide character in write()\n/);
980     }
981
982     my $len = length $buf;
983     my $off = 0;
984
985     local $SIG{PIPE} = 'IGNORE';
986
987     while () {
988         $self->can_write
989           or die(qq/Timed out while waiting for socket to become ready for writing\n/);
990         my $r = syswrite($self->{fh}, $buf, $len, $off);
991         if (defined $r) {
992             $len -= $r;
993             $off += $r;
994             last unless $len > 0;
995         }
996         elsif ($! == EPIPE) {
997             die(qq/Socket closed by remote server: $!\n/);
998         }
999         elsif ($! != EINTR) {
1000             if ($self->{fh}->can('errstr')){
1001                 my $err = $self->{fh}->errstr();
1002                 die (qq/Could not write to SSL socket: '$err'\n /);
1003             }
1004             else {
1005                 die(qq/Could not write to socket: '$!'\n/);
1006             }
1007
1008         }
1009     }
1010     return $off;
1011 }
1012
1013 sub read {
1014     @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
1015     my ($self, $len, $allow_partial) = @_;
1016
1017     my $buf  = '';
1018     my $got = length $self->{rbuf};
1019
1020     if ($got) {
1021         my $take = ($got < $len) ? $got : $len;
1022         $buf  = substr($self->{rbuf}, 0, $take, '');
1023         $len -= $take;
1024     }
1025
1026     while ($len > 0) {
1027         $self->can_read
1028           or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
1029         my $r = sysread($self->{fh}, $buf, $len, length $buf);
1030         if (defined $r) {
1031             last unless $r;
1032             $len -= $r;
1033         }
1034         elsif ($! != EINTR) {
1035             if ($self->{fh}->can('errstr')){
1036                 my $err = $self->{fh}->errstr();
1037                 die (qq/Could not read from SSL socket: '$err'\n /);
1038             }
1039             else {
1040                 die(qq/Could not read from socket: '$!'\n/);
1041             }
1042         }
1043     }
1044     if ($len && !$allow_partial) {
1045         die(qq/Unexpected end of stream\n/);
1046     }
1047     return $buf;
1048 }
1049
1050 sub readline {
1051     @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
1052     my ($self) = @_;
1053
1054     while () {
1055         if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
1056             return $1;
1057         }
1058         if (length $self->{rbuf} >= $self->{max_line_size}) {
1059             die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
1060         }
1061         $self->can_read
1062           or die(qq/Timed out while waiting for socket to become ready for reading\n/);
1063         my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
1064         if (defined $r) {
1065             last unless $r;
1066         }
1067         elsif ($! != EINTR) {
1068             if ($self->{fh}->can('errstr')){
1069                 my $err = $self->{fh}->errstr();
1070                 die (qq/Could not read from SSL socket: '$err'\n /);
1071             }
1072             else {
1073                 die(qq/Could not read from socket: '$!'\n/);
1074             }
1075         }
1076     }
1077     die(qq/Unexpected end of stream while looking for line\n/);
1078 }
1079
1080 sub read_header_lines {
1081     @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
1082     my ($self, $headers) = @_;
1083     $headers ||= {};
1084     my $lines   = 0;
1085     my $val;
1086
1087     while () {
1088          my $line = $self->readline;
1089
1090          if (++$lines >= $self->{max_header_lines}) {
1091              die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
1092          }
1093          elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
1094              my ($field_name) = lc $1;
1095              if (exists $headers->{$field_name}) {
1096                  for ($headers->{$field_name}) {
1097                      $_ = [$_] unless ref $_ eq "ARRAY";
1098                      push @$_, $2;
1099                      $val = \$_->[-1];
1100                  }
1101              }
1102              else {
1103                  $val = \($headers->{$field_name} = $2);
1104              }
1105          }
1106          elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
1107              $val
1108                or die(qq/Unexpected header continuation line\n/);
1109              next unless length $1;
1110              $$val .= ' ' if length $$val;
1111              $$val .= $1;
1112          }
1113          elsif ($line =~ /\A \x0D?\x0A \z/x) {
1114             last;
1115          }
1116          else {
1117             die(q/Malformed header line: / . $Printable->($line) . "\n");
1118          }
1119     }
1120     return $headers;
1121 }
1122
1123 sub write_request {
1124     @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
1125     my($self, $request) = @_;
1126     $self->write_request_header(@{$request}{qw/method uri headers/});
1127     $self->write_body($request) if $request->{cb};
1128     return;
1129 }
1130
1131 my %HeaderCase = (
1132     'content-md5'      => 'Content-MD5',
1133     'etag'             => 'ETag',
1134     'te'               => 'TE',
1135     'www-authenticate' => 'WWW-Authenticate',
1136     'x-xss-protection' => 'X-XSS-Protection',
1137 );
1138
1139 # to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
1140 # combine writes.
1141 sub write_header_lines {
1142     (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n");
1143     my($self, $headers, $prefix_data) = @_;
1144
1145     my $buf = (defined $prefix_data ? $prefix_data : '');
1146     while (my ($k, $v) = each %$headers) {
1147         my $field_name = lc $k;
1148         if (exists $HeaderCase{$field_name}) {
1149             $field_name = $HeaderCase{$field_name};
1150         }
1151         else {
1152             $field_name =~ /\A $Token+ \z/xo
1153               or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
1154             $field_name =~ s/\b(\w)/\u$1/g;
1155             $HeaderCase{lc $field_name} = $field_name;
1156         }
1157         for (ref $v eq 'ARRAY' ? @$v : $v) {
1158             $_ = '' unless defined $_;
1159             $buf .= "$field_name: $_\x0D\x0A";
1160         }
1161     }
1162     $buf .= "\x0D\x0A";
1163     return $self->write($buf);
1164 }
1165
1166 # return value indicates whether message length was defined; this is generally
1167 # true unless there was no content-length header and we just read until EOF.
1168 # Other message length errors are thrown as exceptions
1169 sub read_body {
1170     @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
1171     my ($self, $cb, $response) = @_;
1172     my $te = $response->{headers}{'transfer-encoding'} || '';
1173     my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
1174     return $chunked
1175         ? $self->read_chunked_body($cb, $response)
1176         : $self->read_content_body($cb, $response);
1177 }
1178
1179 sub write_body {
1180     @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
1181     my ($self, $request) = @_;
1182     if ($request->{headers}{'content-length'}) {
1183         return $self->write_content_body($request);
1184     }
1185     else {
1186         return $self->write_chunked_body($request);
1187     }
1188 }
1189
1190 sub read_content_body {
1191     @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
1192     my ($self, $cb, $response, $content_length) = @_;
1193     $content_length ||= $response->{headers}{'content-length'};
1194
1195     if ( defined $content_length ) {
1196         my $len = $content_length;
1197         while ($len > 0) {
1198             my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
1199             $cb->($self->read($read, 0), $response);
1200             $len -= $read;
1201         }
1202         return length($self->{rbuf}) == 0;
1203     }
1204
1205     my $chunk;
1206     $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
1207
1208     return;
1209 }
1210
1211 sub write_content_body {
1212     @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
1213     my ($self, $request) = @_;
1214
1215     my ($len, $content_length) = (0, $request->{headers}{'content-length'});
1216     while () {
1217         my $data = $request->{cb}->();
1218
1219         defined $data && length $data
1220           or last;
1221
1222         if ( $] ge '5.008' ) {
1223             utf8::downgrade($data, 1)
1224                 or die(qq/Wide character in write_content()\n/);
1225         }
1226
1227         $len += $self->write($data);
1228     }
1229
1230     $len == $content_length
1231       or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
1232
1233     return $len;
1234 }
1235
1236 sub read_chunked_body {
1237     @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
1238     my ($self, $cb, $response) = @_;
1239
1240     while () {
1241         my $head = $self->readline;
1242
1243         $head =~ /\A ([A-Fa-f0-9]+)/x
1244           or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
1245
1246         my $len = hex($1)
1247           or last;
1248
1249         $self->read_content_body($cb, $response, $len);
1250
1251         $self->read(2) eq "\x0D\x0A"
1252           or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
1253     }
1254     $self->read_header_lines($response->{headers});
1255     return 1;
1256 }
1257
1258 sub write_chunked_body {
1259     @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
1260     my ($self, $request) = @_;
1261
1262     my $len = 0;
1263     while () {
1264         my $data = $request->{cb}->();
1265
1266         defined $data && length $data
1267           or last;
1268
1269         if ( $] ge '5.008' ) {
1270             utf8::downgrade($data, 1)
1271                 or die(qq/Wide character in write_chunked_body()\n/);
1272         }
1273
1274         $len += length $data;
1275
1276         my $chunk  = sprintf '%X', length $data;
1277            $chunk .= "\x0D\x0A";
1278            $chunk .= $data;
1279            $chunk .= "\x0D\x0A";
1280
1281         $self->write($chunk);
1282     }
1283     $self->write("0\x0D\x0A");
1284     $self->write_header_lines($request->{trailer_cb}->())
1285         if ref $request->{trailer_cb} eq 'CODE';
1286     return $len;
1287 }
1288
1289 sub read_response_header {
1290     @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
1291     my ($self) = @_;
1292
1293     my $line = $self->readline;
1294
1295     $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
1296       or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
1297
1298     my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
1299
1300     die (qq/Unsupported HTTP protocol: $protocol\n/)
1301         unless $version =~ /0*1\.0*[01]/;
1302
1303     return {
1304         status       => $status,
1305         reason       => $reason,
1306         headers      => $self->read_header_lines,
1307         protocol     => $protocol,
1308     };
1309 }
1310
1311 sub write_request_header {
1312     @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
1313     my ($self, $method, $request_uri, $headers) = @_;
1314
1315     return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A");
1316 }
1317
1318 sub _do_timeout {
1319     my ($self, $type, $timeout) = @_;
1320     $timeout = $self->{timeout}
1321         unless defined $timeout && $timeout >= 0;
1322
1323     my $fd = fileno $self->{fh};
1324     defined $fd && $fd >= 0
1325       or die(qq/select(2): 'Bad file descriptor'\n/);
1326
1327     my $initial = time;
1328     my $pending = $timeout;
1329     my $nfound;
1330
1331     vec(my $fdset = '', $fd, 1) = 1;
1332
1333     while () {
1334         $nfound = ($type eq 'read')
1335             ? select($fdset, undef, undef, $pending)
1336             : select(undef, $fdset, undef, $pending) ;
1337         if ($nfound == -1) {
1338             $! == EINTR
1339               or die(qq/select(2): '$!'\n/);
1340             redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
1341             $nfound = 0;
1342         }
1343         last;
1344     }
1345     $! = 0;
1346     return $nfound;
1347 }
1348
1349 sub can_read {
1350     @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
1351     my $self = shift;
1352     if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
1353         return 1 if $self->{fh}->pending;
1354     }
1355     return $self->_do_timeout('read', @_)
1356 }
1357
1358 sub can_write {
1359     @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
1360     my $self = shift;
1361     return $self->_do_timeout('write', @_)
1362 }
1363
1364 sub _assert_ssl {
1365     # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
1366     die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
1367         unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
1368     # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
1369     die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
1370         unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
1371 }
1372
1373 sub can_reuse {
1374     my ($self,$scheme,$host,$port) = @_;
1375     return 0 if
1376         $self->{pid} != $$
1377         || $self->{tid} != _get_tid()
1378         || length($self->{rbuf})
1379         || $scheme ne $self->{scheme}
1380         || $host ne $self->{host}
1381         || $port ne $self->{port}
1382         || eval { $self->can_read(0) }
1383         || $@ ;
1384         return 1;
1385 }
1386
1387 # Try to find a CA bundle to validate the SSL cert,
1388 # prefer Mozilla::CA or fallback to a system file
1389 sub _find_CA_file {
1390     my $self = shift();
1391
1392     return $self->{SSL_options}->{SSL_ca_file}
1393         if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
1394
1395     return Mozilla::CA::SSL_ca_file()
1396         if eval { require Mozilla::CA };
1397
1398     # cert list copied from golang src/crypto/x509/root_unix.go
1399     foreach my $ca_bundle (
1400         "/etc/ssl/certs/ca-certificates.crt",     # Debian/Ubuntu/Gentoo etc.
1401         "/etc/pki/tls/certs/ca-bundle.crt",       # Fedora/RHEL
1402         "/etc/ssl/ca-bundle.pem",                 # OpenSUSE
1403         "/etc/openssl/certs/ca-certificates.crt", # NetBSD
1404         "/etc/ssl/cert.pem",                      # OpenBSD
1405         "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly
1406         "/etc/pki/tls/cacert.pem",                # OpenELEC
1407         "/etc/certs/ca-certificates.crt",         # Solaris 11.2+
1408     ) {
1409         return $ca_bundle if -e $ca_bundle;
1410     }
1411
1412     die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
1413       . qq/Try installing Mozilla::CA from CPAN\n/;
1414 }
1415
1416 # for thread safety, we need to know thread id if threads are loaded
1417 sub _get_tid {
1418     no warnings 'reserved'; # for 'threads'
1419     return threads->can("tid") ? threads->tid : 0;
1420 }
1421
1422 sub _ssl_args {
1423     my ($self, $host) = @_;
1424
1425     my %ssl_args;
1426
1427     # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
1428     # added until IO::Socket::SSL 1.84
1429     if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
1430         $ssl_args{SSL_hostname} = $host,          # Sane SNI support
1431     }
1432
1433     if ($self->{verify_SSL}) {
1434         $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
1435         $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
1436         $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
1437         $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
1438     }
1439     else {
1440         $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
1441         $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
1442     }
1443
1444     # user options override settings from verify_SSL
1445     for my $k ( keys %{$self->{SSL_options}} ) {
1446         $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
1447     }
1448
1449     return \%ssl_args;
1450 }
1451
1452 1;
1453
1454 __END__
1455
1456 =pod
1457
1458 =encoding UTF-8
1459
1460 =head1 NAME
1461
1462 HTTP::Tiny - A small, simple, correct HTTP/1.1 client
1463
1464 =head1 VERSION
1465
1466 version 0.054
1467
1468 =head1 SYNOPSIS
1469
1470     use HTTP::Tiny;
1471
1472     my $response = HTTP::Tiny->new->get('http://example.com/');
1473
1474     die "Failed!\n" unless $response->{success};
1475
1476     print "$response->{status} $response->{reason}\n";
1477
1478     while (my ($k, $v) = each %{$response->{headers}}) {
1479         for (ref $v eq 'ARRAY' ? @$v : $v) {
1480             print "$k: $_\n";
1481         }
1482     }
1483
1484     print $response->{content} if length $response->{content};
1485
1486 =head1 DESCRIPTION
1487
1488 This is a very simple HTTP/1.1 client, designed for doing simple
1489 requests without the overhead of a large framework like L<LWP::UserAgent>.
1490
1491 It is more correct and more complete than L<HTTP::Lite>.  It supports
1492 proxies and redirection.  It also correctly resumes after EINTR.
1493
1494 If L<IO::Socket::IP> 0.25 or later is installed, HTTP::Tiny will use it instead
1495 of L<IO::Socket::INET> for transparent support for both IPv4 and IPv6.
1496
1497 Cookie support requires L<HTTP::CookieJar> or an equivalent class.
1498
1499 =head1 METHODS
1500
1501 =head2 new
1502
1503     $http = HTTP::Tiny->new( %attributes );
1504
1505 This constructor returns a new HTTP::Tiny object.  Valid attributes include:
1506
1507 =over 4
1508
1509 =item *
1510
1511 C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.
1512
1513 =item *
1514
1515 C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods
1516
1517 =item *
1518
1519 C<default_headers> — A hashref of default headers to apply to requests
1520
1521 =item *
1522
1523 C<local_address> — The local IP address to bind to
1524
1525 =item *
1526
1527 C<keep_alive> — Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
1528
1529 =item *
1530
1531 C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
1532
1533 =item *
1534
1535 C<max_size> — Maximum response size (only when not using a data callback).  If defined, responses larger than this will return an exception.
1536
1537 =item *
1538
1539 C<http_proxy> — URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)
1540
1541 =item *
1542
1543 C<https_proxy> — URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)
1544
1545 =item *
1546
1547 C<proxy> — URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)
1548
1549 =item *
1550
1551 C<no_proxy> — List of domain suffixes that should not be proxied.  Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)
1552
1553 =item *
1554
1555 C<timeout> — Request timeout in seconds (default is 60)
1556
1557 =item *
1558
1559 C<verify_SSL> — A boolean that indicates whether to validate the SSL certificate of an C<https> — connection (default is false)
1560
1561 =item *
1562
1563 C<SSL_options> — A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
1564
1565 =back
1566
1567 Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
1568 prevent getting the corresponding proxies from the environment.
1569
1570 Exceptions from C<max_size>, C<timeout> or other errors will result in a
1571 pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
1572 content field in the response will contain the text of the exception.
1573
1574 The C<keep_alive> parameter enables a persistent connection, but only to a
1575 single destination scheme, host and port.  Also, if any connection-relevant
1576 attributes are modified, or if the process ID or thread ID change, the
1577 persistent connection will be dropped.  If you want persistent connections
1578 across multiple destinations, use multiple HTTP::Tiny objects.
1579
1580 See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
1581
1582 =head2 get|head|put|post|delete
1583
1584     $response = $http->get($url);
1585     $response = $http->get($url, \%options);
1586     $response = $http->head($url);
1587
1588 These methods are shorthand for calling C<request()> for the given method.  The
1589 URL must have unsafe characters escaped and international domain names encoded.
1590 See C<request()> for valid options and a description of the response.
1591
1592 The C<success> field of the response will be true if the status code is 2XX.
1593
1594 =head2 post_form
1595
1596     $response = $http->post_form($url, $form_data);
1597     $response = $http->post_form($url, $form_data, \%options);
1598
1599 This method executes a C<POST> request and sends the key/value pairs from a
1600 form data hash or array reference to the given URL with a C<content-type> of
1601 C<application/x-www-form-urlencoded>.  If data is provided as an array
1602 reference, the order is preserved; if provided as a hash reference, the terms
1603 are sorted on key and value for consistency.  See documentation for the
1604 C<www_form_urlencode> method for details on the encoding.
1605
1606 The URL must have unsafe characters escaped and international domain names
1607 encoded.  See C<request()> for valid options and a description of the response.
1608 Any C<content-type> header or content in the options hashref will be ignored.
1609
1610 The C<success> field of the response will be true if the status code is 2XX.
1611
1612 =head2 mirror
1613
1614     $response = $http->mirror($url, $file, \%options)
1615     if ( $response->{success} ) {
1616         print "$file is up to date\n";
1617     }
1618
1619 Executes a C<GET> request for the URL and saves the response body to the file
1620 name provided.  The URL must have unsafe characters escaped and international
1621 domain names encoded.  If the file already exists, the request will include an
1622 C<If-Modified-Since> header with the modification timestamp of the file.  You
1623 may specify a different C<If-Modified-Since> header yourself in the C<<
1624 $options->{headers} >> hash.
1625
1626 The C<success> field of the response will be true if the status code is 2XX
1627 or if the status code is 304 (unmodified).
1628
1629 If the file was modified and the server response includes a properly
1630 formatted C<Last-Modified> header, the file modification time will
1631 be updated accordingly.
1632
1633 =head2 request
1634
1635     $response = $http->request($method, $url);
1636     $response = $http->request($method, $url, \%options);
1637
1638 Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
1639 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
1640 international domain names encoded.
1641
1642 If the URL includes a "user:password" stanza, they will be used for Basic-style
1643 authorization headers.  (Authorization headers will not be included in a
1644 redirected request.) For example:
1645
1646     $http->request('GET', 'http://Aladdin:open sesame@example.com/');
1647
1648 If the "user:password" stanza contains reserved characters, they must
1649 be percent-escaped:
1650
1651     $http->request('GET', 'http://john%40example.com:password@example.com/');
1652
1653 A hashref of options may be appended to modify the request.
1654
1655 Valid options are:
1656
1657 =over 4
1658
1659 =item *
1660
1661 C<headers> — A hashref containing headers to include with the request.  If the value for a header is an array reference, the header will be output multiple times with each value in the array.  These headers over-write any default headers.
1662
1663 =item *
1664
1665 C<content> — A scalar to include as the body of the request OR a code reference that will be called iteratively to produce the body of the request
1666
1667 =item *
1668
1669 C<trailer_callback> — A code reference that will be called if it exists to provide a hashref of trailing headers (only used with chunked transfer-encoding)
1670
1671 =item *
1672
1673 C<data_callback> — A code reference that will be called for each chunks of the response body received.
1674
1675 =back
1676
1677 The C<Host> header is generated from the URL in accordance with RFC 2616.  It
1678 is a fatal error to specify C<Host> in the C<headers> option.  Other headers
1679 may be ignored or overwritten if necessary for transport compliance.
1680
1681 If the C<content> option is a code reference, it will be called iteratively
1682 to provide the content body of the request.  It should return the empty
1683 string or undef when the iterator is exhausted.
1684
1685 If the C<content> option is the empty string, no C<content-type> or
1686 C<content-length> headers will be generated.
1687
1688 If the C<data_callback> option is provided, it will be called iteratively until
1689 the entire response body is received.  The first argument will be a string
1690 containing a chunk of the response body, the second argument will be the
1691 in-progress response hash reference, as described below.  (This allows
1692 customizing the action of the callback based on the C<status> or C<headers>
1693 received prior to the content body.)
1694
1695 The C<request> method returns a hashref containing the response.  The hashref
1696 will have the following keys:
1697
1698 =over 4
1699
1700 =item *
1701
1702 C<success> — Boolean indicating whether the operation returned a 2XX status code
1703
1704 =item *
1705
1706 C<url> — URL that provided the response. This is the URL of the request unless there were redirections, in which case it is the last URL queried in a redirection chain
1707
1708 =item *
1709
1710 C<status> — The HTTP status code of the response
1711
1712 =item *
1713
1714 C<reason> — The response phrase returned by the server
1715
1716 =item *
1717
1718 C<content> — The body of the response.  If the response does not have any content or if a data callback is provided to consume the response body, this will be the empty string
1719
1720 =item *
1721
1722 C<headers> — A hashref of header fields.  All header field names will be normalized to be lower case. If a header is repeated, the value will be an arrayref; it will otherwise be a scalar string containing the value
1723
1724 =back
1725
1726 On an exception during the execution of the request, the C<status> field will
1727 contain 599, and the C<content> field will contain the text of the exception.
1728
1729 =head2 www_form_urlencode
1730
1731     $params = $http->www_form_urlencode( $data );
1732     $response = $http->get("http://example.com/query?$params");
1733
1734 This method converts the key/value pairs from a data hash or array reference
1735 into a C<x-www-form-urlencoded> string.  The keys and values from the data
1736 reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
1737 array reference, the key will be repeated with each of the values of the array
1738 reference.  If data is provided as a hash reference, the key/value pairs in the
1739 resulting string will be sorted by key and value for consistent ordering.
1740
1741 =for Pod::Coverage SSL_options
1742 agent
1743 cookie_jar
1744 default_headers
1745 http_proxy
1746 https_proxy
1747 keep_alive
1748 local_address
1749 max_redirect
1750 max_size
1751 no_proxy
1752 proxy
1753 timeout
1754 verify_SSL
1755
1756 =head1 SSL SUPPORT
1757
1758 Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
1759 greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
1760 thrown if new enough versions of these modules are not installed or if the SSL
1761 encryption fails. An C<https> connection may be made via an C<http> proxy that
1762 supports the CONNECT command (i.e. RFC 2817).  You may not proxy C<https> via
1763 a proxy that itself requires C<https> to communicate.
1764
1765 SSL provides two distinct capabilities:
1766
1767 =over 4
1768
1769 =item *
1770
1771 Encrypted communication channel
1772
1773 =item *
1774
1775 Verification of server identity
1776
1777 =back
1778
1779 B<By default, HTTP::Tiny does not verify server identity>.
1780
1781 Server identity verification is controversial and potentially tricky because it
1782 depends on a (usually paid) third-party Certificate Authority (CA) trust model
1783 to validate a certificate as legitimate.  This discriminates against servers
1784 with self-signed certificates or certificates signed by free, community-driven
1785 CA's such as L<CAcert.org|http://cacert.org>.
1786
1787 By default, HTTP::Tiny does not make any assumptions about your trust model,
1788 threat level or risk tolerance.  It just aims to give you an encrypted channel
1789 when you need one.
1790
1791 Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
1792 that an SSL connection has a valid SSL certificate corresponding to the host
1793 name of the connection and that the SSL certificate has been verified by a CA.
1794 Assuming you trust the CA, this will protect against a L<man-in-the-middle
1795 attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
1796 concerned about security, you should enable this option.
1797
1798 Certificate verification requires a file containing trusted CA certificates.
1799 If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
1800 included with it as a source of trusted CA's.  (This means you trust Mozilla,
1801 the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
1802 toolchain used to install it, and your operating system security, right?)
1803
1804 If that module is not available, then HTTP::Tiny will search several
1805 system-specific default locations for a CA certificate file:
1806
1807 =over 4
1808
1809 =item *
1810
1811 /etc/ssl/certs/ca-certificates.crt
1812
1813 =item *
1814
1815 /etc/pki/tls/certs/ca-bundle.crt
1816
1817 =item *
1818
1819 /etc/ssl/ca-bundle.pem
1820
1821 =back
1822
1823 An exception will be raised if C<verify_SSL> is true and no CA certificate file
1824 is available.
1825
1826 If you desire complete control over SSL connections, the C<SSL_options> attribute
1827 lets you provide a hash reference that will be passed through to
1828 C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
1829 example, to provide your own trusted CA file:
1830
1831     SSL_options => {
1832         SSL_ca_file => $file_path,
1833     }
1834
1835 The C<SSL_options> attribute could also be used for such things as providing a
1836 client certificate for authentication to a server or controlling the choice of
1837 cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
1838 details.
1839
1840 =head1 PROXY SUPPORT
1841
1842 HTTP::Tiny can proxy both C<http> and C<https> requests.  Only Basic proxy
1843 authorization is supported and it must be provided as part of the proxy URL:
1844 C<http://user:pass@proxy.example.com/>.
1845
1846 HTTP::Tiny supports the following proxy environment variables:
1847
1848 =over 4
1849
1850 =item *
1851
1852 http_proxy or HTTP_PROXY
1853
1854 =item *
1855
1856 https_proxy or HTTPS_PROXY
1857
1858 =item *
1859
1860 all_proxy or ALL_PROXY
1861
1862 =back
1863
1864 If the C<REQUEST_METHOD> environment variable is set, then this might be a CGI
1865 process and C<HTTP_PROXY> would be set from the C<Proxy:> header, which is a
1866 security risk.  If C<REQUEST_METHOD> is set, C<HTTP_PROXY> (the upper case
1867 variant only) is ignored.
1868
1869 Tunnelling C<https> over an C<http> proxy using the CONNECT method is
1870 supported.  If your proxy uses C<https> itself, you can not tunnel C<https>
1871 over it.
1872
1873 Be warned that proxying an C<https> connection opens you to the risk of a
1874 man-in-the-middle attack by the proxy server.
1875
1876 The C<no_proxy> environment variable is supported in the format of a
1877 comma-separated list of domain extensions proxy should not be used for.
1878
1879 Proxy arguments passed to C<new> will override their corresponding
1880 environment variables.
1881
1882 =head1 LIMITATIONS
1883
1884 HTTP::Tiny is I<conditionally compliant> with the
1885 L<HTTP/1.1 specifications|http://www.w3.org/Protocols/>:
1886
1887 =over 4
1888
1889 =item *
1890
1891 "Message Syntax and Routing" [RFC7230]
1892
1893 =item *
1894
1895 "Semantics and Content" [RFC7231]
1896
1897 =item *
1898
1899 "Conditional Requests" [RFC7232]
1900
1901 =item *
1902
1903 "Range Requests" [RFC7233]
1904
1905 =item *
1906
1907 "Caching" [RFC7234]
1908
1909 =item *
1910
1911 "Authentication" [RFC7235]
1912
1913 =back
1914
1915 It attempts to meet all "MUST" requirements of the specification, but does not
1916 implement all "SHOULD" requirements.  (Note: it was developed against the
1917 earlier RFC 2616 specification and may not yet meet the revised RFC 7230-7235
1918 spec.)
1919
1920 Some particular limitations of note include:
1921
1922 =over
1923
1924 =item *
1925
1926 HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
1927 that user-defined headers and content are compliant with the HTTP/1.1
1928 specification.
1929
1930 =item *
1931
1932 Users must ensure that URLs are properly escaped for unsafe characters and that
1933 international domain names are properly encoded to ASCII. See L<URI::Escape>,
1934 L<URI::_punycode> and L<Net::IDN::Encode>.
1935
1936 =item *
1937
1938 Redirection is very strict against the specification.  Redirection is only
1939 automatic for response codes 301, 302 and 307 if the request method is 'GET' or
1940 'HEAD'.  Response code 303 is always converted into a 'GET' redirection, as
1941 mandated by the specification.  There is no automatic support for status 305
1942 ("Use proxy") redirections.
1943
1944 =item *
1945
1946 There is no provision for delaying a request body using an C<Expect> header.
1947 Unexpected C<1XX> responses are silently ignored as per the specification.
1948
1949 =item *
1950
1951 Only 'chunked' C<Transfer-Encoding> is supported.
1952
1953 =item *
1954
1955 There is no support for a Request-URI of '*' for the 'OPTIONS' request.
1956
1957 =back
1958
1959 Despite the limitations listed above, HTTP::Tiny is considered
1960 feature-complete.  New feature requests should be directed to
1961 L<HTTP::Tiny::UA>.
1962
1963 =head1 SEE ALSO
1964
1965 =over 4
1966
1967 =item *
1968
1969 L<HTTP::Tiny::UA> - Higher level UA features for HTTP::Tiny
1970
1971 =item *
1972
1973 L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
1974
1975 =item *
1976
1977 L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface
1978
1979 =item *
1980
1981 L<IO::Socket::IP> - Required for IPv6 support
1982
1983 =item *
1984
1985 L<IO::Socket::SSL> - Required for SSL support
1986
1987 =item *
1988
1989 L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things
1990
1991 =item *
1992
1993 L<Mozilla::CA> - Required if you want to validate SSL certificates
1994
1995 =item *
1996
1997 L<Net::SSLeay> - Required for SSL support
1998
1999 =back
2000
2001 =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
2002
2003 =head1 SUPPORT
2004
2005 =head2 Bugs / Feature Requests
2006
2007 Please report any bugs or feature requests through the issue tracker
2008 at L<https://github.com/chansen/p5-http-tiny/issues>.
2009 You will be notified automatically of any progress on your issue.
2010
2011 =head2 Source Code
2012
2013 This is open source software.  The code repository is available for
2014 public review and contribution under the terms of the license.
2015
2016 L<https://github.com/chansen/p5-http-tiny>
2017
2018   git clone https://github.com/chansen/p5-http-tiny.git
2019
2020 =head1 AUTHORS
2021
2022 =over 4
2023
2024 =item *
2025
2026 Christian Hansen <chansen@cpan.org>
2027
2028 =item *
2029
2030 David Golden <dagolden@cpan.org>
2031
2032 =back
2033
2034 =head1 CONTRIBUTORS
2035
2036 =for stopwords Alan Gardner Alessandro Ghedini Brad Gilbert Chris Nehren Weyl Claes Jakobsson Clinton Gormley Craig Berry David Mitchell Dean Pearce Edward Zborowski James Raspass Jess Robinson Lukas Eklund Martin J. Evans Martin-Louis Bright Mike Doherty Olaf Alders Petr Písař Serguei Trouchelle Sören Kornetzki Syohei YOSHIDA Tom Hukins Tony Cook
2037
2038 =over 4
2039
2040 =item *
2041
2042 Alan Gardner <gardner@pythian.com>
2043
2044 =item *
2045
2046 Alessandro Ghedini <al3xbio@gmail.com>
2047
2048 =item *
2049
2050 Brad Gilbert <bgills@cpan.org>
2051
2052 =item *
2053
2054 Chris Nehren <apeiron@cpan.org>
2055
2056 =item *
2057
2058 Chris Weyl <cweyl@alumni.drew.edu>
2059
2060 =item *
2061
2062 Claes Jakobsson <claes@surfar.nu>
2063
2064 =item *
2065
2066 Clinton Gormley <clint@traveljury.com>
2067
2068 =item *
2069
2070 Craig Berry <cberry@cpan.org>
2071
2072 =item *
2073
2074 David Mitchell <davem@iabyn.com>
2075
2076 =item *
2077
2078 Dean Pearce <pearce@pythian.com>
2079
2080 =item *
2081
2082 Edward Zborowski <ed@rubensteintech.com>
2083
2084 =item *
2085
2086 James Raspass <jraspass@gmail.com>
2087
2088 =item *
2089
2090 Jess Robinson <castaway@desert-island.me.uk>
2091
2092 =item *
2093
2094 Lukas Eklund <leklund@gmail.com>
2095
2096 =item *
2097
2098 Martin J. Evans <mjegh@ntlworld.com>
2099
2100 =item *
2101
2102 Martin-Louis Bright <mlbright@gmail.com>
2103
2104 =item *
2105
2106 Mike Doherty <doherty@cpan.org>
2107
2108 =item *
2109
2110 Olaf Alders <olaf@wundersolutions.com>
2111
2112 =item *
2113
2114 Petr Písař <ppisar@redhat.com>
2115
2116 =item *
2117
2118 Serguei Trouchelle <stro@cpan.org>
2119
2120 =item *
2121
2122 Sören Kornetzki <soeren.kornetzki@delti.com>
2123
2124 =item *
2125
2126 Syohei YOSHIDA <syohex@gmail.com>
2127
2128 =item *
2129
2130 Tom Hukins <tom@eborcom.com>
2131
2132 =item *
2133
2134 Tony Cook <tony@develop-help.com>
2135
2136 =back
2137
2138 =head1 COPYRIGHT AND LICENSE
2139
2140 This software is copyright (c) 2015 by Christian Hansen.
2141
2142 This is free software; you can redistribute it and/or modify it under
2143 the same terms as the Perl 5 programming language system itself.
2144
2145 =cut