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