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