This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
30ef26ce63eabea8788dc443d74d2c92cc13a584
[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.034'; # 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, $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.034
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>.  See documentation for the
1146 C<www_form_urlencode> method for details on the encoding.
1147
1148 The URL must have unsafe characters escaped and international domain names
1149 encoded.  See C<request()> for valid options and a description of the response.
1150 Any C<content-type> header or content in the options hashref will be ignored.
1151
1152 The C<success> field of the response will be true if the status code is 2XX.
1153
1154 =head2 mirror
1155
1156     $response = $http->mirror($url, $file, \%options)
1157     if ( $response->{success} ) {
1158         print "$file is up to date\n";
1159     }
1160
1161 Executes a C<GET> request for the URL and saves the response body to the file
1162 name provided.  The URL must have unsafe characters escaped and international
1163 domain names encoded.  If the file already exists, the request will include an
1164 C<If-Modified-Since> header with the modification timestamp of the file.  You
1165 may specify a different C<If-Modified-Since> header yourself in the C<<
1166 $options->{headers} >> hash.
1167
1168 The C<success> field of the response will be true if the status code is 2XX
1169 or if the status code is 304 (unmodified).
1170
1171 If the file was modified and the server response includes a properly
1172 formatted C<Last-Modified> header, the file modification time will
1173 be updated accordingly.
1174
1175 =head2 request
1176
1177     $response = $http->request($method, $url);
1178     $response = $http->request($method, $url, \%options);
1179
1180 Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
1181 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
1182 international domain names encoded.
1183
1184 If the URL includes a "user:password" stanza, they will be used for Basic-style
1185 authorization headers.  (Authorization headers will not be included in a
1186 redirected request.) For example:
1187
1188     $http->request('GET', 'http://Aladdin:open sesame@example.com/');
1189
1190 A hashref of options may be appended to modify the request.
1191
1192 Valid options are:
1193
1194 =over 4
1195
1196 =item *
1197
1198 C<headers>
1199
1200 A hashref containing headers to include with the request.  If the value for
1201 a header is an array reference, the header will be output multiple times with
1202 each value in the array.  These headers over-write any default headers.
1203
1204 =item *
1205
1206 C<content>
1207
1208 A scalar to include as the body of the request OR a code reference
1209 that will be called iteratively to produce the body of the request
1210
1211 =item *
1212
1213 C<trailer_callback>
1214
1215 A code reference that will be called if it exists to provide a hashref
1216 of trailing headers (only used with chunked transfer-encoding)
1217
1218 =item *
1219
1220 C<data_callback>
1221
1222 A code reference that will be called for each chunks of the response
1223 body received.
1224
1225 =back
1226
1227 If the C<content> option is a code reference, it will be called iteratively
1228 to provide the content body of the request.  It should return the empty
1229 string or undef when the iterator is exhausted.
1230
1231 If the C<content> option is the empty string, no C<content-type> or
1232 C<content-length> headers will be generated.
1233
1234 If the C<data_callback> option is provided, it will be called iteratively until
1235 the entire response body is received.  The first argument will be a string
1236 containing a chunk of the response body, the second argument will be the
1237 in-progress response hash reference, as described below.  (This allows
1238 customizing the action of the callback based on the C<status> or C<headers>
1239 received prior to the content body.)
1240
1241 The C<request> method returns a hashref containing the response.  The hashref
1242 will have the following keys:
1243
1244 =over 4
1245
1246 =item *
1247
1248 C<success>
1249
1250 Boolean indicating whether the operation returned a 2XX status code
1251
1252 =item *
1253
1254 C<url>
1255
1256 URL that provided the response. This is the URL of the request unless
1257 there were redirections, in which case it is the last URL queried
1258 in a redirection chain
1259
1260 =item *
1261
1262 C<status>
1263
1264 The HTTP status code of the response
1265
1266 =item *
1267
1268 C<reason>
1269
1270 The response phrase returned by the server
1271
1272 =item *
1273
1274 C<content>
1275
1276 The body of the response.  If the response does not have any content
1277 or if a data callback is provided to consume the response body,
1278 this will be the empty string
1279
1280 =item *
1281
1282 C<headers>
1283
1284 A hashref of header fields.  All header field names will be normalized
1285 to be lower case. If a header is repeated, the value will be an arrayref;
1286 it will otherwise be a scalar string containing the value
1287
1288 =back
1289
1290 On an exception during the execution of the request, the C<status> field will
1291 contain 599, and the C<content> field will contain the text of the exception.
1292
1293 =head2 www_form_urlencode
1294
1295     $params = $http->www_form_urlencode( $data );
1296     $response = $http->get("http://example.com/query?$params");
1297
1298 This method converts the key/value pairs from a data hash or array reference
1299 into a C<x-www-form-urlencoded> string.  The keys and values from the data
1300 reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
1301 array reference, the key will be repeated with each of the values of the array
1302 reference.  The key/value pairs in the resulting string will be sorted by key
1303 and value.
1304
1305 =for Pod::Coverage agent
1306 cookie_jar
1307 default_headers
1308 local_address
1309 max_redirect
1310 max_size
1311 proxy
1312 no_proxy
1313 timeout
1314 verify_SSL
1315 SSL_options
1316
1317 =head1 SSL SUPPORT
1318
1319 Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
1320 greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
1321 thrown if a new enough versions of these modules not installed or if the SSL
1322 encryption fails. There is no support for C<https> connections via proxy (i.e.
1323 RFC 2817).
1324
1325 SSL provides two distinct capabilities:
1326
1327 =over 4
1328
1329 =item *
1330
1331 Encrypted communication channel
1332
1333 =item *
1334
1335 Verification of server identity
1336
1337 =back
1338
1339 B<By default, HTTP::Tiny does not verify server identity>.
1340
1341 Server identity verification is controversial and potentially tricky because it
1342 depends on a (usually paid) third-party Certificate Authority (CA) trust model
1343 to validate a certificate as legitimate.  This discriminates against servers
1344 with self-signed certificates or certificates signed by free, community-driven
1345 CA's such as L<CAcert.org|http://cacert.org>.
1346
1347 By default, HTTP::Tiny does not make any assumptions about your trust model,
1348 threat level or risk tolerance.  It just aims to give you an encrypted channel
1349 when you need one.
1350
1351 Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
1352 that an SSL connection has a valid SSL certificate corresponding to the host
1353 name of the connection and that the SSL certificate has been verified by a CA.
1354 Assuming you trust the CA, this will protect against a L<man-in-the-middle
1355 attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
1356 concerned about security, you should enable this option.
1357
1358 Certificate verification requires a file containing trusted CA certificates.
1359 If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
1360 included with it as a source of trusted CA's.  (This means you trust Mozilla,
1361 the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
1362 toolchain used to install it, and your operating system security, right?)
1363
1364 If that module is not available, then HTTP::Tiny will search several
1365 system-specific default locations for a CA certificate file:
1366
1367 =over 4
1368
1369 =item *
1370
1371 /etc/ssl/certs/ca-certificates.crt
1372
1373 =item *
1374
1375 /etc/pki/tls/certs/ca-bundle.crt
1376
1377 =item *
1378
1379 /etc/ssl/ca-bundle.pem
1380
1381 =back
1382
1383 An exception will be raised if C<verify_SSL> is true and no CA certificate file
1384 is available.
1385
1386 If you desire complete control over SSL connections, the C<SSL_options> attribute
1387 lets you provide a hash reference that will be passed through to
1388 C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
1389 example, to provide your own trusted CA file:
1390
1391     SSL_options => {
1392         SSL_ca_file => $file_path,
1393     }
1394
1395 The C<SSL_options> attribute could also be used for such things as providing a
1396 client certificate for authentication to a server or controlling the choice of
1397 cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
1398 details.
1399
1400 =head1 LIMITATIONS
1401
1402 HTTP::Tiny is I<conditionally compliant> with the
1403 L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>.
1404 It attempts to meet all "MUST" requirements of the specification, but does not
1405 implement all "SHOULD" requirements.
1406
1407 Some particular limitations of note include:
1408
1409 =over
1410
1411 =item *
1412
1413 HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
1414 that user-defined headers and content are compliant with the HTTP/1.1
1415 specification.
1416
1417 =item *
1418
1419 Users must ensure that URLs are properly escaped for unsafe characters and that
1420 international domain names are properly encoded to ASCII. See L<URI::Escape>,
1421 L<URI::_punycode> and L<Net::IDN::Encode>.
1422
1423 =item *
1424
1425 Redirection is very strict against the specification.  Redirection is only
1426 automatic for response codes 301, 302 and 307 if the request method is 'GET' or
1427 'HEAD'.  Response code 303 is always converted into a 'GET' redirection, as
1428 mandated by the specification.  There is no automatic support for status 305
1429 ("Use proxy") redirections.
1430
1431 =item *
1432
1433 Persistent connections are not supported.  The C<Connection> header will
1434 always be set to C<close>.
1435
1436 =item *
1437
1438 Cookie support requires L<HTTP::CookieJar> or an equivalent class.
1439
1440 =item *
1441
1442 Only the C<http_proxy> environment variable is supported in the format
1443 C<http://HOST:PORT/>.  If a C<proxy> argument is passed to C<new> (including
1444 undef), then the C<http_proxy> environment variable is ignored.
1445
1446 =item *
1447
1448 C<no_proxy> environment variable is supported in the format comma-separated
1449 list of domain extensions proxy should not be used for.  If a C<no_proxy>
1450 argument is passed to C<new>, then the C<no_proxy> environment variable is
1451 ignored.
1452
1453 =item *
1454
1455 There is no provision for delaying a request body using an C<Expect> header.
1456 Unexpected C<1XX> responses are silently ignored as per the specification.
1457
1458 =item *
1459
1460 Only 'chunked' C<Transfer-Encoding> is supported.
1461
1462 =item *
1463
1464 There is no support for a Request-URI of '*' for the 'OPTIONS' request.
1465
1466 =item *
1467
1468 There is no support for IPv6 of any kind.
1469
1470 =back
1471
1472 =head1 SEE ALSO
1473
1474 =over 4
1475
1476 =item *
1477
1478 L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
1479
1480 =item *
1481
1482 L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface
1483
1484 =item *
1485
1486 L<IO::Socket::SSL> - Required for SSL support
1487
1488 =item *
1489
1490 L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things
1491
1492 =item *
1493
1494 L<Mozilla::CA> - Required if you want to validate SSL certificates
1495
1496 =item *
1497
1498 L<Net::SSLeay> - Required for SSL support
1499
1500 =back
1501
1502 =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
1503
1504 =head1 SUPPORT
1505
1506 =head2 Bugs / Feature Requests
1507
1508 Please report any bugs or feature requests through the issue tracker
1509 at L<https://github.com/chansen/p5-http-tiny/issues>.
1510 You will be notified automatically of any progress on your issue.
1511
1512 =head2 Source Code
1513
1514 This is open source software.  The code repository is available for
1515 public review and contribution under the terms of the license.
1516
1517 L<https://github.com/chansen/p5-http-tiny>
1518
1519   git clone git://github.com/chansen/p5-http-tiny.git
1520
1521 =head1 AUTHORS
1522
1523 =over 4
1524
1525 =item *
1526
1527 Christian Hansen <chansen@cpan.org>
1528
1529 =item *
1530
1531 David Golden <dagolden@cpan.org>
1532
1533 =back
1534
1535 =head1 CONTRIBUTORS
1536
1537 =over 4
1538
1539 =item *
1540
1541 Alan Gardner <gardner@pythian.com>
1542
1543 =item *
1544
1545 Alessandro Ghedini <al3xbio@gmail.com>
1546
1547 =item *
1548
1549 Brad Gilbert <bgills@cpan.org>
1550
1551 =item *
1552
1553 Chris Nehren <apeiron@cpan.org>
1554
1555 =item *
1556
1557 Chris Weyl <cweyl@alumni.drew.edu>
1558
1559 =item *
1560
1561 Claes Jakobsson <claes@surfar.nu>
1562
1563 =item *
1564
1565 Craig Berry <cberry@cpan.org>
1566
1567 =item *
1568
1569 David Mitchell <davem@iabyn.com>
1570
1571 =item *
1572
1573 Edward Zborowski <ed@rubensteintech.com>
1574
1575 =item *
1576
1577 Jess Robinson <castaway@desert-island.me.uk>
1578
1579 =item *
1580
1581 Lukas Eklund <leklund@gmail.com>
1582
1583 =item *
1584
1585 Martin-Louis Bright <mlbright@gmail.com>
1586
1587 =item *
1588
1589 Mike Doherty <doherty@cpan.org>
1590
1591 =item *
1592
1593 Serguei Trouchelle <stro@cpan.org>
1594
1595 =item *
1596
1597 Syohei YOSHIDA <syohex@gmail.com>
1598
1599 =item *
1600
1601 Tony Cook <tony@develop-help.com>
1602
1603 =back
1604
1605 =head1 COPYRIGHT AND LICENSE
1606
1607 This software is copyright (c) 2013 by Christian Hansen.
1608
1609 This is free software; you can redistribute it and/or modify it under
1610 the same terms as the Perl 5 programming language system itself.
1611
1612 =cut