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