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