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
CommitLineData
a3ab329f 1# vim: ts=4 sts=4 sw=4 et:
a3ab329f 2package HTTP::Tiny;
a3ab329f
DG
3use strict;
4use warnings;
35265876 5# ABSTRACT: A small, simple, correct HTTP/1.1 client
1d28c016 6our $VERSION = '0.036'; # VERSION
a3ab329f
DG
7
8use Carp ();
9
10
11my @attributes;
12BEGIN {
9a00675d 13 @attributes = qw(cookie_jar default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);
a3ab329f
DG
14 no strict 'refs';
15 for my $accessor ( @attributes ) {
16 *{$accessor} = sub {
17 @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
18 };
19 }
20}
21
9a00675d
CBW
22sub 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
a3ab329f
DG
31sub new {
32 my($class, %args) = @_;
d72a6fbd 33
a3ab329f 34 my $self = {
a3ab329f
DG
35 max_redirect => 5,
36 timeout => 60,
fcfb9f49 37 verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
9a00675d 38 no_proxy => $ENV{no_proxy},
a3ab329f 39 };
d72a6fbd 40
9a00675d 41 bless $self, $class;
d72a6fbd 42
107bec06
CBW
43 $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
44
a3ab329f
DG
45 for my $key ( @attributes ) {
46 $self->{$key} = $args{$key} if exists $args{$key}
47 }
77ccfaeb 48
9a00675d
CBW
49 $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
50
77ccfaeb
DG
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
9a00675d
CBW
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;
a3ab329f
DG
68}
69
70
35265876
CBW
71for my $sub_name ( qw/get head put post delete/ ) {
72 my $req_method = uc $sub_name;
73 no strict 'refs';
4984624c 74 eval <<"HERE"; ## no critic
35265876
CBW
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 }
81HERE
82}
83
84
85sub 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 );
a3ab329f
DG
105}
106
107
108sub mirror {
109 my ($self, $url, $file, $args) = @_;
110 @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
77ccfaeb 111 or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
a3ab329f
DG
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
77ccfaeb 117 or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!\n/);
b06ddfb0 118 binmode $fh;
a3ab329f
DG
119 $args->{data_callback} = sub { print {$fh} $_[0] };
120 my $response = $self->request('GET', $url, $args);
121 close $fh
77ccfaeb 122 or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!\n/);
a3ab329f
DG
123 if ( $response->{success} ) {
124 rename $tempfile, $file
77ccfaeb 125 or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
a3ab329f
DG
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
137my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
138
139sub request {
140 my ($self, $method, $url, $args) = @_;
141 @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
77ccfaeb 142 or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
a3ab329f
DG
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 = {
fcfb9f49 155 url => $url,
a3ab329f
DG
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
35265876
CBW
169
170sub 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')
107bec06 175 or Carp::croak("form data must be a hash or array reference\n");
35265876
CBW
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
4403b774 192 return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
35265876
CBW
193}
194
195#--------------------------------------------------------------------------#
196# private methods
197#--------------------------------------------------------------------------#
198
a3ab329f
DG
199my %DefaultPort = (
200 http => 80,
201 https => 443,
202);
203
9a00675d
CBW
204sub _agent {
205 my $class = ref($_[0]) || $_[0];
206 (my $default_agent = $class) =~ s{::}{-}g;
207 return $default_agent . "/" . ($class->VERSION || 0);
208}
209
a3ab329f
DG
210sub _request {
211 my ($self, $method, $url, $args) = @_;
212
49d2f596 213 my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
a3ab329f
DG
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
fcfb9f49 223 my $handle = HTTP::Tiny::Handle->new(
44347bc3
JL
224 timeout => $self->{timeout},
225 SSL_options => $self->{SSL_options},
226 verify_SSL => $self->{verify_SSL},
227 local_address => $self->{local_address},
fcfb9f49 228 );
a3ab329f 229
9a00675d 230 if ($self->{proxy} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
a3ab329f 231 $request->{uri} = "$scheme://$request->{host_port}$path_query";
77ccfaeb 232 die(qq/HTTPS via proxy is not supported\n/)
a3ab329f
DG
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
49d2f596 240 $self->_prepare_headers_and_cb($request, $args, $url, $auth);
a3ab329f
DG
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
107bec06
CBW
247 $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
248
a3ab329f
DG
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';
fcfb9f49 264 $response->{url} = $url;
a3ab329f
DG
265 return $response;
266}
267
268sub _prepare_headers_and_cb {
49d2f596 269 my ($self, $request, $args, $url, $auth) = @_;
a3ab329f
DG
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
1bc74233 281 if ( defined $args->{content} ) {
a3ab329f 282 if (ref $args->{content} eq 'CODE') {
1bc74233 283 $request->{headers}{'content-type'} ||= "application/octet-stream";
a3ab329f
DG
284 $request->{headers}{'transfer-encoding'} = 'chunked'
285 unless $request->{headers}{'content-length'}
286 || $request->{headers}{'transfer-encoding'};
287 $request->{cb} = $args->{content};
288 }
1bc74233 289 elsif ( length $args->{content} ) {
a3ab329f
DG
290 my $content = $args->{content};
291 if ( $] ge '5.008' ) {
292 utf8::downgrade($content, 1)
77ccfaeb 293 or die(qq/Wide character in request message body\n/);
a3ab329f 294 }
1bc74233 295 $request->{headers}{'content-type'} ||= "application/octet-stream";
a3ab329f
DG
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 }
107bec06
CBW
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
49d2f596
CBW
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
a3ab329f
DG
318 return;
319}
320
321sub _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
107bec06
CBW
341sub _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
354sub _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
a3ab329f
DG
366sub _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
382sub _split_url {
383 my $url = pop;
384
385 # URI regex adapted from the URI module
386 my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
77ccfaeb 387 or die(qq/Cannot parse URL: '$url'\n/);
a3ab329f
DG
388
389 $scheme = lc $scheme;
390 $path_query = "/$path_query" unless $path_query =~ m<\A/>;
391
49d2f596
CBW
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;
a3ab329f
DG
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
49d2f596 408 return ($scheme, $host, $port, $path_query, $auth);
a3ab329f
DG
409}
410
411# Date conversions adapted from HTTP::Date
412my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
413my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
414sub _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
423sub _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
35265876
CBW
442# URI escaping adapted from URI::Escape
443# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
6ce52845 444# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
35265876
CBW
445my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
446$escapes{' '}="+";
447my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
448
449sub _uri_escape {
450 my ($self, $str) = @_;
6ce52845
CBW
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 }
35265876
CBW
459 $str =~ s/($unsafe_char)/$escapes{$1}/ge;
460 return $str;
461}
462
a3ab329f
DG
463package
464 HTTP::Tiny::Handle; # hide from PAUSE/indexers
465use strict;
466use warnings;
467
a3ab329f
DG
468use Errno qw[EINTR EPIPE];
469use IO::Socket qw[SOCK_STREAM];
470
4984624c 471sub BUFSIZE () { 32768 } ## no critic
a3ab329f
DG
472
473my $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
482my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
483
484sub new {
485 my ($class, %args) = @_;
486 return bless {
487 rbuf => '',
488 timeout => 60,
489 max_line_size => 16384,
490 max_header_lines => 64,
fcfb9f49
CBW
491 verify_SSL => 0,
492 SSL_options => {},
a3ab329f
DG
493 %args
494 }, $class;
495}
496
497sub connect {
77ccfaeb 498 @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
a3ab329f
DG
499 my ($self, $scheme, $host, $port) = @_;
500
501 if ( $scheme eq 'https' ) {
107bec06
CBW
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
4e375cef
CBW
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)};
a3ab329f
DG
508 }
509 elsif ( $scheme ne 'http' ) {
77ccfaeb 510 die(qq/Unsupported URL scheme '$scheme'\n/);
a3ab329f 511 }
a3ab329f
DG
512 $self->{fh} = 'IO::Socket::INET'->new(
513 PeerHost => $host,
514 PeerPort => $port,
4e375cef 515 $self->{local_address} ?
44347bc3 516 ( LocalAddr => $self->{local_address} ) : (),
a3ab329f
DG
517 Proto => 'tcp',
518 Type => SOCK_STREAM,
519 Timeout => $self->{timeout}
77ccfaeb 520 ) or die(qq/Could not connect to '$host:$port': $@\n/);
a3ab329f
DG
521
522 binmode($self->{fh})
77ccfaeb 523 or die(qq/Could not binmode() socket: '$!'\n/);
a3ab329f
DG
524
525 if ( $scheme eq 'https') {
fcfb9f49 526 my $ssl_args = $self->_ssl_args($host);
4e375cef
CBW
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
fcfb9f49
CBW
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 }
a3ab329f
DG
540 }
541
542 $self->{host} = $host;
543 $self->{port} = $port;
544
545 return $self;
546}
547
548sub close {
77ccfaeb 549 @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
a3ab329f
DG
550 my ($self) = @_;
551 CORE::close($self->{fh})
77ccfaeb 552 or die(qq/Could not close socket: '$!'\n/);
a3ab329f
DG
553}
554
555sub write {
77ccfaeb 556 @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
a3ab329f
DG
557 my ($self, $buf) = @_;
558
559 if ( $] ge '5.008' ) {
560 utf8::downgrade($buf, 1)
77ccfaeb 561 or die(qq/Wide character in write()\n/);
a3ab329f
DG
562 }
563
564 my $len = length $buf;
565 my $off = 0;
566
567 local $SIG{PIPE} = 'IGNORE';
568
569 while () {
570 $self->can_write
77ccfaeb 571 or die(qq/Timed out while waiting for socket to become ready for writing\n/);
a3ab329f
DG
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) {
77ccfaeb 579 die(qq/Socket closed by remote server: $!\n/);
a3ab329f
DG
580 }
581 elsif ($! != EINTR) {
4e375cef
CBW
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
a3ab329f
DG
590 }
591 }
592 return $off;
593}
594
595sub read {
77ccfaeb 596 @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
a3ab329f
DG
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
77ccfaeb 610 or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
a3ab329f
DG
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) {
4e375cef
CBW
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 }
a3ab329f
DG
624 }
625 }
626 if ($len && !$allow_partial) {
77ccfaeb 627 die(qq/Unexpected end of stream\n/);
a3ab329f
DG
628 }
629 return $buf;
630}
631
632sub readline {
77ccfaeb 633 @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
a3ab329f
DG
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}) {
77ccfaeb 641 die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
a3ab329f
DG
642 }
643 $self->can_read
77ccfaeb 644 or die(qq/Timed out while waiting for socket to become ready for reading\n/);
a3ab329f
DG
645 my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
646 if (defined $r) {
647 last unless $r;
648 }
649 elsif ($! != EINTR) {
4e375cef
CBW
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 }
a3ab329f
DG
657 }
658 }
77ccfaeb 659 die(qq/Unexpected end of stream while looking for line\n/);
a3ab329f
DG
660}
661
662sub read_header_lines {
77ccfaeb 663 @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
a3ab329f
DG
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}) {
77ccfaeb 673 die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
a3ab329f
DG
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
77ccfaeb 690 or die(qq/Unexpected header continuation line\n/);
a3ab329f
DG
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 {
77ccfaeb 699 die(q/Malformed header line: / . $Printable->($line) . "\n");
a3ab329f
DG
700 }
701 }
702 return $headers;
703}
704
705sub write_request {
77ccfaeb 706 @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
a3ab329f
DG
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
713my %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
721sub write_header_lines {
77ccfaeb 722 (@_ == 2 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
a3ab329f
DG
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
77ccfaeb 733 or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
a3ab329f
DG
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]/
77ccfaeb 739 or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n");
a3ab329f
DG
740 $buf .= "$field_name: $_\x0D\x0A";
741 }
742 }
743 $buf .= "\x0D\x0A";
744 return $self->write($buf);
745}
746
747sub read_body {
77ccfaeb 748 @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
a3ab329f
DG
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
760sub write_body {
77ccfaeb 761 @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
a3ab329f
DG
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
771sub read_content_body {
77ccfaeb 772 @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
a3ab329f
DG
773 my ($self, $cb, $response, $content_length) = @_;
774 $content_length ||= $response->{headers}{'content-length'};
775
3ea9257d 776 if ( defined $content_length ) {
a3ab329f
DG
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
792sub write_content_body {
77ccfaeb 793 @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
a3ab329f
DG
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)
77ccfaeb 805 or die(qq/Wide character in write_content()\n/);
a3ab329f
DG
806 }
807
808 $len += $self->write($data);
809 }
810
811 $len == $content_length
77ccfaeb 812 or die(qq/Content-Length missmatch (got: $len expected: $content_length)\n/);
a3ab329f
DG
813
814 return $len;
815}
816
817sub read_chunked_body {
77ccfaeb 818 @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
a3ab329f
DG
819 my ($self, $cb, $response) = @_;
820
821 while () {
822 my $head = $self->readline;
823
824 $head =~ /\A ([A-Fa-f0-9]+)/x
77ccfaeb 825 or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
a3ab329f
DG
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"
77ccfaeb 833 or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
a3ab329f
DG
834 }
835 $self->read_header_lines($response->{headers});
836 return;
837}
838
839sub write_chunked_body {
77ccfaeb 840 @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
a3ab329f
DG
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)
77ccfaeb 852 or die(qq/Wide character in write_chunked_body()\n/);
a3ab329f
DG
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
870sub read_response_header {
77ccfaeb 871 @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
a3ab329f
DG
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
77ccfaeb 877 or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
a3ab329f
DG
878
879 my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
880
77ccfaeb 881 die (qq/Unsupported HTTP protocol: $protocol\n/)
a3ab329f
DG
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
892sub write_request_header {
77ccfaeb 893 @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
a3ab329f
DG
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
900sub _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
77ccfaeb 907 or die(qq/select(2): 'Bad file descriptor'\n/);
a3ab329f
DG
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
77ccfaeb 921 or die(qq/select(2): '$!'\n/);
a3ab329f
DG
922 redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
923 $nfound = 0;
924 }
925 last;
926 }
927 $! = 0;
928 return $nfound;
929}
930
931sub can_read {
77ccfaeb 932 @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
a3ab329f
DG
933 my $self = shift;
934 return $self->_do_timeout('read', @_)
935}
936
937sub can_write {
77ccfaeb 938 @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
a3ab329f
DG
939 my $self = shift;
940 return $self->_do_timeout('write', @_)
941}
942
fcfb9f49
CBW
943# Try to find a CA bundle to validate the SSL cert,
944# prefer Mozilla::CA or fallback to a system file
945sub _find_CA_file {
4e375cef
CBW
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
fcfb9f49
CBW
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
967sub _ssl_args {
968 my ($self, $host) = @_;
969
107bec06
CBW
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 }
fcfb9f49
CBW
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
a3ab329f
DG
9971;
998
a3ab329f 999__END__
4e375cef 1000
a3ab329f
DG
1001=pod
1002
107bec06
CBW
1003=encoding utf-8
1004
a3ab329f
DG
1005=head1 NAME
1006
1007HTTP::Tiny - A small, simple, correct HTTP/1.1 client
1008
1009=head1 VERSION
1010
1d28c016 1011version 0.036
a3ab329f
DG
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
35265876 1033This is a very simple HTTP/1.1 client, designed for doing simple GET
a3ab329f
DG
1034requests without the overhead of a large framework like L<LWP::UserAgent>.
1035
1036It is more correct and more complete than L<HTTP::Lite>. It supports
1037proxies (currently only non-authenticating ones) and redirection. It
1038also correctly resumes after EINTR.
1039
1040=head1 METHODS
1041
1042=head2 new
1043
1044 $http = HTTP::Tiny->new( %attributes );
1045
1046This constructor returns a new HTTP::Tiny object. Valid attributes include:
1047
1048=over 4
1049
1050=item *
1051
4984624c 1052C<agent>
a3ab329f 1053
d72a6fbd 1054A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
a3ab329f
DG
1055
1056=item *
1057
107bec06
CBW
1058C<cookie_jar>
1059
1060An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods
1061
1062=item *
1063
4984624c 1064C<default_headers>
a3ab329f
DG
1065
1066A hashref of default headers to apply to requests
1067
1068=item *
1069
44347bc3
JL
1070C<local_address>
1071
1072The local IP address to bind to
1073
1074=item *
1075
4984624c 1076C<max_redirect>
a3ab329f
DG
1077
1078Maximum number of redirects allowed (defaults to 5)
1079
1080=item *
1081
4984624c 1082C<max_size>
a3ab329f
DG
1083
1084Maximum response size (only when not using a data callback). If defined,
4984624c 1085responses larger than this will return an exception.
a3ab329f
DG
1086
1087=item *
1088
4984624c 1089C<proxy>
a3ab329f 1090
77ccfaeb 1091URL of a proxy server to use (default is C<$ENV{http_proxy}> if set)
a3ab329f
DG
1092
1093=item *
1094
9a00675d
CBW
1095C<no_proxy>
1096
1097List 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
4984624c 1101C<timeout>
a3ab329f
DG
1102
1103Request timeout in seconds (default is 60)
1104
fcfb9f49
CBW
1105=item *
1106
1107C<verify_SSL>
1108
1109A boolean that indicates whether to validate the SSL certificate of an C<https>
1110connection (default is false)
1111
1112=item *
1113
1114C<SSL_options>
1115
1116A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
1117
a3ab329f
DG
1118=back
1119
4984624c
A
1120Exceptions from C<max_size>, C<timeout> or other errors will result in a
1121pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
1122content field in the response will contain the text of the exception.
1123
fcfb9f49
CBW
1124See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
1125
35265876 1126=head2 get|head|put|post|delete
a3ab329f
DG
1127
1128 $response = $http->get($url);
1129 $response = $http->get($url, \%options);
35265876
CBW
1130 $response = $http->head($url);
1131
1132These methods are shorthand for calling C<request()> for the given method. The
1133URL must have unsafe characters escaped and international domain names encoded.
1134See C<request()> for valid options and a description of the response.
1135
4984624c
A
1136The C<success> field of the response will be true if the status code is 2XX.
1137
35265876
CBW
1138=head2 post_form
1139
1140 $response = $http->post_form($url, $form_data);
1141 $response = $http->post_form($url, $form_data, \%options);
a3ab329f 1142
35265876
CBW
1143This method executes a C<POST> request and sends the key/value pairs from a
1144form data hash or array reference to the given URL with a C<content-type> of
4403b774
SH
1145C<application/x-www-form-urlencoded>. If data is provided as an array
1146reference, the order is preserved; if provided as a hash reference, the terms
1147are sorted on key and value for consistency. See documentation for the
35265876
CBW
1148C<www_form_urlencode> method for details on the encoding.
1149
1150The URL must have unsafe characters escaped and international domain names
1151encoded. See C<request()> for valid options and a description of the response.
1152Any C<content-type> header or content in the options hashref will be ignored.
a3ab329f 1153
4984624c
A
1154The C<success> field of the response will be true if the status code is 2XX.
1155
a3ab329f
DG
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
1163Executes a C<GET> request for the URL and saves the response body to the file
1164name provided. The URL must have unsafe characters escaped and international
1bc74233 1165domain names encoded. If the file already exists, the request will include an
a3ab329f 1166C<If-Modified-Since> header with the modification timestamp of the file. You
4984624c 1167may specify a different C<If-Modified-Since> header yourself in the C<<
a3ab329f
DG
1168$options->{headers} >> hash.
1169
1170The C<success> field of the response will be true if the status code is 2XX
4984624c 1171or if the status code is 304 (unmodified).
a3ab329f
DG
1172
1173If the file was modified and the server response includes a properly
1174formatted C<Last-Modified> header, the file modification time will
1175be updated accordingly.
1176
1177=head2 request
1178
1179 $response = $http->request($method, $url);
1180 $response = $http->request($method, $url, \%options);
1181
435aa301
DG
1182Executes 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
49d2f596
CBW
1184international domain names encoded.
1185
1186If the URL includes a "user:password" stanza, they will be used for Basic-style
1187authorization headers. (Authorization headers will not be included in a
1188redirected request.) For example:
1189
1190 $http->request('GET', 'http://Aladdin:open sesame@example.com/');
1191
1192A hashref of options may be appended to modify the request.
a3ab329f
DG
1193
1194Valid options are:
1195
1196=over 4
1197
1198=item *
1199
fcfb9f49 1200C<headers>
a3ab329f
DG
1201
1202A hashref containing headers to include with the request. If the value for
1203a header is an array reference, the header will be output multiple times with
1204each value in the array. These headers over-write any default headers.
1205
1206=item *
1207
fcfb9f49 1208C<content>
a3ab329f
DG
1209
1210A scalar to include as the body of the request OR a code reference
fcfb9f49 1211that will be called iteratively to produce the body of the request
a3ab329f
DG
1212
1213=item *
1214
fcfb9f49 1215C<trailer_callback>
a3ab329f
DG
1216
1217A code reference that will be called if it exists to provide a hashref
1218of trailing headers (only used with chunked transfer-encoding)
1219
1220=item *
1221
fcfb9f49 1222C<data_callback>
a3ab329f
DG
1223
1224A code reference that will be called for each chunks of the response
1225body received.
1226
1227=back
1228
1229If the C<content> option is a code reference, it will be called iteratively
1230to provide the content body of the request. It should return the empty
1231string or undef when the iterator is exhausted.
1232
1bc74233
CBW
1233If the C<content> option is the empty string, no C<content-type> or
1234C<content-length> headers will be generated.
1235
a3ab329f
DG
1236If the C<data_callback> option is provided, it will be called iteratively until
1237the entire response body is received. The first argument will be a string
1238containing a chunk of the response body, the second argument will be the
1239in-progress response hash reference, as described below. (This allows
1240customizing the action of the callback based on the C<status> or C<headers>
1241received prior to the content body.)
1242
1243The C<request> method returns a hashref containing the response. The hashref
1244will have the following keys:
1245
1246=over 4
1247
1248=item *
1249
fcfb9f49 1250C<success>
a3ab329f
DG
1251
1252Boolean indicating whether the operation returned a 2XX status code
1253
1254=item *
1255
fcfb9f49
CBW
1256C<url>
1257
1258URL that provided the response. This is the URL of the request unless
1259there were redirections, in which case it is the last URL queried
1260in a redirection chain
1261
1262=item *
1263
1264C<status>
a3ab329f
DG
1265
1266The HTTP status code of the response
1267
1268=item *
1269
fcfb9f49 1270C<reason>
a3ab329f
DG
1271
1272The response phrase returned by the server
1273
1274=item *
1275
fcfb9f49 1276C<content>
a3ab329f
DG
1277
1278The body of the response. If the response does not have any content
1279or if a data callback is provided to consume the response body,
1280this will be the empty string
1281
1282=item *
1283
fcfb9f49 1284C<headers>
a3ab329f
DG
1285
1286A hashref of header fields. All header field names will be normalized
1287to be lower case. If a header is repeated, the value will be an arrayref;
1288it will otherwise be a scalar string containing the value
1289
1290=back
1291
1292On an exception during the execution of the request, the C<status> field will
1293contain 599, and the C<content> field will contain the text of the exception.
1294
35265876
CBW
1295=head2 www_form_urlencode
1296
1297 $params = $http->www_form_urlencode( $data );
1298 $response = $http->get("http://example.com/query?$params");
1299
1300This method converts the key/value pairs from a data hash or array reference
1301into a C<x-www-form-urlencoded> string. The keys and values from the data
1302reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
1303array reference, the key will be repeated with each of the values of the array
4403b774
SH
1304reference. If data is provided as a hash reference, the key/value pairs in the
1305resulting string will be sorted by key and value for consistent ordering.
1306
1307To preserve the order (r
35265876 1308
a3ab329f 1309=for Pod::Coverage agent
107bec06 1310cookie_jar
a3ab329f 1311default_headers
44347bc3 1312local_address
a3ab329f
DG
1313max_redirect
1314max_size
1315proxy
9a00675d 1316no_proxy
a3ab329f 1317timeout
fcfb9f49
CBW
1318verify_SSL
1319SSL_options
1320
1321=head1 SSL SUPPORT
1322
1323Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
4e375cef
CBW
1324greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
1325thrown if a new enough versions of these modules not installed or if the SSL
1326encryption fails. There is no support for C<https> connections via proxy (i.e.
1327RFC 2817).
fcfb9f49
CBW
1328
1329SSL provides two distinct capabilities:
1330
1331=over 4
1332
1333=item *
1334
1335Encrypted communication channel
1336
1337=item *
1338
1339Verification of server identity
1340
1341=back
1342
1343B<By default, HTTP::Tiny does not verify server identity>.
1344
1345Server identity verification is controversial and potentially tricky because it
1346depends on a (usually paid) third-party Certificate Authority (CA) trust model
1347to validate a certificate as legitimate. This discriminates against servers
1348with self-signed certificates or certificates signed by free, community-driven
1349CA's such as L<CAcert.org|http://cacert.org>.
1350
1351By default, HTTP::Tiny does not make any assumptions about your trust model,
1352threat level or risk tolerance. It just aims to give you an encrypted channel
1353when you need one.
1354
1355Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
1356that an SSL connection has a valid SSL certificate corresponding to the host
1357name of the connection and that the SSL certificate has been verified by a CA.
1358Assuming you trust the CA, this will protect against a L<man-in-the-middle
1359attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>. If you are
1360concerned about security, you should enable this option.
1361
1362Certificate verification requires a file containing trusted CA certificates.
1363If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
1364included with it as a source of trusted CA's. (This means you trust Mozilla,
1365the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
1366toolchain used to install it, and your operating system security, right?)
1367
1368If that module is not available, then HTTP::Tiny will search several
1369system-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
1387An exception will be raised if C<verify_SSL> is true and no CA certificate file
1388is available.
1389
1390If you desire complete control over SSL connections, the C<SSL_options> attribute
1391lets you provide a hash reference that will be passed through to
1392C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
1393example, to provide your own trusted CA file:
1394
1395 SSL_options => {
1396 SSL_ca_file => $file_path,
1397 }
1398
1399The C<SSL_options> attribute could also be used for such things as providing a
1400client certificate for authentication to a server or controlling the choice of
1401cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
1402details.
a3ab329f
DG
1403
1404=head1 LIMITATIONS
1405
1406HTTP::Tiny is I<conditionally compliant> with the
1407L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>.
1408It attempts to meet all "MUST" requirements of the specification, but does not
1409implement all "SHOULD" requirements.
1410
1411Some particular limitations of note include:
1412
1413=over
1414
1415=item *
1416
1417HTTP::Tiny focuses on correct transport. Users are responsible for ensuring
1418that user-defined headers and content are compliant with the HTTP/1.1
1419specification.
1420
1421=item *
1422
1423Users must ensure that URLs are properly escaped for unsafe characters and that
1424international domain names are properly encoded to ASCII. See L<URI::Escape>,
1425L<URI::_punycode> and L<Net::IDN::Encode>.
1426
1427=item *
1428
1429Redirection is very strict against the specification. Redirection is only
1430automatic 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
1432mandated by the specification. There is no automatic support for status 305
1433("Use proxy") redirections.
1434
1435=item *
1436
293dcbbb 1437Persistent connections are not supported. The C<Connection> header will
a3ab329f
DG
1438always be set to C<close>.
1439
1440=item *
1441
107bec06 1442Cookie support requires L<HTTP::CookieJar> or an equivalent class.
a3ab329f
DG
1443
1444=item *
1445
77ccfaeb
DG
1446Only the C<http_proxy> environment variable is supported in the format
1447C<http://HOST:PORT/>. If a C<proxy> argument is passed to C<new> (including
1448undef), then the C<http_proxy> environment variable is ignored.
a3ab329f
DG
1449
1450=item *
1451
9a00675d
CBW
1452C<no_proxy> environment variable is supported in the format comma-separated
1453list of domain extensions proxy should not be used for. If a C<no_proxy>
1454argument is passed to C<new>, then the C<no_proxy> environment variable is
1455ignored.
1456
1457=item *
1458
a3ab329f
DG
1459There is no provision for delaying a request body using an C<Expect> header.
1460Unexpected C<1XX> responses are silently ignored as per the specification.
1461
1462=item *
1463
1464Only 'chunked' C<Transfer-Encoding> is supported.
1465
1466=item *
1467
1468There is no support for a Request-URI of '*' for the 'OPTIONS' request.
1469
44347bc3
JL
1470=item *
1471
1472There is no support for IPv6 of any kind.
1473
a3ab329f
DG
1474=back
1475
1476=head1 SEE ALSO
1477
1478=over 4
1479
1480=item *
1481
9a00675d
CBW
1482L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
1483
1484=item *
1485
1486L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface
a3ab329f 1487
fcfb9f49
CBW
1488=item *
1489
9a00675d 1490L<IO::Socket::SSL> - Required for SSL support
fcfb9f49
CBW
1491
1492=item *
1493
9a00675d 1494L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things
fcfb9f49 1495
4e375cef
CBW
1496=item *
1497
9a00675d
CBW
1498L<Mozilla::CA> - Required if you want to validate SSL certificates
1499
1500=item *
1501
1502L<Net::SSLeay> - Required for SSL support
4e375cef 1503
a3ab329f
DG
1504=back
1505
fcfb9f49 1506=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
44de791a
DG
1507
1508=head1 SUPPORT
1509
1510=head2 Bugs / Feature Requests
1511
4984624c 1512Please report any bugs or feature requests through the issue tracker
107bec06 1513at L<https://github.com/chansen/p5-http-tiny/issues>.
4984624c 1514You will be notified automatically of any progress on your issue.
44de791a
DG
1515
1516=head2 Source Code
1517
1518This is open source software. The code repository is available for
1519public review and contribution under the terms of the license.
1520
107bec06 1521L<https://github.com/chansen/p5-http-tiny>
44de791a 1522
1d28c016 1523 git clone https://github.com/chansen/p5-http-tiny.git
44de791a 1524
a3ab329f
DG
1525=head1 AUTHORS
1526
1527=over 4
1528
1529=item *
1530
1531Christian Hansen <chansen@cpan.org>
1532
1533=item *
1534
1535David Golden <dagolden@cpan.org>
1536
107bec06
CBW
1537=back
1538
1539=head1 CONTRIBUTORS
1540
1541=over 4
1542
1543=item *
1544
1545Alan Gardner <gardner@pythian.com>
1546
1547=item *
1548
1549Alessandro Ghedini <al3xbio@gmail.com>
1550
1551=item *
1552
9a00675d
CBW
1553Brad Gilbert <bgills@cpan.org>
1554
1555=item *
1556
107bec06
CBW
1557Chris Nehren <apeiron@cpan.org>
1558
1559=item *
1560
1561Chris Weyl <cweyl@alumni.drew.edu>
1562
1563=item *
1564
1565Claes Jakobsson <claes@surfar.nu>
1566
1567=item *
1568
1569Craig Berry <cberry@cpan.org>
1570
1571=item *
1572
1573David Mitchell <davem@iabyn.com>
1574
1575=item *
1576
1577Edward Zborowski <ed@rubensteintech.com>
1578
1579=item *
1580
1581Jess Robinson <castaway@desert-island.me.uk>
1582
1583=item *
1584
1585Lukas Eklund <leklund@gmail.com>
1586
fcfb9f49
CBW
1587=item *
1588
1bc74233
CBW
1589Martin-Louis Bright <mlbright@gmail.com>
1590
1591=item *
1592
fcfb9f49
CBW
1593Mike Doherty <doherty@cpan.org>
1594
107bec06
CBW
1595=item *
1596
1597Serguei Trouchelle <stro@cpan.org>
1598
1599=item *
1600
9a00675d
CBW
1601Syohei YOSHIDA <syohex@gmail.com>
1602
1603=item *
1604
107bec06
CBW
1605Tony Cook <tony@develop-help.com>
1606
a3ab329f
DG
1607=back
1608
1609=head1 COPYRIGHT AND LICENSE
1610
107bec06 1611This software is copyright (c) 2013 by Christian Hansen.
a3ab329f
DG
1612
1613This is free software; you can redistribute it and/or modify it under
1614the same terms as the Perl 5 programming language system itself.
1615
1616=cut