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