← Index
NYTProf Performance Profile   « line view »
For flows_to_es.pl
  Run on Mon May 9 23:27:59 2016
Reported on Mon May 9 23:28:09 2016

Filename/opt/flows/lib/lib/perl5/HTTP/Tiny.pm
StatementsExecuted 823 statements in 14.0ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
5112.63ms2.63msHTTP::Tiny::Handle::::CORE:sselectHTTP::Tiny::Handle::CORE:sselect (opcode)
211124µs4.36msHTTP::Tiny::::_request HTTP::Tiny::_request
821112µs2.86msHTTP::Tiny::Handle::::readlineHTTP::Tiny::Handle::readline
52191µs2.72msHTTP::Tiny::Handle::::_do_timeoutHTTP::Tiny::Handle::_do_timeout
21187µs285µsHTTP::Tiny::Handle::::write_header_linesHTTP::Tiny::Handle::write_header_lines
21184µs144µsHTTP::Tiny::Handle::::read_header_linesHTTP::Tiny::Handle::read_header_lines
21170µs169µsHTTP::Tiny::Handle::::writeHTTP::Tiny::Handle::write
21164µs3.04msHTTP::Tiny::Handle::::read_response_headerHTTP::Tiny::Handle::read_response_header
11156µs56µsHTTP::Tiny::::BEGIN@65 HTTP::Tiny::BEGIN@65
21148µs48µsHTTP::Tiny::Handle::::CORE:syswriteHTTP::Tiny::Handle::CORE:syswrite (opcode)
11147µs683µsHTTP::Tiny::Handle::::connectHTTP::Tiny::Handle::connect
21136µs51µsHTTP::Tiny::::_split_url HTTP::Tiny::_split_url
164135µs35µsHTTP::Tiny::Handle::::CORE:matchHTTP::Tiny::Handle::CORE:match (opcode)
32135µs2.72msHTTP::Tiny::Handle::::can_readHTTP::Tiny::Handle::can_read
21131µs31µsHTTP::Tiny::::_prepare_headers_and_cb HTTP::Tiny::_prepare_headers_and_cb
11130µs81µsHTTP::Tiny::::new HTTP::Tiny::new
122130µs30µsHTTP::Tiny::Handle::::CORE:substHTTP::Tiny::Handle::CORE:subst (opcode)
21129µs4.39msHTTP::Tiny::::request HTTP::Tiny::request
21127µs27µsHTTP::Tiny::Handle::::CORE:sysreadHTTP::Tiny::Handle::CORE:sysread (opcode)
21126µs27µsHTTP::Tiny::::_maybe_redirect HTTP::Tiny::_maybe_redirect
11126µs39µsHTTP::Tiny::Handle::::timeoutHTTP::Tiny::Handle::timeout
21120µs20µsHTTP::Tiny::Handle::::CORE:regcompHTTP::Tiny::Handle::CORE:regcomp (opcode)
11120µs54µsHTTP::Tiny::Handle::::can_reuseHTTP::Tiny::Handle::can_reuse
11118µs715µsHTTP::Tiny::::_open_handle HTTP::Tiny::_open_handle
21118µs318µsHTTP::Tiny::Handle::::write_requestHTTP::Tiny::Handle::write_request
22117µs21µsHTTP::Tiny::Handle::::_get_tidHTTP::Tiny::Handle::_get_tid
11117µs17µsHTTP::Tiny::::_set_proxies HTTP::Tiny::_set_proxies
11116µs24µsHTTP::Tiny::::_agent HTTP::Tiny::_agent
21116µs50µsHTTP::Tiny::Handle::::can_writeHTTP::Tiny::Handle::can_write
21115µs301µsHTTP::Tiny::Handle::::write_request_headerHTTP::Tiny::Handle::write_request_header
11115µs33µsHTTP::Tiny::::BEGIN@3 HTTP::Tiny::BEGIN@3
11115µs28µsHTTP::Tiny::::BEGIN@205 HTTP::Tiny::BEGIN@205
21114µs53µsHTTP::Tiny::::timeout HTTP::Tiny::timeout
11113µs13µsHTTP::Tiny::Handle::::newHTTP::Tiny::Handle::new
74113µs13µsHTTP::Tiny::::CORE:match HTTP::Tiny::CORE:match (opcode)
11112µs24µsHTTP::Tiny::Handle::::BEGIN@1594HTTP::Tiny::Handle::BEGIN@1594
11112µs14µsHTTP::Tiny::::BEGIN@969 HTTP::Tiny::BEGIN@969
11111µs23µsHTTP::Tiny::::BEGIN@74 HTTP::Tiny::BEGIN@74
11110µs322µsHTTP::Tiny::Handle::::BEGIN@981HTTP::Tiny::Handle::BEGIN@981
11110µs611µsHTTP::Tiny::Handle::::BEGIN@982HTTP::Tiny::Handle::BEGIN@982
11110µs39µsHTTP::Tiny::Handle::::BEGIN@983HTTP::Tiny::Handle::BEGIN@983
1119µs16µsHTTP::Tiny::Handle::::BEGIN@979HTTP::Tiny::Handle::BEGIN@979
1119µs9µsHTTP::Tiny::::agent HTTP::Tiny::agent
1118µs13µsHTTP::Tiny::::BEGIN@4 HTTP::Tiny::BEGIN@4
1118µs19µsHTTP::Tiny::::BEGIN@75 HTTP::Tiny::BEGIN@75
1118µs22µsHTTP::Tiny::Handle::::BEGIN@978HTTP::Tiny::Handle::BEGIN@978
3217µs7µsHTTP::Tiny::::CORE:subst HTTP::Tiny::CORE:subst (opcode)
1114µs4µsHTTP::Tiny::::BEGIN@9 HTTP::Tiny::BEGIN@9
1113µs3µsHTTP::Tiny::::CORE:qr HTTP::Tiny::CORE:qr (opcode)
2212µs2µsHTTP::Tiny::Handle::::CORE:qrHTTP::Tiny::Handle::CORE:qr (opcode)
1112µs2µsHTTP::Tiny::Handle::::CORE:binmodeHTTP::Tiny::Handle::CORE:binmode (opcode)
0000s0sHTTP::Tiny::Handle::::__ANON__[:1002]HTTP::Tiny::Handle::__ANON__[:1002]
0000s0sHTTP::Tiny::Handle::::__ANON__[:1093]HTTP::Tiny::Handle::__ANON__[:1093]
0000s0sHTTP::Tiny::Handle::::_assert_sslHTTP::Tiny::Handle::_assert_ssl
0000s0sHTTP::Tiny::Handle::::_find_CA_fileHTTP::Tiny::Handle::_find_CA_file
0000s0sHTTP::Tiny::Handle::::_ssl_argsHTTP::Tiny::Handle::_ssl_args
0000s0sHTTP::Tiny::Handle::::closeHTTP::Tiny::Handle::close
0000s0sHTTP::Tiny::Handle::::readHTTP::Tiny::Handle::read
0000s0sHTTP::Tiny::Handle::::read_bodyHTTP::Tiny::Handle::read_body
0000s0sHTTP::Tiny::Handle::::read_chunked_bodyHTTP::Tiny::Handle::read_chunked_body
0000s0sHTTP::Tiny::Handle::::read_content_bodyHTTP::Tiny::Handle::read_content_body
0000s0sHTTP::Tiny::Handle::::start_sslHTTP::Tiny::Handle::start_ssl
0000s0sHTTP::Tiny::Handle::::write_bodyHTTP::Tiny::Handle::write_body
0000s0sHTTP::Tiny::Handle::::write_chunked_bodyHTTP::Tiny::Handle::write_chunked_body
0000s0sHTTP::Tiny::Handle::::write_content_bodyHTTP::Tiny::Handle::write_content_body
0000s0sHTTP::Tiny::::__ANON__[:294] HTTP::Tiny::__ANON__[:294]
0000s0sHTTP::Tiny::::__ANON__[:806] HTTP::Tiny::__ANON__[:806]
0000s0sHTTP::Tiny::::__ANON__[:845] HTTP::Tiny::__ANON__[:845]
0000s0sHTTP::Tiny::::__ANON__[:848] HTTP::Tiny::__ANON__[:848]
0000s0sHTTP::Tiny::::__ANON__[:84] HTTP::Tiny::__ANON__[:84]
0000s0sHTTP::Tiny::::_add_basic_auth_header HTTP::Tiny::_add_basic_auth_header
0000s0sHTTP::Tiny::::_create_proxy_tunnel HTTP::Tiny::_create_proxy_tunnel
0000s0sHTTP::Tiny::::_http_date HTTP::Tiny::_http_date
0000s0sHTTP::Tiny::::_parse_http_date HTTP::Tiny::_parse_http_date
0000s0sHTTP::Tiny::::_prepare_data_cb HTTP::Tiny::_prepare_data_cb
0000s0sHTTP::Tiny::::_proxy_connect HTTP::Tiny::_proxy_connect
0000s0sHTTP::Tiny::::_split_proxy HTTP::Tiny::_split_proxy
0000s0sHTTP::Tiny::::_update_cookie_jar HTTP::Tiny::_update_cookie_jar
0000s0sHTTP::Tiny::::_uri_escape HTTP::Tiny::_uri_escape
0000s0sHTTP::Tiny::::_validate_cookie_jar HTTP::Tiny::_validate_cookie_jar
0000s0sHTTP::Tiny::::can_ssl HTTP::Tiny::can_ssl
0000s0sHTTP::Tiny::::connected HTTP::Tiny::connected
0000s0sHTTP::Tiny::::mirror HTTP::Tiny::mirror
0000s0sHTTP::Tiny::::post_form HTTP::Tiny::post_form
0000s0sHTTP::Tiny::::www_form_urlencode HTTP::Tiny::www_form_urlencode
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# vim: ts=4 sts=4 sw=4 et:
2package HTTP::Tiny;
3229µs251µs
# spent 33µs (15+18) within HTTP::Tiny::BEGIN@3 which was called: # once (15µs+18µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 3
use strict;
# spent 33µs making 1 call to HTTP::Tiny::BEGIN@3 # spent 18µs making 1 call to strict::import
4242µs218µs
# spent 13µs (8+5) within HTTP::Tiny::BEGIN@4 which was called: # once (8µs+5µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 4
use warnings;
# spent 13µs making 1 call to HTTP::Tiny::BEGIN@4 # spent 5µs making 1 call to warnings::import
5# ABSTRACT: A small, simple, correct HTTP/1.1 client
6
71700nsour $VERSION = '0.058';
8
92106µs14µs
# spent 4µs within HTTP::Tiny::BEGIN@9 which was called: # once (4µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 9
use Carp ();
# spent 4µs making 1 call to HTTP::Tiny::BEGIN@9
10
11#pod =method new
12#pod
13#pod $http = HTTP::Tiny->new( %attributes );
14#pod
15#pod This constructor returns a new HTTP::Tiny object. Valid attributes include:
16#pod
17#pod =for :list
18#pod * C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If
19#pod C<agent> — ends in a space character, the default user-agent string is
20#pod appended.
21#pod * C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class
22#pod that supports the C<add> and C<cookie_header> methods
23#pod * C<default_headers> — A hashref of default headers to apply to requests
24#pod * C<local_address> — The local IP address to bind to
25#pod * C<keep_alive> — Whether to reuse the last connection (if for the same
26#pod scheme, host and port) (defaults to 1)
27#pod * C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
28#pod * C<max_size> — Maximum response size in bytes (only when not using a data
29#pod callback). If defined, responses larger than this will return an
30#pod exception.
31#pod * C<http_proxy> — URL of a proxy server to use for HTTP connections
32#pod (default is C<$ENV{http_proxy}> — if set)
33#pod * C<https_proxy> — URL of a proxy server to use for HTTPS connections
34#pod (default is C<$ENV{https_proxy}> — if set)
35#pod * C<proxy> — URL of a generic proxy server for both HTTP and HTTPS
36#pod connections (default is C<$ENV{all_proxy}> — if set)
37#pod * C<no_proxy> — List of domain suffixes that should not be proxied. Must
38#pod be a comma-separated string or an array reference. (default is
39#pod C<$ENV{no_proxy}> —)
40#pod * C<timeout> — Request timeout in seconds (default is 60) If a socket open,
41#pod read or write takes longer than the timeout, an exception is thrown.
42#pod * C<verify_SSL> — A boolean that indicates whether to validate the SSL
43#pod certificate of an C<https> — connection (default is false)
44#pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to
45#pod L<IO::Socket::SSL>
46#pod
47#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
48#pod prevent getting the corresponding proxies from the environment.
49#pod
50#pod Exceptions from C<max_size>, C<timeout> or other errors will result in a
51#pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
52#pod content field in the response will contain the text of the exception.
53#pod
54#pod The C<keep_alive> parameter enables a persistent connection, but only to a
55#pod single destination scheme, host and port. Also, if any connection-relevant
56#pod attributes are modified, or if the process ID or thread ID change, the
57#pod persistent connection will be dropped. If you want persistent connections
58#pod across multiple destinations, use multiple HTTP::Tiny objects.
59#pod
60#pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
61#pod
62#pod =cut
63
641200nsmy @attributes;
65
# spent 56µs within HTTP::Tiny::BEGIN@65 which was called: # once (56µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 86
BEGIN {
6617µs @attributes = qw(
67 cookie_jar default_headers http_proxy https_proxy keep_alive
68 local_address max_redirect max_size proxy no_proxy
69 SSL_options verify_SSL
70 );
7115µs my %persist_ok = map {; $_ => 1 } qw(
72 cookie_jar default_headers max_redirect max_size
73 );
74230µs235µs
# spent 23µs (11+12) within HTTP::Tiny::BEGIN@74 which was called: # once (11µs+12µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 74
no strict 'refs';
# spent 23µs making 1 call to HTTP::Tiny::BEGIN@74 # spent 12µs making 1 call to strict::unimport
752109µs229µs
# spent 19µs (8+10) within HTTP::Tiny::BEGIN@75 which was called: # once (8µs+10µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 75
no warnings 'uninitialized';
# spent 19µs making 1 call to HTTP::Tiny::BEGIN@75 # spent 10µs making 1 call to warnings::unimport
7616µs for my $accessor ( @attributes ) {
77 *{$accessor} = sub {
78 @_ > 1
79 ? do {
80 delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
81 $_[0]->{$accessor} = $_[1]
82 }
83 : $_[0]->{$accessor};
841240µs };
85 }
861537µs156µs}
# spent 56µs making 1 call to HTTP::Tiny::BEGIN@65
87
88
# spent 9µs (9+600ns) within HTTP::Tiny::agent which was called: # once (9µs+600ns) by HTTP::Tiny::new at line 127
sub agent {
891700ns my($self, $agent) = @_;
9011µs if( @_ > 1 ){
9116µs1600ns $self->{agent} =
# spent 600ns making 1 call to HTTP::Tiny::CORE:match
92 (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
93 }
9413µs return $self->{agent};
95}
96
97
# spent 53µs (14+39) within HTTP::Tiny::timeout which was called 2 times, avg 26µs/call: # 2 times (14µs+39µs) by Search::Elasticsearch::Cxn::HTTPTiny::perform_request at line 32 of /opt/flows/lib/lib/perl5/Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 26µs/call
sub timeout {
9821µs my ($self, $timeout) = @_;
9922µs if ( @_ > 1 ) {
10022µs $self->{timeout} = $timeout;
10124µs139µs if ($self->{handle}) {
# spent 39µs making 1 call to HTTP::Tiny::Handle::timeout
102 $self->{handle}->timeout($timeout);
103 }
104 }
10526µs return $self->{timeout};
106}
107
108
# spent 81µs (30+50) within HTTP::Tiny::new which was called: # once (30µs+50µs) by Search::Elasticsearch::Cxn::HTTPTiny::_build_handle at line 69 of /opt/flows/lib/lib/perl5/Search/Elasticsearch/Cxn/HTTPTiny.pm
sub new {
10912µs my($class, %args) = @_;
110
11114µs my $self = {
112 max_redirect => 5,
113 timeout => 60,
114 keep_alive => 1,
115 verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
116 no_proxy => $ENV{no_proxy},
117 };
118
11911µs bless $self, $class;
120
1211600ns $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
122
12311µs for my $key ( @attributes ) {
124127µs $self->{$key} = $args{$key} if exists $args{$key}
125 }
126
12716µs234µs $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
# spent 24µs making 1 call to HTTP::Tiny::_agent # spent 9µs making 1 call to HTTP::Tiny::agent
128
12912µs117µs $self->_set_proxies;
# spent 17µs making 1 call to HTTP::Tiny::_set_proxies
130
13114µs return $self;
132}
133
134
# spent 17µs within HTTP::Tiny::_set_proxies which was called: # once (17µs+0s) by HTTP::Tiny::new at line 129
sub _set_proxies {
1351400ns my ($self) = @_;
136
137 # get proxies from %ENV only if not provided; explicit undef will disable
138 # getting proxies from the environment
139
140 # generic proxy
14114µs if (! exists $self->{proxy} ) {
142 $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
143 }
144
14511µs if ( defined $self->{proxy} ) {
146 $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
147 }
148 else {
1491900ns delete $self->{proxy};
150 }
151
152 # http proxy
1531700ns if (! exists $self->{http_proxy} ) {
154 # under CGI, bypass HTTP_PROXY as request sets it from Proxy header
1551500ns local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
15611µs $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
157 }
158
1591900ns if ( defined $self->{http_proxy} ) {
160 $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
161 $self->{_has_proxy}{http} = 1;
162 }
163 else {
1641700ns delete $self->{http_proxy};
165 }
166
167 # https proxy
16812µs if (! exists $self->{https_proxy} ) {
169 $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
170 }
171
1721500ns if ( $self->{https_proxy} ) {
173 $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
174 $self->{_has_proxy}{https} = 1;
175 }
176 else {
1771500ns delete $self->{https_proxy};
178 }
179
180 # Split no_proxy to array reference if not provided as such
1811900ns unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
18211µs $self->{no_proxy} =
183 (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
184 }
185
18613µs return;
187}
188
189#pod =method get|head|put|post|delete
190#pod
191#pod $response = $http->get($url);
192#pod $response = $http->get($url, \%options);
193#pod $response = $http->head($url);
194#pod
195#pod These methods are shorthand for calling C<request()> for the given method. The
196#pod URL must have unsafe characters escaped and international domain names encoded.
197#pod See C<request()> for valid options and a description of the response.
198#pod
199#pod The C<success> field of the response will be true if the status code is 2XX.
200#pod
201#pod =cut
202
20311µsfor my $sub_name ( qw/get head put post delete/ ) {
20454µs my $req_method = uc $sub_name;
20523.81ms241µs
# spent 28µs (15+13) within HTTP::Tiny::BEGIN@205 which was called: # once (15µs+13µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 205
no strict 'refs';
# spent 28µs making 1 call to HTTP::Tiny::BEGIN@205 # spent 13µs making 1 call to strict::unimport
2065386µs eval <<"HERE"; ## no critic
207 sub $sub_name {
208 my (\$self, \$url, \$args) = \@_;
209 \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
210 or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
211 return \$self->request('$req_method', \$url, \$args || {});
212 }
213HERE
214}
215
216#pod =method post_form
217#pod
218#pod $response = $http->post_form($url, $form_data);
219#pod $response = $http->post_form($url, $form_data, \%options);
220#pod
221#pod This method executes a C<POST> request and sends the key/value pairs from a
222#pod form data hash or array reference to the given URL with a C<content-type> of
223#pod C<application/x-www-form-urlencoded>. If data is provided as an array
224#pod reference, the order is preserved; if provided as a hash reference, the terms
225#pod are sorted on key and value for consistency. See documentation for the
226#pod C<www_form_urlencode> method for details on the encoding.
227#pod
228#pod The URL must have unsafe characters escaped and international domain names
229#pod encoded. See C<request()> for valid options and a description of the response.
230#pod Any C<content-type> header or content in the options hashref will be ignored.
231#pod
232#pod The C<success> field of the response will be true if the status code is 2XX.
233#pod
234#pod =cut
235
236sub post_form {
237 my ($self, $url, $data, $args) = @_;
238 (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
239 or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
240
241 my $headers = {};
242 while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
243 $headers->{lc $key} = $value;
244 }
245 delete $args->{headers};
246
247 return $self->request('POST', $url, {
248 %$args,
249 content => $self->www_form_urlencode($data),
250 headers => {
251 %$headers,
252 'content-type' => 'application/x-www-form-urlencoded'
253 },
254 }
255 );
256}
257
258#pod =method mirror
259#pod
260#pod $response = $http->mirror($url, $file, \%options)
261#pod if ( $response->{success} ) {
262#pod print "$file is up to date\n";
263#pod }
264#pod
265#pod Executes a C<GET> request for the URL and saves the response body to the file
266#pod name provided. The URL must have unsafe characters escaped and international
267#pod domain names encoded. If the file already exists, the request will include an
268#pod C<If-Modified-Since> header with the modification timestamp of the file. You
269#pod may specify a different C<If-Modified-Since> header yourself in the C<<
270#pod $options->{headers} >> hash.
271#pod
272#pod The C<success> field of the response will be true if the status code is 2XX
273#pod or if the status code is 304 (unmodified).
274#pod
275#pod If the file was modified and the server response includes a properly
276#pod formatted C<Last-Modified> header, the file modification time will
277#pod be updated accordingly.
278#pod
279#pod =cut
280
281sub mirror {
282 my ($self, $url, $file, $args) = @_;
283 @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
284 or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
285 if ( -e $file and my $mtime = (stat($file))[9] ) {
286 $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
287 }
288 my $tempfile = $file . int(rand(2**31));
289
290 require Fcntl;
291 sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
292 or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
293 binmode $fh;
294 $args->{data_callback} = sub { print {$fh} $_[0] };
295 my $response = $self->request('GET', $url, $args);
296 close $fh
297 or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
298
299 if ( $response->{success} ) {
300 rename $tempfile, $file
301 or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
302 my $lm = $response->{headers}{'last-modified'};
303 if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
304 utime $mtime, $mtime, $file;
305 }
306 }
307 $response->{success} ||= $response->{status} eq '304';
308 unlink $tempfile;
309 return $response;
310}
311
312#pod =method request
313#pod
314#pod $response = $http->request($method, $url);
315#pod $response = $http->request($method, $url, \%options);
316#pod
317#pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
318#pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and
319#pod international domain names encoded.
320#pod
321#pod If the URL includes a "user:password" stanza, they will be used for Basic-style
322#pod authorization headers. (Authorization headers will not be included in a
323#pod redirected request.) For example:
324#pod
325#pod $http->request('GET', 'http://Aladdin:open sesame@example.com/');
326#pod
327#pod If the "user:password" stanza contains reserved characters, they must
328#pod be percent-escaped:
329#pod
330#pod $http->request('GET', 'http://john%40example.com:password@example.com/');
331#pod
332#pod A hashref of options may be appended to modify the request.
333#pod
334#pod Valid options are:
335#pod
336#pod =for :list
337#pod * C<headers> —
338#pod A hashref containing headers to include with the request. If the value for
339#pod a header is an array reference, the header will be output multiple times with
340#pod each value in the array. These headers over-write any default headers.
341#pod * C<content> —
342#pod A scalar to include as the body of the request OR a code reference
343#pod that will be called iteratively to produce the body of the request
344#pod * C<trailer_callback> —
345#pod A code reference that will be called if it exists to provide a hashref
346#pod of trailing headers (only used with chunked transfer-encoding)
347#pod * C<data_callback> —
348#pod A code reference that will be called for each chunks of the response
349#pod body received.
350#pod * C<peer> —
351#pod Override host resolution and force all connections to go only to a
352#pod specific peer address, regardless of the URL of the request. This will
353#pod include any redirections! This options should be used with extreme
354#pod caution (e.g. debugging or very special circumstances).
355#pod
356#pod The C<Host> header is generated from the URL in accordance with RFC 2616. It
357#pod is a fatal error to specify C<Host> in the C<headers> option. Other headers
358#pod may be ignored or overwritten if necessary for transport compliance.
359#pod
360#pod If the C<content> option is a code reference, it will be called iteratively
361#pod to provide the content body of the request. It should return the empty
362#pod string or undef when the iterator is exhausted.
363#pod
364#pod If the C<content> option is the empty string, no C<content-type> or
365#pod C<content-length> headers will be generated.
366#pod
367#pod If the C<data_callback> option is provided, it will be called iteratively until
368#pod the entire response body is received. The first argument will be a string
369#pod containing a chunk of the response body, the second argument will be the
370#pod in-progress response hash reference, as described below. (This allows
371#pod customizing the action of the callback based on the C<status> or C<headers>
372#pod received prior to the content body.)
373#pod
374#pod The C<request> method returns a hashref containing the response. The hashref
375#pod will have the following keys:
376#pod
377#pod =for :list
378#pod * C<success> —
379#pod Boolean indicating whether the operation returned a 2XX status code
380#pod * C<url> —
381#pod URL that provided the response. This is the URL of the request unless
382#pod there were redirections, in which case it is the last URL queried
383#pod in a redirection chain
384#pod * C<status> —
385#pod The HTTP status code of the response
386#pod * C<reason> —
387#pod The response phrase returned by the server
388#pod * C<content> —
389#pod The body of the response. If the response does not have any content
390#pod or if a data callback is provided to consume the response body,
391#pod this will be the empty string
392#pod * C<headers> —
393#pod A hashref of header fields. All header field names will be normalized
394#pod to be lower case. If a header is repeated, the value will be an arrayref;
395#pod it will otherwise be a scalar string containing the value
396#pod * C<redirects>
397#pod If this field exists, it is an arrayref of response hash references from
398#pod redirects in the same order that redirections occurred. If it does
399#pod not exist, then no redirections occurred.
400#pod
401#pod On an exception during the execution of the request, the C<status> field will
402#pod contain 599, and the C<content> field will contain the text of the exception.
403#pod
404#pod =cut
405
40616µsmy %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
407
408
# spent 4.39ms (29µs+4.36) within HTTP::Tiny::request which was called 2 times, avg 2.19ms/call: # 2 times (29µs+4.36ms) by Search::Elasticsearch::Cxn::HTTPTiny::perform_request at line 34 of /opt/flows/lib/lib/perl5/Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 2.19ms/call
sub request {
40922µs my ($self, $method, $url, $args) = @_;
41024µs @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
411 or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
4122500ns $args ||= {}; # we keep some state in this during _request
413
414 # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
4152200ns my $response;
41622µs for ( 0 .. 1 ) {
41748µs24.36ms $response = eval { $self->_request($method, $url, $args) };
# spent 4.36ms making 2 calls to HTTP::Tiny::_request, avg 2.18ms/call
41822µs last unless $@ && $idempotent{$method}
419 && $@ =~ m{^(?:Socket closed|Unexpected end)};
420 }
421
42222µs if (my $e = $@) {
423 # maybe we got a response hash thrown from somewhere deep
424 if ( ref $e eq 'HASH' && exists $e->{status} ) {
425 return $e;
426 }
427
428 # otherwise, stringify it
429 $e = "$e";
430 $response = {
431 url => $url,
432 success => q{},
433 status => 599,
434 reason => 'Internal Exception',
435 content => $e,
436 headers => {
437 'content-type' => 'text/plain',
438 'content-length' => length $e,
439 }
440 };
441 }
442210µs return $response;
443}
444
445#pod =method www_form_urlencode
446#pod
447#pod $params = $http->www_form_urlencode( $data );
448#pod $response = $http->get("http://example.com/query?$params");
449#pod
450#pod This method converts the key/value pairs from a data hash or array reference
451#pod into a C<x-www-form-urlencoded> string. The keys and values from the data
452#pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
453#pod array reference, the key will be repeated with each of the values of the array
454#pod reference. If data is provided as a hash reference, the key/value pairs in the
455#pod resulting string will be sorted by key and value for consistent ordering.
456#pod
457#pod =cut
458
459sub www_form_urlencode {
460 my ($self, $data) = @_;
461 (@_ == 2 && ref $data)
462 or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
463 (ref $data eq 'HASH' || ref $data eq 'ARRAY')
464 or Carp::croak("form data must be a hash or array reference\n");
465
466 my @params = ref $data eq 'HASH' ? %$data : @$data;
467 @params % 2 == 0
468 or Carp::croak("form data reference must have an even number of terms\n");
469
470 my @terms;
471 while( @params ) {
472 my ($key, $value) = splice(@params, 0, 2);
473 if ( ref $value eq 'ARRAY' ) {
474 unshift @params, map { $key => $_ } @$value;
475 }
476 else {
477 push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
478 }
479 }
480
481 return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
482}
483
484#pod =method can_ssl
485#pod
486#pod $ok = HTTP::Tiny->can_ssl;
487#pod ($ok, $why) = HTTP::Tiny->can_ssl;
488#pod ($ok, $why) = $http->can_ssl;
489#pod
490#pod Indicates if SSL support is available. When called as a class object, it
491#pod checks for the correct version of L<Net::SSLeay> and L<IO::Socket::SSL>.
492#pod When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode>
493#pod is set in C<SSL_options>, it checks that a CA file is available.
494#pod
495#pod In scalar context, returns a boolean indicating if SSL is available.
496#pod In list context, returns the boolean and a (possibly multi-line) string of
497#pod errors indicating why SSL isn't available.
498#pod
499#pod =cut
500
501sub can_ssl {
502 my ($self) = @_;
503
504 my($ok, $reason) = (1, '');
505
506 # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
507 unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
508 $ok = 0;
509 $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
510 }
511
512 # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
513 unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) {
514 $ok = 0;
515 $reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/;
516 }
517
518 # If an object, check that SSL config lets us get a CA if necessary
519 if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) {
520 my $handle = HTTP::Tiny::Handle->new(
521 SSL_options => $self->{SSL_options},
522 verify_SSL => $self->{verify_SSL},
523 );
524 unless ( eval { $handle->_find_CA_file; 1 } ) {
525 $ok = 0;
526 $reason .= "$@";
527 }
528 }
529
530 wantarray ? ($ok, $reason) : $ok;
531}
532
533#pod =method connected
534#pod
535#pod $host = $http->connected;
536#pod ($host, $port) = $http->connected;
537#pod
538#pod Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
539#pod option.
540#pod
541#pod In scalar context, returns the peer host and port, joined with a colon, or
542#pod C<undef> (if no peer is connected).
543#pod In list context, returns the peer host and port or an empty list (if no peer
544#pod is connected).
545#pod
546#pod B<Note>: This method cannot reliably be used to discover whether the remote
547#pod host has closed its end of the socket.
548#pod
549#pod =cut
550
551sub connected {
552 my ($self) = @_;
553
554 # If a socket exists...
555 if ($self->{handle} && $self->{handle}{fh}) {
556 my $socket = $self->{handle}{fh};
557
558 # ...and is connected, return the peer host and port.
559 if ($socket->connected) {
560 return wantarray
561 ? ($socket->peerhost, $socket->peerport)
562 : join(':', $socket->peerhost, $socket->peerport);
563 }
564 }
565 return;
566}
567
568#--------------------------------------------------------------------------#
569# private methods
570#--------------------------------------------------------------------------#
571
57211µsmy %DefaultPort = (
573 http => 80,
574 https => 443,
575);
576
577
# spent 24µs (16+8) within HTTP::Tiny::_agent which was called: # once (16µs+8µs) by HTTP::Tiny::new at line 127
sub _agent {
57811µs my $class = ref($_[0]) || $_[0];
57918µs13µs (my $default_agent = $class) =~ s{::}{-}g;
# spent 3µs making 1 call to HTTP::Tiny::CORE:subst
580117µs15µs return $default_agent . "/" . $class->VERSION;
# spent 5µs making 1 call to UNIVERSAL::VERSION
581}
582
583
# spent 4.36ms (124µs+4.23) within HTTP::Tiny::_request which was called 2 times, avg 2.18ms/call: # 2 times (124µs+4.23ms) by HTTP::Tiny::request at line 417, avg 2.18ms/call
sub _request {
58422µs my ($self, $method, $url, $args) = @_;
585
58627µs251µs my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
# spent 51µs making 2 calls to HTTP::Tiny::_split_url, avg 25µs/call
587
588215µs my $request = {
589 method => $method,
590 scheme => $scheme,
591 host => $host,
592 port => $port,
593 host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
594 uri => $path_query,
595 headers => {},
596 };
597
59822µs my $peer = $args->{peer} || $host;
599
600 # We remove the cached handle so it is not reused in the case of redirect.
601 # If all is well, it will be recached at the end of _request. We only
602 # reuse for the same scheme, host and port
60322µs my $handle = delete $self->{handle};
6042900ns if ( $handle ) {
60514µs154µs unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) {
# spent 54µs making 1 call to HTTP::Tiny::Handle::can_reuse
606 $handle->close;
607 undef $handle;
608 }
609 }
61023µs1715µs $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer );
# spent 715µs making 1 call to HTTP::Tiny::_open_handle
611
61226µs231µs $self->_prepare_headers_and_cb($request, $args, $url, $auth);
# spent 31µs making 2 calls to HTTP::Tiny::_prepare_headers_and_cb, avg 15µs/call
61325µs2318µs $handle->write_request($request);
# spent 318µs making 2 calls to HTTP::Tiny::Handle::write_request, avg 159µs/call
614
6152500ns my $response;
616212µs23.04ms do { $response = $handle->read_response_header }
# spent 3.04ms making 2 calls to HTTP::Tiny::Handle::read_response_header, avg 1.52ms/call
617 until (substr($response->{status},0,1) ne '1');
618
61922µs $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
620210µs227µs my @redir_args = $self->_maybe_redirect($request, $response, $args);
# spent 27µs making 2 calls to HTTP::Tiny::_maybe_redirect, avg 14µs/call
621
6222400ns my $known_message_length;
62322µs if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
624 # response has no message body
625 $known_message_length = 1;
626 }
627 else {
628 # Ignore any data callbacks during redirection.
629 my $cb_args = @redir_args ? +{} : $args;
630 my $data_cb = $self->_prepare_data_cb($response, $cb_args);
631 $known_message_length = $handle->read_body($data_cb, $response);
632 }
633
63429µs if ( $self->{keep_alive}
635 && $known_message_length
636 && $response->{protocol} eq 'HTTP/1.1'
637 && ($response->{headers}{connection} || '') ne 'close'
638 ) {
639 $self->{handle} = $handle;
640 }
641 else {
642 $handle->close;
643 }
644
64525µs $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
64622µs $response->{url} = $url;
647
648 # Push the current response onto the stack of redirects if redirecting.
6492900ns if (@redir_args) {
650 push @{$args->{_redirects}}, $response;
651 return $self->_request(@redir_args, $args);
652 }
653
654 # Copy the stack of redirects into the response before returning.
655 $response->{redirects} = delete $args->{_redirects}
65622µs if @{$args->{_redirects}};
657220µs return $response;
658}
659
660
# spent 715µs (18+696) within HTTP::Tiny::_open_handle which was called: # once (18µs+696µs) by HTTP::Tiny::_request at line 610
sub _open_handle {
66111µs my ($self, $request, $scheme, $host, $port, $peer) = @_;
662
66318µs113µs my $handle = HTTP::Tiny::Handle->new(
# spent 13µs making 1 call to HTTP::Tiny::Handle::new
664 timeout => $self->{timeout},
665 SSL_options => $self->{SSL_options},
666 verify_SSL => $self->{verify_SSL},
667 local_address => $self->{local_address},
668 keep_alive => $self->{keep_alive}
669 );
670
67111µs if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
672 return $self->_proxy_connect( $request, $handle );
673 }
674 else {
67515µs1683µs return $handle->connect($scheme, $host, $port, $peer);
# spent 683µs making 1 call to HTTP::Tiny::Handle::connect
676 }
677}
678
679sub _proxy_connect {
680 my ($self, $request, $handle) = @_;
681
682 my @proxy_vars;
683 if ( $request->{scheme} eq 'https' ) {
684 Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
685 @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
686 if ( $proxy_vars[0] eq 'https' ) {
687 Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
688 }
689 }
690 else {
691 Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
692 @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
693 }
694
695 my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
696
697 if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
698 $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
699 }
700
701 $handle->connect($p_scheme, $p_host, $p_port, $p_host);
702
703 if ($request->{scheme} eq 'https') {
704 $self->_create_proxy_tunnel( $request, $handle );
705 }
706 else {
707 # non-tunneled proxy requires absolute URI
708 $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
709 }
710
711 return $handle;
712}
713
714sub _split_proxy {
715 my ($self, $type, $proxy) = @_;
716
717 my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
718
719 unless(
720 defined($scheme) && length($scheme) && length($host) && length($port)
721 && $path_query eq '/'
722 ) {
723 Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
724 }
725
726 return ($scheme, $host, $port, $auth);
727}
728
729sub _create_proxy_tunnel {
730 my ($self, $request, $handle) = @_;
731
732 $handle->_assert_ssl;
733
734 my $agent = exists($request->{headers}{'user-agent'})
735 ? $request->{headers}{'user-agent'} : $self->{agent};
736
737 my $connect_request = {
738 method => 'CONNECT',
739 uri => "$request->{host}:$request->{port}",
740 headers => {
741 host => "$request->{host}:$request->{port}",
742 'user-agent' => $agent,
743 }
744 };
745
746 if ( $request->{headers}{'proxy-authorization'} ) {
747 $connect_request->{headers}{'proxy-authorization'} =
748 delete $request->{headers}{'proxy-authorization'};
749 }
750
751 $handle->write_request($connect_request);
752 my $response;
753 do { $response = $handle->read_response_header }
754 until (substr($response->{status},0,1) ne '1');
755
756 # if CONNECT failed, throw the response so it will be
757 # returned from the original request() method;
758 unless (substr($response->{status},0,1) eq '2') {
759 die $response;
760 }
761
762 # tunnel established, so start SSL handshake
763 $handle->start_ssl( $request->{host} );
764
765 return;
766}
767
768
# spent 31µs within HTTP::Tiny::_prepare_headers_and_cb which was called 2 times, avg 15µs/call: # 2 times (31µs+0s) by HTTP::Tiny::_request at line 612, avg 15µs/call
sub _prepare_headers_and_cb {
76922µs my ($self, $request, $args, $url, $auth) = @_;
770
77126µs for ($self->{default_headers}, $args->{headers}) {
77242µs next unless defined;
77324µs while (my ($k, $v) = each %$_) {
774 $request->{headers}{lc $k} = $v;
775 $request->{header_case}{lc $k} = $k;
776 }
777 }
778
77922µs if (exists $request->{headers}{'host'}) {
780 die(qq/The 'Host' header must not be provided as header option\n/);
781 }
782
78323µs $request->{headers}{'host'} = $request->{host_port};
78423µs $request->{headers}{'user-agent'} ||= $self->{agent};
78521µs $request->{headers}{'connection'} = "close"
786 unless $self->{keep_alive};
787
78822µs if ( defined $args->{content} ) {
789 if (ref $args->{content} eq 'CODE') {
790 $request->{headers}{'content-type'} ||= "application/octet-stream";
791 $request->{headers}{'transfer-encoding'} = 'chunked'
792 unless $request->{headers}{'content-length'}
793 || $request->{headers}{'transfer-encoding'};
794 $request->{cb} = $args->{content};
795 }
796 elsif ( length $args->{content} ) {
797 my $content = $args->{content};
798 if ( $] ge '5.008' ) {
799 utf8::downgrade($content, 1)
800 or die(qq/Wide character in request message body\n/);
801 }
802 $request->{headers}{'content-type'} ||= "application/octet-stream";
803 $request->{headers}{'content-length'} = length $content
804 unless $request->{headers}{'content-length'}
805 || $request->{headers}{'transfer-encoding'};
806 $request->{cb} = sub { substr $content, 0, length $content, '' };
807 }
808 $request->{trailer_cb} = $args->{trailer_callback}
809 if ref $args->{trailer_callback} eq 'CODE';
810 }
811
812 ### If we have a cookie jar, then maybe add relevant cookies
81321µs if ( $self->{cookie_jar} ) {
814 my $cookies = $self->cookie_jar->cookie_header( $url );
815 $request->{headers}{cookie} = $cookies if length $cookies;
816 }
817
818 # if we have Basic auth parameters, add them
81921µs if ( length $auth && ! defined $request->{headers}{authorization} ) {
820 $self->_add_basic_auth_header( $request, 'authorization' => $auth );
821 }
822
82326µs return;
824}
825
826sub _add_basic_auth_header {
827 my ($self, $request, $header, $auth) = @_;
828 require MIME::Base64;
829 $request->{headers}{$header} =
830 "Basic " . MIME::Base64::encode_base64($auth, "");
831 return;
832}
833
834sub _prepare_data_cb {
835 my ($self, $response, $args) = @_;
836 my $data_cb = $args->{data_callback};
837 $response->{content} = '';
838
839 if (!$data_cb || $response->{status} !~ /^2/) {
840 if (defined $self->{max_size}) {
841 $data_cb = sub {
842 $_[1]->{content} .= $_[0];
843 die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
844 if length $_[1]->{content} > $self->{max_size};
845 };
846 }
847 else {
848 $data_cb = sub { $_[1]->{content} .= $_[0] };
849 }
850 }
851 return $data_cb;
852}
853
854sub _update_cookie_jar {
855 my ($self, $url, $response) = @_;
856
857 my $cookies = $response->{headers}->{'set-cookie'};
858 return unless defined $cookies;
859
860 my @cookies = ref $cookies ? @$cookies : $cookies;
861
862 $self->cookie_jar->add( $url, $_ ) for @cookies;
863
864 return;
865}
866
867sub _validate_cookie_jar {
868 my ($class, $jar) = @_;
869
870 # duck typing
871 for my $method ( qw/add cookie_header/ ) {
872 Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
873 unless ref($jar) && ref($jar)->can($method);
874 }
875
876 return;
877}
878
879
# spent 27µs (26+1) within HTTP::Tiny::_maybe_redirect which was called 2 times, avg 14µs/call: # 2 times (26µs+1µs) by HTTP::Tiny::_request at line 620, avg 14µs/call
sub _maybe_redirect {
88022µs my ($self, $request, $response, $args) = @_;
88121µs my $headers = $response->{headers};
88225µs my ($status, $method) = ($response->{status}, $request->{method});
88324µs $args->{_redirects} ||= [];
884
885210µs21µs if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))
# spent 1µs making 2 calls to HTTP::Tiny::CORE:match, avg 700ns/call
886 and $headers->{location}
887 and @{$args->{_redirects}} < $self->{max_redirect}
888 ) {
889 my $location = ($headers->{location} =~ /^\//)
890 ? "$request->{scheme}://$request->{host_port}$headers->{location}"
891 : $headers->{location} ;
892 return (($status eq '303' ? 'GET' : $method), $location);
893 }
894210µs return;
895}
896
897
# spent 51µs (36+15) within HTTP::Tiny::_split_url which was called 2 times, avg 25µs/call: # 2 times (36µs+15µs) by HTTP::Tiny::_request at line 586, avg 25µs/call
sub _split_url {
89822µs my $url = pop;
899
900 # URI regex adapted from the URI module
901216µs28µs my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
# spent 8µs making 2 calls to HTTP::Tiny::CORE:match, avg 4µs/call
902 or die(qq/Cannot parse URL: '$url'\n/);
903
90422µs $scheme = lc $scheme;
90527µs22µs $path_query = "/$path_query" unless $path_query =~ m<\A/>;
# spent 2µs making 2 calls to HTTP::Tiny::CORE:match, avg 1µs/call
906
90721µs my $auth = '';
90822µs if ( (my $i = index $host, '@') != -1 ) {
909 # user:pass@host
910 $auth = substr $host, 0, $i, ''; # take up to the @ for auth
911 substr $host, 0, 1, ''; # knock the @ off the host
912
913 # userinfo might be percent escaped, so recover real auth info
914 $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
915 }
916214µs24µs my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
# spent 4µs making 2 calls to HTTP::Tiny::CORE:subst, avg 2µs/call
917 : $scheme eq 'http' ? 80
918 : $scheme eq 'https' ? 443
919 : undef;
920
92129µs return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
922}
923
924# Date conversions adapted from HTTP::Date
9251400nsmy $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
9261200nsmy $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
927sub _http_date {
928 my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
929 return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
930 substr($DoW,$wday*4,3),
931 $mday, substr($MoY,$mon*4,3), $year+1900,
932 $hour, $min, $sec
933 );
934}
935
936sub _parse_http_date {
937 my ($self, $str) = @_;
938 require Time::Local;
939 my @tl_parts;
940 if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
941 @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
942 }
943 elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
944 @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
945 }
946 elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
947 @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
948 }
949 return eval {
950 my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
951 $t < 0 ? undef : $t;
952 };
953}
954
955# URI escaping adapted from URI::Escape
956# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
957# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
958257307µsmy %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
9591800ns$escapes{' '}="+";
960111µs13µsmy $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
# spent 3µs making 1 call to HTTP::Tiny::CORE:qr
961
962sub _uri_escape {
963 my ($self, $str) = @_;
964 if ( $] ge '5.008' ) {
965 utf8::encode($str);
966 }
967 else {
968 $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
9692100µs216µs
# spent 14µs (12+2) within HTTP::Tiny::BEGIN@969 which was called: # once (12µs+2µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 969
if ( length $str == do { use bytes; length $str } );
# spent 14µs making 1 call to HTTP::Tiny::BEGIN@969 # spent 2µs making 1 call to bytes::import
970 $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
971 }
972 $str =~ s/($unsafe_char)/$escapes{$1}/ge;
973 return $str;
974}
975
976package
977 HTTP::Tiny::Handle; # hide from PAUSE/indexers
978228µs236µs
# spent 22µs (8+14) within HTTP::Tiny::Handle::BEGIN@978 which was called: # once (8µs+14µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 978
use strict;
# spent 22µs making 1 call to HTTP::Tiny::Handle::BEGIN@978 # spent 14µs making 1 call to strict::import
979238µs223µs
# spent 16µs (9+7) within HTTP::Tiny::Handle::BEGIN@979 which was called: # once (9µs+7µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 979
use warnings;
# spent 16µs making 1 call to HTTP::Tiny::Handle::BEGIN@979 # spent 7µs making 1 call to warnings::import
980
981237µs2634µs
# spent 322µs (10+312) within HTTP::Tiny::Handle::BEGIN@981 which was called: # once (10µs+312µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 981
use Errno qw[EINTR EPIPE];
# spent 322µs making 1 call to HTTP::Tiny::Handle::BEGIN@981 # spent 312µs making 1 call to Exporter::import
982243µs21.21ms
# spent 611µs (10+600) within HTTP::Tiny::Handle::BEGIN@982 which was called: # once (10µs+600µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 982
use IO::Socket qw[SOCK_STREAM];
# spent 611µs making 1 call to HTTP::Tiny::Handle::BEGIN@982 # spent 600µs making 1 call to IO::Socket::import
98324.07ms269µs
# spent 39µs (10+29) within HTTP::Tiny::Handle::BEGIN@983 which was called: # once (10µs+29µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 983
use Socket qw[SOL_SOCKET SO_KEEPALIVE];
# spent 39µs making 1 call to HTTP::Tiny::Handle::BEGIN@983 # spent 29µs making 1 call to Exporter::import
984
985# PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
986# behavior if someone is unable to boostrap CPAN from a new perl install; it is
987# not intended for general, per-client use and may be removed in the future
988my $SOCKET_CLASS =
989 $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
990243µs eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
991 'IO::Socket::INET';
992
993sub BUFSIZE () { 32768 } ## no critic
994
995my $Printable = sub {
996 local $_ = shift;
997 s/\r/\\r/g;
998 s/\n/\\n/g;
999 s/\t/\\t/g;
1000 s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
1001 $_;
100213µs};
1003
100417µs12µsmy $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
# spent 2µs making 1 call to HTTP::Tiny::Handle::CORE:qr
100513µs1800nsmy $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;
# spent 800ns making 1 call to HTTP::Tiny::Handle::CORE:qr
1006
1007
# spent 13µs within HTTP::Tiny::Handle::new which was called: # once (13µs+0s) by HTTP::Tiny::_open_handle at line 663
sub new {
100813µs my ($class, %args) = @_;
1009113µs return bless {
1010 rbuf => '',
1011 timeout => 60,
1012 max_line_size => 16384,
1013 max_header_lines => 64,
1014 verify_SSL => 0,
1015 SSL_options => {},
1016 %args
1017 }, $class;
1018}
1019
1020
# spent 39µs (26+13) within HTTP::Tiny::Handle::timeout which was called: # once (26µs+13µs) by HTTP::Tiny::timeout at line 101
sub timeout {
10211800ns my ($self, $timeout) = @_;
102211µs if ( @_ > 1 ) {
102311µs $self->{timeout} = $timeout;
1024121µs213µs if ( $self->{fh} && $self->{fh}->can('timeout') ) {
# spent 9µs making 1 call to IO::Socket::timeout # spent 4µs making 1 call to UNIVERSAL::can
1025 $self->{fh}->timeout($timeout);
1026 }
1027 }
102814µs return $self->{timeout};
1029}
1030
1031
# spent 683µs (47+637) within HTTP::Tiny::Handle::connect which was called: # once (47µs+637µs) by HTTP::Tiny::_open_handle at line 675
sub connect {
10321600ns @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n");
103314µs my ($self, $scheme, $host, $port, $peer) = @_;
1034
10351800ns if ( $scheme eq 'https' ) {
1036 $self->_assert_ssl;
1037 }
1038 elsif ( $scheme ne 'http' ) {
1039 die(qq/Unsupported URL scheme '$scheme'\n/);
1040 }
1041113µs1610µs $self->{fh} = $SOCKET_CLASS->new(
# spent 610µs making 1 call to IO::Socket::INET::new
1042 PeerHost => $peer,
1043 PeerPort => $port,
1044 $self->{local_address} ?
1045 ( LocalAddr => $self->{local_address} ) : (),
1046 Proto => 'tcp',
1047 Type => SOCK_STREAM,
1048 Timeout => $self->{timeout},
1049 ) or die(qq/Could not connect to '$host:$port': $@\n/);
1050
105117µs12µs binmode($self->{fh})
# spent 2µs making 1 call to HTTP::Tiny::Handle::CORE:binmode
1052 or die(qq/Could not binmode() socket: '$!'\n/);
1053
105411µs if ( $self->{keep_alive} ) {
105518µs113µs unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
# spent 13µs making 1 call to IO::Socket::setsockopt
1056 CORE::close($self->{fh});
1057 die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
1058 }
1059 }
1060
10611700ns $self->start_ssl($host) if $scheme eq 'https';
1062
106311µs $self->{scheme} = $scheme;
10641700ns $self->{host} = $host;
106514µs $self->{peer} = $peer;
10661700ns $self->{port} = $port;
106711µs $self->{pid} = $$;
106813µs111µs $self->{tid} = _get_tid();
# spent 11µs making 1 call to HTTP::Tiny::Handle::_get_tid
1069
107013µs return $self;
1071}
1072
1073sub start_ssl {
1074 my ($self, $host) = @_;
1075
1076 # As this might be used via CONNECT after an SSL session
1077 # to a proxy, we shut down any existing SSL before attempting
1078 # the handshake
1079 if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
1080 unless ( $self->{fh}->stop_SSL ) {
1081 my $ssl_err = IO::Socket::SSL->errstr;
1082 die(qq/Error halting prior SSL connection: $ssl_err/);
1083 }
1084 }
1085
1086 my $ssl_args = $self->_ssl_args($host);
1087 IO::Socket::SSL->start_SSL(
1088 $self->{fh},
1089 %$ssl_args,
1090 SSL_create_ctx_callback => sub {
1091 my $ctx = shift;
1092 Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
1093 },
1094 );
1095
1096 unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
1097 my $ssl_err = IO::Socket::SSL->errstr;
1098 die(qq/SSL connection failed for $host: $ssl_err\n/);
1099 }
1100}
1101
1102sub close {
1103 @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
1104 my ($self) = @_;
1105 CORE::close($self->{fh})
1106 or die(qq/Could not close socket: '$!'\n/);
1107}
1108
1109
# spent 169µs (70+99) within HTTP::Tiny::Handle::write which was called 2 times, avg 85µs/call: # 2 times (70µs+99µs) by HTTP::Tiny::Handle::write_header_lines at line 1333, avg 85µs/call
sub write {
111021µs @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
111122µs my ($self, $buf) = @_;
1112
111322µs if ( $] ge '5.008' ) {
111427µs22µs utf8::downgrade($buf, 1)
# spent 2µs making 2 calls to utf8::downgrade, avg 750ns/call
1115 or die(qq/Wide character in write()\n/);
1116 }
1117
111821µs my $len = length $buf;
11192800ns my $off = 0;
1120
1121219µs local $SIG{PIPE} = 'IGNORE';
1122
11232400ns while () {
112425µs250µs $self->can_write
# spent 50µs making 2 calls to HTTP::Tiny::Handle::can_write, avg 25µs/call
1125 or die(qq/Timed out while waiting for socket to become ready for writing\n/);
1126262µs248µs my $r = syswrite($self->{fh}, $buf, $len, $off);
# spent 48µs making 2 calls to HTTP::Tiny::Handle::CORE:syswrite, avg 24µs/call
112721µs if (defined $r) {
112821µs $len -= $r;
11292800ns $off += $r;
113022µs last unless $len > 0;
1131 }
1132 elsif ($! == EPIPE) {
1133 die(qq/Socket closed by remote server: $!\n/);
1134 }
1135 elsif ($! != EINTR) {
1136 if ($self->{fh}->can('errstr')){
1137 my $err = $self->{fh}->errstr();
1138 die (qq/Could not write to SSL socket: '$err'\n /);
1139 }
1140 else {
1141 die(qq/Could not write to socket: '$!'\n/);
1142 }
1143
1144 }
1145 }
1146214µs return $off;
1147}
1148
1149sub read {
1150 @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
1151 my ($self, $len, $allow_partial) = @_;
1152
1153 my $buf = '';
1154 my $got = length $self->{rbuf};
1155
1156 if ($got) {
1157 my $take = ($got < $len) ? $got : $len;
1158 $buf = substr($self->{rbuf}, 0, $take, '');
1159 $len -= $take;
1160 }
1161
1162 while ($len > 0) {
1163 $self->can_read
1164 or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
1165 my $r = sysread($self->{fh}, $buf, $len, length $buf);
1166 if (defined $r) {
1167 last unless $r;
1168 $len -= $r;
1169 }
1170 elsif ($! != EINTR) {
1171 if ($self->{fh}->can('errstr')){
1172 my $err = $self->{fh}->errstr();
1173 die (qq/Could not read from SSL socket: '$err'\n /);
1174 }
1175 else {
1176 die(qq/Could not read from socket: '$!'\n/);
1177 }
1178 }
1179 }
1180 if ($len && !$allow_partial) {
1181 die(qq/Unexpected end of stream\n/);
1182 }
1183 return $buf;
1184}
1185
1186
# spent 2.86ms (112µs+2.75) within HTTP::Tiny::Handle::readline which was called 8 times, avg 358µs/call: # 6 times (34µs+11µs) by HTTP::Tiny::Handle::read_header_lines at line 1224, avg 7µs/call # 2 times (78µs+2.74ms) by HTTP::Tiny::Handle::read_response_header at line 1463, avg 1.41ms/call
sub readline {
118783µs @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
118882µs my ($self) = @_;
1189
119081µs while () {
11911097µs1028µs if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
# spent 28µs making 10 calls to HTTP::Tiny::Handle::CORE:subst, avg 3µs/call
1192 return $1;
1193 }
119423µs if (length $self->{rbuf} >= $self->{max_line_size}) {
1195 die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
1196 }
1197 $self->can_read
119824µs22.70ms or die(qq/Timed out while waiting for socket to become ready for reading\n/);
# spent 2.70ms making 2 calls to HTTP::Tiny::Handle::can_read, avg 1.35ms/call
1199257µs227µs my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
# spent 27µs making 2 calls to HTTP::Tiny::Handle::CORE:sysread, avg 13µs/call
120024µs if (defined $r) {
120121µs last unless $r;
1202 }
1203 elsif ($! != EINTR) {
1204 if ($self->{fh}->can('errstr')){
1205 my $err = $self->{fh}->errstr();
1206 die (qq/Could not read from SSL socket: '$err'\n /);
1207 }
1208 else {
1209 die(qq/Could not read from socket: '$!'\n/);
1210 }
1211 }
1212 }
1213 die(qq/Unexpected end of stream while looking for line\n/);
1214}
1215
1216
# spent 144µs (84+61) within HTTP::Tiny::Handle::read_header_lines which was called 2 times, avg 72µs/call: # 2 times (84µs+61µs) by HTTP::Tiny::Handle::read_response_header at line 1474, avg 72µs/call
sub read_header_lines {
121722µs @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
121822µs my ($self, $headers) = @_;
121923µs $headers ||= {};
122021µs my $lines = 0;
12212500ns my $val;
1222
12232700ns while () {
1224610µs645µs my $line = $self->readline;
# spent 45µs making 6 calls to HTTP::Tiny::Handle::readline, avg 7µs/call
1225
1226644µs1016µs if (++$lines >= $self->{max_header_lines}) {
# spent 16µs making 10 calls to HTTP::Tiny::Handle::CORE:match, avg 2µs/call
1227 die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
1228 }
1229 elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
123049µs my ($field_name) = lc $1;
123144µs if (exists $headers->{$field_name}) {
1232 for ($headers->{$field_name}) {
1233 $_ = [$_] unless ref $_ eq "ARRAY";
1234 push @$_, $2;
1235 $val = \$_->[-1];
1236 }
1237 }
1238 else {
123948µs $val = \($headers->{$field_name} = $2);
1240 }
1241 }
1242 elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
1243 $val
1244 or die(qq/Unexpected header continuation line\n/);
1245 next unless length $1;
1246 $$val .= ' ' if length $$val;
1247 $$val .= $1;
1248 }
1249 elsif ($line =~ /\A \x0D?\x0A \z/x) {
125022µs last;
1251 }
1252 else {
1253 die(q/Malformed header line: / . $Printable->($line) . "\n");
1254 }
1255 }
1256210µs return $headers;
1257}
1258
1259
# spent 318µs (18+301) within HTTP::Tiny::Handle::write_request which was called 2 times, avg 159µs/call: # 2 times (18µs+301µs) by HTTP::Tiny::_request at line 613, avg 159µs/call
sub write_request {
126021µs @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
12612900ns my($self, $request) = @_;
1262210µs2301µs $self->write_request_header(@{$request}{qw/method uri headers header_case/});
# spent 301µs making 2 calls to HTTP::Tiny::Handle::write_request_header, avg 150µs/call
126322µs $self->write_body($request) if $request->{cb};
126425µs return;
1265}
1266
1267# Standard request header names/case from HTTP/1.1 RFCs
126814µsmy @rfc_request_headers = qw(
1269 Accept Accept-Charset Accept-Encoding Accept-Language Authorization
1270 Cache-Control Connection Content-Length Expect From Host
1271 If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
1272 Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer
1273 Transfer-Encoding Upgrade User-Agent Via
1274);
1275
127611µsmy @other_request_headers = qw(
1277 Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin
1278 X-XSS-Protection
1279);
1280
1281127µsmy %HeaderCase = map { lc($_) => $_ } @rfc_request_headers, @other_request_headers;
1282
1283# to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
1284# combine writes.
1285
# spent 285µs (87+198) within HTTP::Tiny::Handle::write_header_lines which was called 2 times, avg 143µs/call: # 2 times (87µs+198µs) by HTTP::Tiny::Handle::write_request_header at line 1485, avg 143µs/call
sub write_header_lines {
128624µs (@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n");
128722µs my($self, $headers, $header_case, $prefix_data) = @_;
128822µs $header_case ||= {};
1289
129021µs my $buf = (defined $prefix_data ? $prefix_data : '');
1291
1292 # Per RFC, control fields should be listed first
12932600ns my %seen;
129425µs for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) {
1295144µs next unless exists $headers->{$k};
129622µs $seen{$k}++;
129722µs my $field_name = $HeaderCase{$k};
129821µs my $v = $headers->{$k};
129923µs for (ref $v eq 'ARRAY' ? @$v : $v) {
13002400ns $_ = '' unless defined $_;
130123µs $buf .= "$field_name: $_\x0D\x0A";
1302 }
1303 }
1304
1305 # Other headers sent in arbitrary order
130628µs while (my ($k, $v) = each %$headers) {
130742µs my $field_name = lc $k;
130842µs next if $seen{$field_name};
130922µs if (exists $HeaderCase{$field_name}) {
1310 $field_name = $HeaderCase{$field_name};
1311 }
1312 else {
1313 if (exists $header_case->{$field_name}) {
1314 $field_name = $header_case->{$field_name};
1315 }
1316 else {
1317 $field_name =~ s/\b(\w)/\u$1/g;
1318 }
1319 $field_name =~ /\A $Token+ \z/xo
1320 or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
1321 $HeaderCase{lc $field_name} = $field_name;
1322 }
132323µs for (ref $v eq 'ARRAY' ? @$v : $v) {
1324 # unwrap a field value if pre-wrapped by user
1325211µs22µs s/\x0D?\x0A\s+/ /g;
# spent 2µs making 2 calls to HTTP::Tiny::Handle::CORE:subst, avg 1µs/call
1326242µs426µs die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n")
# spent 20µs making 2 calls to HTTP::Tiny::Handle::CORE:regcomp, avg 10µs/call # spent 6µs making 2 calls to HTTP::Tiny::Handle::CORE:match, avg 3µs/call
1327 unless $_ eq '' || /\A $Field_Content \z/xo;
13282700ns $_ = '' unless defined $_;
132925µs $buf .= "$field_name: $_\x0D\x0A";
1330 }
1331 }
133221µs $buf .= "\x0D\x0A";
1333212µs2169µs return $self->write($buf);
# spent 169µs making 2 calls to HTTP::Tiny::Handle::write, avg 85µs/call
1334}
1335
1336# return value indicates whether message length was defined; this is generally
1337# true unless there was no content-length header and we just read until EOF.
1338# Other message length errors are thrown as exceptions
1339sub read_body {
1340 @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
1341 my ($self, $cb, $response) = @_;
1342 my $te = $response->{headers}{'transfer-encoding'} || '';
1343 my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
1344 return $chunked
1345 ? $self->read_chunked_body($cb, $response)
1346 : $self->read_content_body($cb, $response);
1347}
1348
1349sub write_body {
1350 @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
1351 my ($self, $request) = @_;
1352 if ($request->{headers}{'content-length'}) {
1353 return $self->write_content_body($request);
1354 }
1355 else {
1356 return $self->write_chunked_body($request);
1357 }
1358}
1359
1360sub read_content_body {
1361 @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
1362 my ($self, $cb, $response, $content_length) = @_;
1363 $content_length ||= $response->{headers}{'content-length'};
1364
1365 if ( defined $content_length ) {
1366 my $len = $content_length;
1367 while ($len > 0) {
1368 my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
1369 $cb->($self->read($read, 0), $response);
1370 $len -= $read;
1371 }
1372 return length($self->{rbuf}) == 0;
1373 }
1374
1375 my $chunk;
1376 $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
1377
1378 return;
1379}
1380
1381sub write_content_body {
1382 @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
1383 my ($self, $request) = @_;
1384
1385 my ($len, $content_length) = (0, $request->{headers}{'content-length'});
1386 while () {
1387 my $data = $request->{cb}->();
1388
1389 defined $data && length $data
1390 or last;
1391
1392 if ( $] ge '5.008' ) {
1393 utf8::downgrade($data, 1)
1394 or die(qq/Wide character in write_content()\n/);
1395 }
1396
1397 $len += $self->write($data);
1398 }
1399
1400 $len == $content_length
1401 or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
1402
1403 return $len;
1404}
1405
1406sub read_chunked_body {
1407 @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
1408 my ($self, $cb, $response) = @_;
1409
1410 while () {
1411 my $head = $self->readline;
1412
1413 $head =~ /\A ([A-Fa-f0-9]+)/x
1414 or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
1415
1416 my $len = hex($1)
1417 or last;
1418
1419 $self->read_content_body($cb, $response, $len);
1420
1421 $self->read(2) eq "\x0D\x0A"
1422 or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
1423 }
1424 $self->read_header_lines($response->{headers});
1425 return 1;
1426}
1427
1428sub write_chunked_body {
1429 @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
1430 my ($self, $request) = @_;
1431
1432 my $len = 0;
1433 while () {
1434 my $data = $request->{cb}->();
1435
1436 defined $data && length $data
1437 or last;
1438
1439 if ( $] ge '5.008' ) {
1440 utf8::downgrade($data, 1)
1441 or die(qq/Wide character in write_chunked_body()\n/);
1442 }
1443
1444 $len += length $data;
1445
1446 my $chunk = sprintf '%X', length $data;
1447 $chunk .= "\x0D\x0A";
1448 $chunk .= $data;
1449 $chunk .= "\x0D\x0A";
1450
1451 $self->write($chunk);
1452 }
1453 $self->write("0\x0D\x0A");
1454 $self->write_header_lines($request->{trailer_cb}->())
1455 if ref $request->{trailer_cb} eq 'CODE';
1456 return $len;
1457}
1458
1459
# spent 3.04ms (64µs+2.98) within HTTP::Tiny::Handle::read_response_header which was called 2 times, avg 1.52ms/call: # 2 times (64µs+2.98ms) by HTTP::Tiny::_request at line 616, avg 1.52ms/call
sub read_response_header {
146021µs @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
146121µs my ($self) = @_;
1462
146325µs22.82ms my $line = $self->readline;
# spent 2.82ms making 2 calls to HTTP::Tiny::Handle::readline, avg 1.41ms/call
1464
1465218µs29µs $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
# spent 9µs making 2 calls to HTTP::Tiny::Handle::CORE:match, avg 4µs/call
1466 or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
1467
146829µs my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
1469
1470211µs25µs die (qq/Unsupported HTTP protocol: $protocol\n/)
# spent 5µs making 2 calls to HTTP::Tiny::Handle::CORE:match, avg 2µs/call
1471 unless $version =~ /0*1\.0*[01]/;
1472
1473 return {
1474226µs2144µs status => $status,
# spent 144µs making 2 calls to HTTP::Tiny::Handle::read_header_lines, avg 72µs/call
1475 reason => $reason,
1476 headers => $self->read_header_lines,
1477 protocol => $protocol,
1478 };
1479}
1480
1481
# spent 301µs (15+285) within HTTP::Tiny::Handle::write_request_header which was called 2 times, avg 150µs/call: # 2 times (15µs+285µs) by HTTP::Tiny::Handle::write_request at line 1262, avg 150µs/call
sub write_request_header {
14822900ns @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n");
148322µs my ($self, $method, $request_uri, $headers, $header_case) = @_;
1484
1485211µs2285µs return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A");
# spent 285µs making 2 calls to HTTP::Tiny::Handle::write_header_lines, avg 143µs/call
1486}
1487
1488
# spent 2.72ms (91µs+2.63) within HTTP::Tiny::Handle::_do_timeout which was called 5 times, avg 544µs/call: # 3 times (65µs+2.62ms) by HTTP::Tiny::Handle::can_read at line 1525, avg 895µs/call # 2 times (26µs+8µs) by HTTP::Tiny::Handle::can_write at line 1531, avg 17µs/call
sub _do_timeout {
148953µs my ($self, $type, $timeout) = @_;
149054µs $timeout = $self->{timeout}
1491 unless defined $timeout && $timeout >= 0;
1492
149354µs my $fd = fileno $self->{fh};
149452µs defined $fd && $fd >= 0
1495 or die(qq/select(2): 'Bad file descriptor'\n/);
1496
149752µs my $initial = time;
149851µs my $pending = $timeout;
14995600ns my $nfound;
1500
150159µs vec(my $fdset = '', $fd, 1) = 1;
1502
15035900ns while () {
150452.67ms52.63ms $nfound = ($type eq 'read')
# spent 2.63ms making 5 calls to HTTP::Tiny::Handle::CORE:sselect, avg 525µs/call
1505 ? select($fdset, undef, undef, $pending)
1506 : select(undef, $fdset, undef, $pending) ;
150753µs if ($nfound == -1) {
1508 $! == EINTR
1509 or die(qq/select(2): '$!'\n/);
1510 redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
1511 $nfound = 0;
1512 }
151355µs last;
1514 }
151556µs $! = 0;
1516537µs return $nfound;
1517}
1518
1519
# spent 2.72ms (35µs+2.68) within HTTP::Tiny::Handle::can_read which was called 3 times, avg 906µs/call: # 2 times (28µs+2.67ms) by HTTP::Tiny::Handle::readline at line 1198, avg 1.35ms/call # once (7µs+17µs) by HTTP::Tiny::Handle::can_reuse at line 1549
sub can_read {
152032µs @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
152131µs my $self = shift;
152233µs if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
1523 return 1 if $self->{fh}->pending;
1524 }
1525322µs32.68ms return $self->_do_timeout('read', @_)
# spent 2.68ms making 3 calls to HTTP::Tiny::Handle::_do_timeout, avg 895µs/call
1526}
1527
1528
# spent 50µs (16+34) within HTTP::Tiny::Handle::can_write which was called 2 times, avg 25µs/call: # 2 times (16µs+34µs) by HTTP::Tiny::Handle::write at line 1124, avg 25µs/call
sub can_write {
152921µs @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
153021µs my $self = shift;
153128µs234µs return $self->_do_timeout('write', @_)
# spent 34µs making 2 calls to HTTP::Tiny::Handle::_do_timeout, avg 17µs/call
1532}
1533
1534sub _assert_ssl {
1535 my($ok, $reason) = HTTP::Tiny->can_ssl();
1536 die $reason unless $ok;
1537}
1538
1539
# spent 54µs (20+34) within HTTP::Tiny::Handle::can_reuse which was called: # once (20µs+34µs) by HTTP::Tiny::_request at line 605
sub can_reuse {
154011µs my ($self,$scheme,$host,$port,$peer) = @_;
1541 return 0 if
1542 $self->{pid} != $$
1543 || $self->{tid} != _get_tid()
1544 || length($self->{rbuf})
1545 || $scheme ne $self->{scheme}
1546 || $host ne $self->{host}
1547 || $port ne $self->{port}
1548 || $peer ne $self->{peer}
1549214µs234µs || eval { $self->can_read(0) }
# spent 24µs making 1 call to HTTP::Tiny::Handle::can_read # spent 10µs making 1 call to HTTP::Tiny::Handle::_get_tid
1550 || $@ ;
155114µs return 1;
1552}
1553
1554# Try to find a CA bundle to validate the SSL cert,
1555# prefer Mozilla::CA or fallback to a system file
1556sub _find_CA_file {
1557 my $self = shift();
1558
1559 my $ca_file =
1560 defined( $self->{SSL_options}->{SSL_ca_file} )
1561 ? $self->{SSL_options}->{SSL_ca_file}
1562 : $ENV{SSL_CERT_FILE};
1563
1564 if ( defined $ca_file ) {
1565 unless ( -r $ca_file ) {
1566 die qq/SSL_ca_file '$ca_file' not found or not readable\n/;
1567 }
1568 return $ca_file;
1569 }
1570
1571 return Mozilla::CA::SSL_ca_file()
1572 if eval { require Mozilla::CA; 1 };
1573
1574 # cert list copied from golang src/crypto/x509/root_unix.go
1575 foreach my $ca_bundle (
1576 "/etc/ssl/certs/ca-certificates.crt", # Debian/Ubuntu/Gentoo etc.
1577 "/etc/pki/tls/certs/ca-bundle.crt", # Fedora/RHEL
1578 "/etc/ssl/ca-bundle.pem", # OpenSUSE
1579 "/etc/openssl/certs/ca-certificates.crt", # NetBSD
1580 "/etc/ssl/cert.pem", # OpenBSD
1581 "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly
1582 "/etc/pki/tls/cacert.pem", # OpenELEC
1583 "/etc/certs/ca-certificates.crt", # Solaris 11.2+
1584 ) {
1585 return $ca_bundle if -e $ca_bundle;
1586 }
1587
1588 die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
1589 . qq/Try installing Mozilla::CA from CPAN\n/;
1590}
1591
1592# for thread safety, we need to know thread id if threads are loaded
1593
# spent 21µs (17+4) within HTTP::Tiny::Handle::_get_tid which was called 2 times, avg 10µs/call: # once (10µs+2µs) by HTTP::Tiny::Handle::connect at line 1068 # once (7µs+3µs) by HTTP::Tiny::Handle::can_reuse at line 1549
sub _get_tid {
15942246µs236µs
# spent 24µs (12+12) within HTTP::Tiny::Handle::BEGIN@1594 which was called: # once (12µs+12µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 1594
no warnings 'reserved'; # for 'threads'
# spent 24µs making 1 call to HTTP::Tiny::Handle::BEGIN@1594 # spent 12µs making 1 call to warnings::unimport
1595224µs24µs return threads->can("tid") ? threads->tid : 0;
# spent 4µs making 2 calls to UNIVERSAL::can, avg 2µs/call
1596}
1597
1598sub _ssl_args {
1599 my ($self, $host) = @_;
1600
1601 my %ssl_args;
1602
1603 # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
1604 # added until IO::Socket::SSL 1.84
1605 if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
1606 $ssl_args{SSL_hostname} = $host, # Sane SNI support
1607 }
1608
1609 if ($self->{verify_SSL}) {
1610 $ssl_args{SSL_verifycn_scheme} = 'http'; # enable CN validation
1611 $ssl_args{SSL_verifycn_name} = $host; # set validation hostname
1612 $ssl_args{SSL_verify_mode} = 0x01; # enable cert validation
1613 $ssl_args{SSL_ca_file} = $self->_find_CA_file;
1614 }
1615 else {
1616 $ssl_args{SSL_verifycn_scheme} = 'none'; # disable CN validation
1617 $ssl_args{SSL_verify_mode} = 0x00; # disable cert validation
1618 }
1619
1620 # user options override settings from verify_SSL
1621 for my $k ( keys %{$self->{SSL_options}} ) {
1622 $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
1623 }
1624
1625 return \%ssl_args;
1626}
1627
1628124µs1;
1629
1630__END__
 
