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.033
[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.033'; # VERSION
7
8 use Carp ();
9
10
11 my @attributes;
12 BEGIN {
13     @attributes = qw(cookie_jar default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);
14     no strict 'refs';
15     for my $accessor ( @attributes ) {
16         *{$accessor} = sub {
17             @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
18         };
19     }
20 }
21
22 sub agent {
23     my($self, $agent) = @_;
24     if( @_ > 1 ){
25         $self->{agent} =
26             (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
27     }
28     return $self->{agent};
29 }
30
31 sub new {
32     my($class, %args) = @_;
33
34     my $self = {
35         max_redirect => 5,
36         timeout      => 60,
37         verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
38         no_proxy     => $ENV{no_proxy},
39     };
40
41     bless $self, $class;
42
43     $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
44
45     for my $key ( @attributes ) {
46         $self->{$key} = $args{$key} if exists $args{$key}
47     }
48
49     $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
50
51     # Never override proxy argument as this breaks backwards compat.
52     if (!exists $self->{proxy} && (my $http_proxy = $ENV{http_proxy})) {
53         if ($http_proxy =~ m{\Ahttp://[^/?#:@]+:\d+/?\z}) {
54             $self->{proxy} = $http_proxy;
55         }
56         else {
57             Carp::croak(qq{Environment 'http_proxy' must be in format http://<host>:<port>/\n});
58         }
59     }
60
61     # Split no_proxy to array reference if not provided as such
62     unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
63         $self->{no_proxy} =
64             (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
65     }
66
67     return $self;
68 }
69
70
71 for my $sub_name ( qw/get head put post delete/ ) {
72     my $req_method = uc $sub_name;
73     no strict 'refs';
74     eval <<"HERE"; ## no critic
75     sub $sub_name {
76         my (\$self, \$url, \$args) = \@_;
77         \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
78         or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
79         return \$self->request('$req_method', \$url, \$args || {});
80     }
81 HERE
82 }
83
84
85 sub post_form {
86     my ($self, $url, $data, $args) = @_;
87     (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
88         or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
89
90     my $headers = {};
91     while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
92         $headers->{lc $key} = $value;
93     }
94     delete $args->{headers};
95
96     return $self->request('POST', $url, {
97             %$args,
98             content => $self->www_form_urlencode($data),
99             headers => {
100                 %$headers,
101                 'content-type' => 'application/x-www-form-urlencoded'
102             },
103         }
104     );
105 }
106
107
108 sub mirror {
109     my ($self, $url, $file, $args) = @_;
110     @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
111       or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
112     if ( -e $file and my $mtime = (stat($file))[9] ) {
113         $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
114     }
115     my $tempfile = $file . int(rand(2**31));
116     open my $fh, ">", $tempfile
117         or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!\n/);
118     binmode $fh;
119     $args->{data_callback} = sub { print {$fh} $_[0] };
120     my $response = $self->request('GET', $url, $args);
121     close $fh
122         or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!\n/);
123     if ( $response->{success} ) {
124         rename $tempfile, $file
125             or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
126         my $lm = $response->{headers}{'last-modified'};
127         if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
128             utime $mtime, $mtime, $file;
129         }
130     }
131     $response->{success} ||= $response->{status} eq '304';
132     unlink $tempfile;
133     return $response;
134 }
135
136
137 my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
138
139 sub request {
140     my ($self, $method, $url, $args) = @_;
141     @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
142       or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
143     $args ||= {}; # we keep some state in this during _request
144
145     # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
146     my $response;
147     for ( 0 .. 1 ) {
148         $response = eval { $self->_request($method, $url, $args) };
149         last unless $@ && $idempotent{$method}
150             && $@ =~ m{^(?:Socket closed|Unexpected end)};
151     }
152
153     if (my $e = "$@") {
154         $response = {
155             url     => $url,
156             success => q{},
157             status  => 599,
158             reason  => 'Internal Exception',
159             content => $e,
160             headers => {
161                 'content-type'   => 'text/plain',
162                 'content-length' => length $e,
163             }
164         };
165     }
166     return $response;
167 }
168
169
170 sub www_form_urlencode {
171     my ($self, $data) = @_;
172     (@_ == 2 && ref $data)
173         or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
174     (ref $data eq 'HASH' || ref $data eq 'ARRAY')
175         or Carp::croak("form data must be a hash or array reference\n");
176
177     my @params = ref $data eq 'HASH' ? %$data : @$data;
178     @params % 2 == 0
179         or Carp::croak("form data reference must have an even number of terms\n");
180
181     my @terms;
182     while( @params ) {
183         my ($key, $value) = splice(@params, 0, 2);
184         if ( ref $value eq 'ARRAY' ) {
185             unshift @params, map { $key => $_ } @$value;
186         }
187         else {
188             push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
189         }
190     }
191
192     return join("&", sort @terms);
193 }
194
195 #--------------------------------------------------------------------------#
196 # private methods
197 #--------------------------------------------------------------------------#
198
199 my %DefaultPort = (
200     http => 80,
201     https => 443,
202 );
203
204 sub _agent {
205     my $class = ref($_[0]) || $_[0];
206     (my $default_agent = $class) =~ s{::}{-}g;
207     return $default_agent . "/" . ($class->VERSION || 0);
208 }
209
210 sub _request {
211     my ($self, $method, $url, $args) = @_;
212
213     my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
214
215     my $request = {
216         method    => $method,
217         scheme    => $scheme,
218         host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
219         uri       => $path_query,
220         headers   => {},
221     };
222
223     my $handle  = HTTP::Tiny::Handle->new(
224         timeout         => $self->{timeout},
225         SSL_options     => $self->{SSL_options},
226         verify_SSL      => $self->{verify_SSL},
227         local_address   => $self->{local_address},
228     );
229
230     if ($self->{proxy} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
231         $request->{uri} = "$scheme://$request->{host_port}$path_query";
232         die(qq/HTTPS via proxy is not supported\n/)
233             if $request->{scheme} eq 'https';
234         $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
235     }
236     else {
237         $handle->connect($scheme, $host, $port);
238     }
239
240     $self->_prepare_headers_and_cb($request, $args, $url);
241     $handle->write_request($request);
242
243     my $response;
244     do { $response = $handle->read_response_header }
245         until (substr($response->{status},0,1) ne '1');
246
247     $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
248
249     if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
250         $handle->close;
251         return $self->_request(@redir_args, $args);
252     }
253
254     if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
255         # response has no message body
256     }
257     else {
258         my $data_cb = $self->_prepare_data_cb($response, $args);
259         $handle->read_body($data_cb, $response);
260     }
261
262     $handle->close;
263     $response->{success} = substr($response->{status},0,1) eq '2';
264     $response->{url} = $url;
265     return $response;
266 }
267
268 sub _prepare_headers_and_cb {
269     my ($self, $request, $args, $url) = @_;
270
271     for ($self->{default_headers}, $args->{headers}) {
272         next unless defined;
273         while (my ($k, $v) = each %$_) {
274             $request->{headers}{lc $k} = $v;
275         }
276     }
277     $request->{headers}{'host'}         = $request->{host_port};
278     $request->{headers}{'connection'}   = "close";
279     $request->{headers}{'user-agent'} ||= $self->{agent};
280
281     if ( defined $args->{content} ) {
282         if (ref $args->{content} eq 'CODE') {
283             $request->{headers}{'content-type'} ||= "application/octet-stream";
284             $request->{headers}{'transfer-encoding'} = 'chunked'
285               unless $request->{headers}{'content-length'}
286                   || $request->{headers}{'transfer-encoding'};
287             $request->{cb} = $args->{content};
288         }
289         elsif ( length $args->{content} ) {
290             my $content = $args->{content};
291             if ( $] ge '5.008' ) {
292                 utf8::downgrade($content, 1)
293                     or die(qq/Wide character in request message body\n/);
294             }
295             $request->{headers}{'content-type'} ||= "application/octet-stream";
296             $request->{headers}{'content-length'} = length $content
297               unless $request->{headers}{'content-length'}
298                   || $request->{headers}{'transfer-encoding'};
299             $request->{cb} = sub { substr $content, 0, length $content, '' };
300         }
301         $request->{trailer_cb} = $args->{trailer_callback}
302             if ref $args->{trailer_callback} eq 'CODE';
303     }
304
305     ### If we have a cookie jar, then maybe add relevant cookies
306     if ( $self->{cookie_jar} ) {
307         my $cookies = $self->cookie_jar->cookie_header( $url );
308         $request->{headers}{cookie} = $cookies if length $cookies;
309     }
310
311     return;
312 }
313
314 sub _prepare_data_cb {
315     my ($self, $response, $args) = @_;
316     my $data_cb = $args->{data_callback};
317     $response->{content} = '';
318
319     if (!$data_cb || $response->{status} !~ /^2/) {
320         if (defined $self->{max_size}) {
321             $data_cb = sub {
322                 $_[1]->{content} .= $_[0];
323                 die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
324                   if length $_[1]->{content} > $self->{max_size};
325             };
326         }
327         else {
328             $data_cb = sub { $_[1]->{content} .= $_[0] };
329         }
330     }
331     return $data_cb;
332 }
333
334 sub _update_cookie_jar {
335     my ($self, $url, $response) = @_;
336
337     my $cookies = $response->{headers}->{'set-cookie'};
338     return unless defined $cookies;
339
340     my @cookies = ref $cookies ? @$cookies : $cookies;
341
342     $self->cookie_jar->add( $url, $_ ) for @cookies;
343
344     return;
345 }
346
347 sub _validate_cookie_jar {
348     my ($class, $jar) = @_;
349
350     # duck typing
351     for my $method ( qw/add cookie_header/ ) {
352         Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
353             unless ref($jar) && ref($jar)->can($method);
354     }
355
356     return;
357 }
358
359 sub _maybe_redirect {
360     my ($self, $request, $response, $args) = @_;
361     my $headers = $response->{headers};
362     my ($status, $method) = ($response->{status}, $request->{method});
363     if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
364         and $headers->{location}
365         and ++$args->{redirects} <= $self->{max_redirect}
366     ) {
367         my $location = ($headers->{location} =~ /^\//)
368             ? "$request->{scheme}://$request->{host_port}$headers->{location}"
369             : $headers->{location} ;
370         return (($status eq '303' ? 'GET' : $method), $location);
371     }
372     return;
373 }
374
375 sub _split_url {
376     my $url = pop;
377
378     # URI regex adapted from the URI module
379     my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
380       or die(qq/Cannot parse URL: '$url'\n/);
381
382     $scheme     = lc $scheme;
383     $path_query = "/$path_query" unless $path_query =~ m<\A/>;
384
385     my $host = (length($authority)) ? lc $authority : 'localhost';
386        $host =~ s/\A[^@]*@//;   # userinfo
387     my $port = do {
388        $host =~ s/:([0-9]*)\z// && length $1
389          ? $1
390          : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
391     };
392
393     return ($scheme, $host, $port, $path_query);
394 }
395
396 # Date conversions adapted from HTTP::Date
397 my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
398 my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
399 sub _http_date {
400     my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
401     return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
402         substr($DoW,$wday*4,3),
403         $mday, substr($MoY,$mon*4,3), $year+1900,
404         $hour, $min, $sec
405     );
406 }
407
408 sub _parse_http_date {
409     my ($self, $str) = @_;
410     require Time::Local;
411     my @tl_parts;
412     if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
413         @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
414     }
415     elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
416         @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
417     }
418     elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
419         @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
420     }
421     return eval {
422         my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
423         $t < 0 ? undef : $t;
424     };
425 }
426
427 # URI escaping adapted from URI::Escape
428 # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
429 # perl 5.6 ready UTF-8 encoding adapted from JSON::PP
430 my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
431 $escapes{' '}="+";
432 my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
433
434 sub _uri_escape {
435     my ($self, $str) = @_;
436     if ( $] ge '5.008' ) {
437         utf8::encode($str);
438     }
439     else {
440         $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
441             if ( length $str == do { use bytes; length $str } );
442         $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
443     }
444     $str =~ s/($unsafe_char)/$escapes{$1}/ge;
445     return $str;
446 }
447
448 package
449     HTTP::Tiny::Handle; # hide from PAUSE/indexers
450 use strict;
451 use warnings;
452
453 use Errno      qw[EINTR EPIPE];
454 use IO::Socket qw[SOCK_STREAM];
455
456 sub BUFSIZE () { 32768 } ## no critic
457
458 my $Printable = sub {
459     local $_ = shift;
460     s/\r/\\r/g;
461     s/\n/\\n/g;
462     s/\t/\\t/g;
463     s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
464     $_;
465 };
466
467 my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
468
469 sub new {
470     my ($class, %args) = @_;
471     return bless {
472         rbuf             => '',
473         timeout          => 60,
474         max_line_size    => 16384,
475         max_header_lines => 64,
476         verify_SSL       => 0,
477         SSL_options      => {},
478         %args
479     }, $class;
480 }
481
482 sub connect {
483     @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
484     my ($self, $scheme, $host, $port) = @_;
485
486     if ( $scheme eq 'https' ) {
487         # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
488         die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
489             unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
490         # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
491         die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
492             unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
493     }
494     elsif ( $scheme ne 'http' ) {
495       die(qq/Unsupported URL scheme '$scheme'\n/);
496     }
497     $self->{fh} = 'IO::Socket::INET'->new(
498         PeerHost  => $host,
499         PeerPort  => $port,
500         $self->{local_address} ?
501             ( LocalAddr => $self->{local_address} ) : (),
502         Proto     => 'tcp',
503         Type      => SOCK_STREAM,
504         Timeout   => $self->{timeout}
505     ) or die(qq/Could not connect to '$host:$port': $@\n/);
506
507     binmode($self->{fh})
508       or die(qq/Could not binmode() socket: '$!'\n/);
509
510     if ( $scheme eq 'https') {
511         my $ssl_args = $self->_ssl_args($host);
512         IO::Socket::SSL->start_SSL(
513             $self->{fh},
514             %$ssl_args,
515             SSL_create_ctx_callback => sub {
516                 my $ctx = shift;
517                 Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
518             },
519         );
520
521         unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
522             my $ssl_err = IO::Socket::SSL->errstr;
523             die(qq/SSL connection failed for $host: $ssl_err\n/);
524         }
525     }
526
527     $self->{host} = $host;
528     $self->{port} = $port;
529
530     return $self;
531 }
532
533 sub close {
534     @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
535     my ($self) = @_;
536     CORE::close($self->{fh})
537       or die(qq/Could not close socket: '$!'\n/);
538 }
539
540 sub write {
541     @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
542     my ($self, $buf) = @_;
543
544     if ( $] ge '5.008' ) {
545         utf8::downgrade($buf, 1)
546             or die(qq/Wide character in write()\n/);
547     }
548
549     my $len = length $buf;
550     my $off = 0;
551
552     local $SIG{PIPE} = 'IGNORE';
553
554     while () {
555         $self->can_write
556           or die(qq/Timed out while waiting for socket to become ready for writing\n/);
557         my $r = syswrite($self->{fh}, $buf, $len, $off);
558         if (defined $r) {
559             $len -= $r;
560             $off += $r;
561             last unless $len > 0;
562         }
563         elsif ($! == EPIPE) {
564             die(qq/Socket closed by remote server: $!\n/);
565         }
566         elsif ($! != EINTR) {
567             if ($self->{fh}->can('errstr')){
568                 my $err = $self->{fh}->errstr();
569                 die (qq/Could not write to SSL socket: '$err'\n /);
570             }
571             else {
572                 die(qq/Could not write to socket: '$!'\n/);
573             }
574
575         }
576     }
577     return $off;
578 }
579
580 sub read {
581     @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
582     my ($self, $len, $allow_partial) = @_;
583
584     my $buf  = '';
585     my $got = length $self->{rbuf};
586
587     if ($got) {
588         my $take = ($got < $len) ? $got : $len;
589         $buf  = substr($self->{rbuf}, 0, $take, '');
590         $len -= $take;
591     }
592
593     while ($len > 0) {
594         $self->can_read
595           or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
596         my $r = sysread($self->{fh}, $buf, $len, length $buf);
597         if (defined $r) {
598             last unless $r;
599             $len -= $r;
600         }
601         elsif ($! != EINTR) {
602             if ($self->{fh}->can('errstr')){
603                 my $err = $self->{fh}->errstr();
604                 die (qq/Could not read from SSL socket: '$err'\n /);
605             }
606             else {
607                 die(qq/Could not read from socket: '$!'\n/);
608             }
609         }
610     }
611     if ($len && !$allow_partial) {
612         die(qq/Unexpected end of stream\n/);
613     }
614     return $buf;
615 }
616
617 sub readline {
618     @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
619     my ($self) = @_;
620
621     while () {
622         if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
623             return $1;
624         }
625         if (length $self->{rbuf} >= $self->{max_line_size}) {
626             die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
627         }
628         $self->can_read
629           or die(qq/Timed out while waiting for socket to become ready for reading\n/);
630         my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
631         if (defined $r) {
632             last unless $r;
633         }
634         elsif ($! != EINTR) {
635             if ($self->{fh}->can('errstr')){
636                 my $err = $self->{fh}->errstr();
637                 die (qq/Could not read from SSL socket: '$err'\n /);
638             }
639             else {
640                 die(qq/Could not read from socket: '$!'\n/);
641             }
642         }
643     }
644     die(qq/Unexpected end of stream while looking for line\n/);
645 }
646
647 sub read_header_lines {
648     @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
649     my ($self, $headers) = @_;
650     $headers ||= {};
651     my $lines   = 0;
652     my $val;
653
654     while () {
655          my $line = $self->readline;
656
657          if (++$lines >= $self->{max_header_lines}) {
658              die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
659          }
660          elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
661              my ($field_name) = lc $1;
662              if (exists $headers->{$field_name}) {
663                  for ($headers->{$field_name}) {
664                      $_ = [$_] unless ref $_ eq "ARRAY";
665                      push @$_, $2;
666                      $val = \$_->[-1];
667                  }
668              }
669              else {
670                  $val = \($headers->{$field_name} = $2);
671              }
672          }
673          elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
674              $val
675                or die(qq/Unexpected header continuation line\n/);
676              next unless length $1;
677              $$val .= ' ' if length $$val;
678              $$val .= $1;
679          }
680          elsif ($line =~ /\A \x0D?\x0A \z/x) {
681             last;
682          }
683          else {
684             die(q/Malformed header line: / . $Printable->($line) . "\n");
685          }
686     }
687     return $headers;
688 }
689
690 sub write_request {
691     @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
692     my($self, $request) = @_;
693     $self->write_request_header(@{$request}{qw/method uri headers/});
694     $self->write_body($request) if $request->{cb};
695     return;
696 }
697
698 my %HeaderCase = (
699     'content-md5'      => 'Content-MD5',
700     'etag'             => 'ETag',
701     'te'               => 'TE',
702     'www-authenticate' => 'WWW-Authenticate',
703     'x-xss-protection' => 'X-XSS-Protection',
704 );
705
706 sub write_header_lines {
707     (@_ == 2 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
708     my($self, $headers) = @_;
709
710     my $buf = '';
711     while (my ($k, $v) = each %$headers) {
712         my $field_name = lc $k;
713         if (exists $HeaderCase{$field_name}) {
714             $field_name = $HeaderCase{$field_name};
715         }
716         else {
717             $field_name =~ /\A $Token+ \z/xo
718               or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
719             $field_name =~ s/\b(\w)/\u$1/g;
720             $HeaderCase{lc $field_name} = $field_name;
721         }
722         for (ref $v eq 'ARRAY' ? @$v : $v) {
723             /[^\x0D\x0A]/
724               or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n");
725             $buf .= "$field_name: $_\x0D\x0A";
726         }
727     }
728     $buf .= "\x0D\x0A";
729     return $self->write($buf);
730 }
731
732 sub read_body {
733     @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
734     my ($self, $cb, $response) = @_;
735     my $te = $response->{headers}{'transfer-encoding'} || '';
736     if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
737         $self->read_chunked_body($cb, $response);
738     }
739     else {
740         $self->read_content_body($cb, $response);
741     }
742     return;
743 }
744
745 sub write_body {
746     @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
747     my ($self, $request) = @_;
748     if ($request->{headers}{'content-length'}) {
749         return $self->write_content_body($request);
750     }
751     else {
752         return $self->write_chunked_body($request);
753     }
754 }
755
756 sub read_content_body {
757     @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
758     my ($self, $cb, $response, $content_length) = @_;
759     $content_length ||= $response->{headers}{'content-length'};
760
761     if ( defined $content_length ) {
762         my $len = $content_length;
763         while ($len > 0) {
764             my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
765             $cb->($self->read($read, 0), $response);
766             $len -= $read;
767         }
768     }
769     else {
770         my $chunk;
771         $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
772     }
773
774     return;
775 }
776
777 sub write_content_body {
778     @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
779     my ($self, $request) = @_;
780
781     my ($len, $content_length) = (0, $request->{headers}{'content-length'});
782     while () {
783         my $data = $request->{cb}->();
784
785         defined $data && length $data
786           or last;
787
788         if ( $] ge '5.008' ) {
789             utf8::downgrade($data, 1)
790                 or die(qq/Wide character in write_content()\n/);
791         }
792
793         $len += $self->write($data);
794     }
795
796     $len == $content_length
797       or die(qq/Content-Length missmatch (got: $len expected: $content_length)\n/);
798
799     return $len;
800 }
801
802 sub read_chunked_body {
803     @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
804     my ($self, $cb, $response) = @_;
805
806     while () {
807         my $head = $self->readline;
808
809         $head =~ /\A ([A-Fa-f0-9]+)/x
810           or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
811
812         my $len = hex($1)
813           or last;
814
815         $self->read_content_body($cb, $response, $len);
816
817         $self->read(2) eq "\x0D\x0A"
818           or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
819     }
820     $self->read_header_lines($response->{headers});
821     return;
822 }
823
824 sub write_chunked_body {
825     @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
826     my ($self, $request) = @_;
827
828     my $len = 0;
829     while () {
830         my $data = $request->{cb}->();
831
832         defined $data && length $data
833           or last;
834
835         if ( $] ge '5.008' ) {
836             utf8::downgrade($data, 1)
837                 or die(qq/Wide character in write_chunked_body()\n/);
838         }
839
840         $len += length $data;
841
842         my $chunk  = sprintf '%X', length $data;
843            $chunk .= "\x0D\x0A";
844            $chunk .= $data;
845            $chunk .= "\x0D\x0A";
846
847         $self->write($chunk);
848     }
849     $self->write("0\x0D\x0A");
850     $self->write_header_lines($request->{trailer_cb}->())
851         if ref $request->{trailer_cb} eq 'CODE';
852     return $len;
853 }
854
855 sub read_response_header {
856     @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
857     my ($self) = @_;
858
859     my $line = $self->readline;
860
861     $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
862       or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
863
864     my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
865
866     die (qq/Unsupported HTTP protocol: $protocol\n/)
867         unless $version =~ /0*1\.0*[01]/;
868
869     return {
870         status   => $status,
871         reason   => $reason,
872         headers  => $self->read_header_lines,
873         protocol => $protocol,
874     };
875 }
876
877 sub write_request_header {
878     @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
879     my ($self, $method, $request_uri, $headers) = @_;
880
881     return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
882          + $self->write_header_lines($headers);
883 }
884
885 sub _do_timeout {
886     my ($self, $type, $timeout) = @_;
887     $timeout = $self->{timeout}
888         unless defined $timeout && $timeout >= 0;
889
890     my $fd = fileno $self->{fh};
891     defined $fd && $fd >= 0
892       or die(qq/select(2): 'Bad file descriptor'\n/);
893
894     my $initial = time;
895     my $pending = $timeout;
896     my $nfound;
897
898     vec(my $fdset = '', $fd, 1) = 1;
899
900     while () {
901         $nfound = ($type eq 'read')
902             ? select($fdset, undef, undef, $pending)
903             : select(undef, $fdset, undef, $pending) ;
904         if ($nfound == -1) {
905             $! == EINTR
906               or die(qq/select(2): '$!'\n/);
907             redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
908             $nfound = 0;
909         }
910         last;
911     }
912     $! = 0;
913     return $nfound;
914 }
915
916 sub can_read {
917     @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
918     my $self = shift;
919     return $self->_do_timeout('read', @_)
920 }
921
922 sub can_write {
923     @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
924     my $self = shift;
925     return $self->_do_timeout('write', @_)
926 }
927
928 # Try to find a CA bundle to validate the SSL cert,
929 # prefer Mozilla::CA or fallback to a system file
930 sub _find_CA_file {
931     my $self = shift();
932
933     return $self->{SSL_options}->{SSL_ca_file}
934         if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
935
936     return Mozilla::CA::SSL_ca_file()
937         if eval { require Mozilla::CA };
938
939     foreach my $ca_bundle (qw{
940         /etc/ssl/certs/ca-certificates.crt
941         /etc/pki/tls/certs/ca-bundle.crt
942         /etc/ssl/ca-bundle.pem
943         }
944     ) {
945         return $ca_bundle if -e $ca_bundle;
946     }
947
948     die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
949       . qq/Try installing Mozilla::CA from CPAN\n/;
950 }
951
952 sub _ssl_args {
953     my ($self, $host) = @_;
954
955     my %ssl_args;
956     
957     # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
958     # added until IO::Socket::SSL 1.84
959     if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
960         $ssl_args{SSL_hostname} = $host,          # Sane SNI support
961     }
962
963     if ($self->{verify_SSL}) {
964         $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
965         $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
966         $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
967         $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
968     }
969     else {
970         $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
971         $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
972     }
973
974     # user options override settings from verify_SSL
975     for my $k ( keys %{$self->{SSL_options}} ) {
976         $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
977     }
978
979     return \%ssl_args;
980 }
981
982 1;
983
984 __END__
985
986 =pod
987
988 =encoding utf-8
989
990 =head1 NAME
991
992 HTTP::Tiny - A small, simple, correct HTTP/1.1 client
993
994 =head1 VERSION
995
996 version 0.033
997
998 =head1 SYNOPSIS
999
1000     use HTTP::Tiny;
1001
1002     my $response = HTTP::Tiny->new->get('http://example.com/');
1003
1004     die "Failed!\n" unless $response->{success};
1005
1006     print "$response->{status} $response->{reason}\n";
1007
1008     while (my ($k, $v) = each %{$response->{headers}}) {
1009         for (ref $v eq 'ARRAY' ? @$v : $v) {
1010             print "$k: $_\n";
1011         }
1012     }
1013
1014     print $response->{content} if length $response->{content};
1015
1016 =head1 DESCRIPTION
1017
1018 This is a very simple HTTP/1.1 client, designed for doing simple GET
1019 requests without the overhead of a large framework like L<LWP::UserAgent>.
1020
1021 It is more correct and more complete than L<HTTP::Lite>.  It supports
1022 proxies (currently only non-authenticating ones) and redirection.  It
1023 also correctly resumes after EINTR.
1024
1025 =head1 METHODS
1026
1027 =head2 new
1028
1029     $http = HTTP::Tiny->new( %attributes );
1030
1031 This constructor returns a new HTTP::Tiny object.  Valid attributes include:
1032
1033 =over 4
1034
1035 =item *
1036
1037 C<agent>
1038
1039 A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
1040
1041 =item *
1042
1043 C<cookie_jar>
1044
1045 An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods
1046
1047 =item *
1048
1049 C<default_headers>
1050
1051 A hashref of default headers to apply to requests
1052
1053 =item *
1054
1055 C<local_address>
1056
1057 The local IP address to bind to
1058
1059 =item *
1060
1061 C<max_redirect>
1062
1063 Maximum number of redirects allowed (defaults to 5)
1064
1065 =item *
1066
1067 C<max_size>
1068
1069 Maximum response size (only when not using a data callback).  If defined,
1070 responses larger than this will return an exception.
1071
1072 =item *
1073
1074 C<proxy>
1075
1076 URL of a proxy server to use (default is C<$ENV{http_proxy}> if set)
1077
1078 =item *
1079
1080 C<no_proxy>
1081
1082 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}>)
1083
1084 =item *
1085
1086 C<timeout>
1087
1088 Request timeout in seconds (default is 60)
1089
1090 =item *
1091
1092 C<verify_SSL>
1093
1094 A boolean that indicates whether to validate the SSL certificate of an C<https>
1095 connection (default is false)
1096
1097 =item *
1098
1099 C<SSL_options>
1100
1101 A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
1102
1103 =back
1104
1105 Exceptions from C<max_size>, C<timeout> or other errors will result in a
1106 pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
1107 content field in the response will contain the text of the exception.
1108
1109 See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
1110
1111 =head2 get|head|put|post|delete
1112
1113     $response = $http->get($url);
1114     $response = $http->get($url, \%options);
1115     $response = $http->head($url);
1116
1117 These methods are shorthand for calling C<request()> for the given method.  The
1118 URL must have unsafe characters escaped and international domain names encoded.
1119 See C<request()> for valid options and a description of the response.
1120
1121 The C<success> field of the response will be true if the status code is 2XX.
1122
1123 =head2 post_form
1124
1125     $response = $http->post_form($url, $form_data);
1126     $response = $http->post_form($url, $form_data, \%options);
1127
1128 This method executes a C<POST> request and sends the key/value pairs from a
1129 form data hash or array reference to the given URL with a C<content-type> of
1130 C<application/x-www-form-urlencoded>.  See documentation for the
1131 C<www_form_urlencode> method for details on the encoding.
1132
1133 The URL must have unsafe characters escaped and international domain names
1134 encoded.  See C<request()> for valid options and a description of the response.
1135 Any C<content-type> header or content in the options hashref will be ignored.
1136
1137 The C<success> field of the response will be true if the status code is 2XX.
1138
1139 =head2 mirror
1140
1141     $response = $http->mirror($url, $file, \%options)
1142     if ( $response->{success} ) {
1143         print "$file is up to date\n";
1144     }
1145
1146 Executes a C<GET> request for the URL and saves the response body to the file
1147 name provided.  The URL must have unsafe characters escaped and international
1148 domain names encoded.  If the file already exists, the request will include an
1149 C<If-Modified-Since> header with the modification timestamp of the file.  You
1150 may specify a different C<If-Modified-Since> header yourself in the C<<
1151 $options->{headers} >> hash.
1152
1153 The C<success> field of the response will be true if the status code is 2XX
1154 or if the status code is 304 (unmodified).
1155
1156 If the file was modified and the server response includes a properly
1157 formatted C<Last-Modified> header, the file modification time will
1158 be updated accordingly.
1159
1160 =head2 request
1161
1162     $response = $http->request($method, $url);
1163     $response = $http->request($method, $url, \%options);
1164
1165 Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
1166 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
1167 international domain names encoded.  A hashref of options may be appended to
1168 modify the request.
1169
1170 Valid options are:
1171
1172 =over 4
1173
1174 =item *
1175
1176 C<headers>
1177
1178 A hashref containing headers to include with the request.  If the value for
1179 a header is an array reference, the header will be output multiple times with
1180 each value in the array.  These headers over-write any default headers.
1181
1182 =item *
1183
1184 C<content>
1185
1186 A scalar to include as the body of the request OR a code reference
1187 that will be called iteratively to produce the body of the request
1188
1189 =item *
1190
1191 C<trailer_callback>
1192
1193 A code reference that will be called if it exists to provide a hashref
1194 of trailing headers (only used with chunked transfer-encoding)
1195
1196 =item *
1197
1198 C<data_callback>
1199
1200 A code reference that will be called for each chunks of the response
1201 body received.
1202
1203 =back
1204
1205 If the C<content> option is a code reference, it will be called iteratively
1206 to provide the content body of the request.  It should return the empty
1207 string or undef when the iterator is exhausted.
1208
1209 If the C<content> option is the empty string, no C<content-type> or
1210 C<content-length> headers will be generated.
1211
1212 If the C<data_callback> option is provided, it will be called iteratively until
1213 the entire response body is received.  The first argument will be a string
1214 containing a chunk of the response body, the second argument will be the
1215 in-progress response hash reference, as described below.  (This allows
1216 customizing the action of the callback based on the C<status> or C<headers>
1217 received prior to the content body.)
1218
1219 The C<request> method returns a hashref containing the response.  The hashref
1220 will have the following keys:
1221
1222 =over 4
1223
1224 =item *
1225
1226 C<success>
1227
1228 Boolean indicating whether the operation returned a 2XX status code
1229
1230 =item *
1231
1232 C<url>
1233
1234 URL that provided the response. This is the URL of the request unless
1235 there were redirections, in which case it is the last URL queried
1236 in a redirection chain
1237
1238 =item *
1239
1240 C<status>
1241
1242 The HTTP status code of the response
1243
1244 =item *
1245
1246 C<reason>
1247
1248 The response phrase returned by the server
1249
1250 =item *
1251
1252 C<content>
1253
1254 The body of the response.  If the response does not have any content
1255 or if a data callback is provided to consume the response body,
1256 this will be the empty string
1257
1258 =item *
1259
1260 C<headers>
1261
1262 A hashref of header fields.  All header field names will be normalized
1263 to be lower case. If a header is repeated, the value will be an arrayref;
1264 it will otherwise be a scalar string containing the value
1265
1266 =back
1267
1268 On an exception during the execution of the request, the C<status> field will
1269 contain 599, and the C<content> field will contain the text of the exception.
1270
1271 =head2 www_form_urlencode
1272
1273     $params = $http->www_form_urlencode( $data );
1274     $response = $http->get("http://example.com/query?$params");
1275
1276 This method converts the key/value pairs from a data hash or array reference
1277 into a C<x-www-form-urlencoded> string.  The keys and values from the data
1278 reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
1279 array reference, the key will be repeated with each of the values of the array
1280 reference.  The key/value pairs in the resulting string will be sorted by key
1281 and value.
1282
1283 =for Pod::Coverage agent
1284 cookie_jar
1285 default_headers
1286 local_address
1287 max_redirect
1288 max_size
1289 proxy
1290 no_proxy
1291 timeout
1292 verify_SSL
1293 SSL_options
1294
1295 =head1 SSL SUPPORT
1296
1297 Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
1298 greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
1299 thrown if a new enough versions of these modules not installed or if the SSL
1300 encryption fails. There is no support for C<https> connections via proxy (i.e.
1301 RFC 2817).
1302
1303 SSL provides two distinct capabilities:
1304
1305 =over 4
1306
1307 =item *
1308
1309 Encrypted communication channel
1310
1311 =item *
1312
1313 Verification of server identity
1314
1315 =back
1316
1317 B<By default, HTTP::Tiny does not verify server identity>.
1318
1319 Server identity verification is controversial and potentially tricky because it
1320 depends on a (usually paid) third-party Certificate Authority (CA) trust model
1321 to validate a certificate as legitimate.  This discriminates against servers
1322 with self-signed certificates or certificates signed by free, community-driven
1323 CA's such as L<CAcert.org|http://cacert.org>.
1324
1325 By default, HTTP::Tiny does not make any assumptions about your trust model,
1326 threat level or risk tolerance.  It just aims to give you an encrypted channel
1327 when you need one.
1328
1329 Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
1330 that an SSL connection has a valid SSL certificate corresponding to the host
1331 name of the connection and that the SSL certificate has been verified by a CA.
1332 Assuming you trust the CA, this will protect against a L<man-in-the-middle
1333 attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
1334 concerned about security, you should enable this option.
1335
1336 Certificate verification requires a file containing trusted CA certificates.
1337 If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
1338 included with it as a source of trusted CA's.  (This means you trust Mozilla,
1339 the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
1340 toolchain used to install it, and your operating system security, right?)
1341
1342 If that module is not available, then HTTP::Tiny will search several
1343 system-specific default locations for a CA certificate file:
1344
1345 =over 4
1346
1347 =item *
1348
1349 /etc/ssl/certs/ca-certificates.crt
1350
1351 =item *
1352
1353 /etc/pki/tls/certs/ca-bundle.crt
1354
1355 =item *
1356
1357 /etc/ssl/ca-bundle.pem
1358
1359 =back
1360
1361 An exception will be raised if C<verify_SSL> is true and no CA certificate file
1362 is available.
1363
1364 If you desire complete control over SSL connections, the C<SSL_options> attribute
1365 lets you provide a hash reference that will be passed through to
1366 C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
1367 example, to provide your own trusted CA file:
1368
1369     SSL_options => {
1370         SSL_ca_file => $file_path,
1371     }
1372
1373 The C<SSL_options> attribute could also be used for such things as providing a
1374 client certificate for authentication to a server or controlling the choice of
1375 cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
1376 details.
1377
1378 =head1 LIMITATIONS
1379
1380 HTTP::Tiny is I<conditionally compliant> with the
1381 L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>.
1382 It attempts to meet all "MUST" requirements of the specification, but does not
1383 implement all "SHOULD" requirements.
1384
1385 Some particular limitations of note include:
1386
1387 =over
1388
1389 =item *
1390
1391 HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
1392 that user-defined headers and content are compliant with the HTTP/1.1
1393 specification.
1394
1395 =item *
1396
1397 Users must ensure that URLs are properly escaped for unsafe characters and that
1398 international domain names are properly encoded to ASCII. See L<URI::Escape>,
1399 L<URI::_punycode> and L<Net::IDN::Encode>.
1400
1401 =item *
1402
1403 Redirection is very strict against the specification.  Redirection is only
1404 automatic for response codes 301, 302 and 307 if the request method is 'GET' or
1405 'HEAD'.  Response code 303 is always converted into a 'GET' redirection, as
1406 mandated by the specification.  There is no automatic support for status 305
1407 ("Use proxy") redirections.
1408
1409 =item *
1410
1411 Persistent connections are not supported.  The C<Connection> header will
1412 always be set to C<close>.
1413
1414 =item *
1415
1416 Cookie support requires L<HTTP::CookieJar> or an equivalent class.
1417
1418 =item *
1419
1420 Only the C<http_proxy> environment variable is supported in the format
1421 C<http://HOST:PORT/>.  If a C<proxy> argument is passed to C<new> (including
1422 undef), then the C<http_proxy> environment variable is ignored.
1423
1424 =item *
1425
1426 C<no_proxy> environment variable is supported in the format comma-separated
1427 list of domain extensions proxy should not be used for.  If a C<no_proxy>
1428 argument is passed to C<new>, then the C<no_proxy> environment variable is
1429 ignored.
1430
1431 =item *
1432
1433 There is no provision for delaying a request body using an C<Expect> header.
1434 Unexpected C<1XX> responses are silently ignored as per the specification.
1435
1436 =item *
1437
1438 Only 'chunked' C<Transfer-Encoding> is supported.
1439
1440 =item *
1441
1442 There is no support for a Request-URI of '*' for the 'OPTIONS' request.
1443
1444 =item *
1445
1446 There is no support for IPv6 of any kind.
1447
1448 =back
1449
1450 =head1 SEE ALSO
1451
1452 =over 4
1453
1454 =item *
1455
1456 L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
1457
1458 =item *
1459
1460 L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface
1461
1462 =item *
1463
1464 L<IO::Socket::SSL> - Required for SSL support
1465
1466 =item *
1467
1468 L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things
1469
1470 =item *
1471
1472 L<Mozilla::CA> - Required if you want to validate SSL certificates
1473
1474 =item *
1475
1476 L<Net::SSLeay> - Required for SSL support
1477
1478 =back
1479
1480 =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
1481
1482 =head1 SUPPORT
1483
1484 =head2 Bugs / Feature Requests
1485
1486 Please report any bugs or feature requests through the issue tracker
1487 at L<https://github.com/chansen/p5-http-tiny/issues>.
1488 You will be notified automatically of any progress on your issue.
1489
1490 =head2 Source Code
1491
1492 This is open source software.  The code repository is available for
1493 public review and contribution under the terms of the license.
1494
1495 L<https://github.com/chansen/p5-http-tiny>
1496
1497   git clone git://github.com/chansen/p5-http-tiny.git
1498
1499 =head1 AUTHORS
1500
1501 =over 4
1502
1503 =item *
1504
1505 Christian Hansen <chansen@cpan.org>
1506
1507 =item *
1508
1509 David Golden <dagolden@cpan.org>
1510
1511 =back
1512
1513 =head1 CONTRIBUTORS
1514
1515 =over 4
1516
1517 =item *
1518
1519 Alan Gardner <gardner@pythian.com>
1520
1521 =item *
1522
1523 Alessandro Ghedini <al3xbio@gmail.com>
1524
1525 =item *
1526
1527 Brad Gilbert <bgills@cpan.org>
1528
1529 =item *
1530
1531 Chris Nehren <apeiron@cpan.org>
1532
1533 =item *
1534
1535 Chris Weyl <cweyl@alumni.drew.edu>
1536
1537 =item *
1538
1539 Claes Jakobsson <claes@surfar.nu>
1540
1541 =item *
1542
1543 Craig Berry <cberry@cpan.org>
1544
1545 =item *
1546
1547 David Mitchell <davem@iabyn.com>
1548
1549 =item *
1550
1551 Edward Zborowski <ed@rubensteintech.com>
1552
1553 =item *
1554
1555 Jess Robinson <castaway@desert-island.me.uk>
1556
1557 =item *
1558
1559 Lukas Eklund <leklund@gmail.com>
1560
1561 =item *
1562
1563 Martin-Louis Bright <mlbright@gmail.com>
1564
1565 =item *
1566
1567 Mike Doherty <doherty@cpan.org>
1568
1569 =item *
1570
1571 Serguei Trouchelle <stro@cpan.org>
1572
1573 =item *
1574
1575 Syohei YOSHIDA <syohex@gmail.com>
1576
1577 =item *
1578
1579 Tony Cook <tony@develop-help.com>
1580
1581 =back
1582
1583 =head1 COPYRIGHT AND LICENSE
1584
1585 This software is copyright (c) 2013 by Christian Hansen.
1586
1587 This is free software; you can redistribute it and/or modify it under
1588 the same terms as the Perl 5 programming language system itself.
1589
1590 =cut