cpan/HTTP-Tiny/lib/HTTP/Tiny.pm

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