# spent 13µs within HTTP::Tiny::CORE:match which was called 7 times, avg 2µs/call: # 2 times (8µs+0s) by HTTP::Tiny::_split_url at line 901, avg 4µs/call # 2 times (2µs+0s) by HTTP::Tiny::_split_url at line 905, avg 1µs/call # 2 times (1µs+0s) by HTTP::Tiny::_maybe_redirect at line 885, avg 700ns/call # once (600ns+0s) by HTTP::Tiny::agent at line 91
sub HTTP::Tiny::CORE:match; # opcode
# spent 3µs within HTTP::Tiny::CORE:qr which was called: # once (3µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 960
sub HTTP::Tiny::CORE:qr; # opcode
# spent 7µs within HTTP::Tiny::CORE:subst which was called 3 times, avg 2µs/call: # 2 times (4µs+0s) by HTTP::Tiny::_split_url at line 916, avg 2µs/call # once (3µs+0s) by HTTP::Tiny::_agent at line 579
sub HTTP::Tiny::CORE:subst; # opcode
# spent 2µs within HTTP::Tiny::Handle::CORE:binmode which was called: # once (2µs+0s) by HTTP::Tiny::Handle::connect at line 1051
sub HTTP::Tiny::Handle::CORE:binmode; # opcode
# spent 35µs within HTTP::Tiny::Handle::CORE:match which was called 16 times, avg 2µs/call: # 10 times (16µs+0s) by HTTP::Tiny::Handle::read_header_lines at line 1226, avg 2µs/call # 2 times (9µs+0s) by HTTP::Tiny::Handle::read_response_header at line 1465, avg 4µs/call # 2 times (6µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1326, avg 3µs/call # 2 times (5µs+0s) by HTTP::Tiny::Handle::read_response_header at line 1470, avg 2µs/call
sub HTTP::Tiny::Handle::CORE:match; # opcode
# spent 2µs within HTTP::Tiny::Handle::CORE:qr which was called 2 times, avg 1µs/call: # once (2µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 1004 # once (800ns+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@8 at line 1005
sub HTTP::Tiny::Handle::CORE:qr; # opcode
# spent 20µs within HTTP::Tiny::Handle::CORE:regcomp which was called 2 times, avg 10µs/call: # 2 times (20µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1326, avg 10µs/call
sub HTTP::Tiny::Handle::CORE:regcomp; # opcode
# spent 2.63ms within HTTP::Tiny::Handle::CORE:sselect which was called 5 times, avg 525µs/call: # 5 times (2.63ms+0s) by HTTP::Tiny::Handle::_do_timeout at line 1504, avg 525µs/call
sub HTTP::Tiny::Handle::CORE:sselect; # opcode
# spent 30µs within HTTP::Tiny::Handle::CORE:subst which was called 12 times, avg 3µs/call: # 10 times (28µs+0s) by HTTP::Tiny::Handle::readline at line 1191, avg 3µs/call # 2 times (2µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1325, avg 1µs/call
sub HTTP::Tiny::Handle::CORE:subst; # opcode
# spent 27µs within HTTP::Tiny::Handle::CORE:sysread which was called 2 times, avg 13µs/call: # 2 times (27µs+0s) by HTTP::Tiny::Handle::readline at line 1199, avg 13µs/call
sub HTTP::Tiny::Handle::CORE:sysread; # opcode
# spent 48µs within HTTP::Tiny::Handle::CORE:syswrite which was called 2 times, avg 24µs/call: # 2 times (48µs+0s) by HTTP::Tiny::Handle::write at line 1126, avg 24µs/call
sub HTTP::Tiny::Handle::CORE:syswrite; # opcode