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