Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm |
Statements | Executed 556813 statements in 18.6s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5004 | 1 | 1 | 17.3s | 17.3s | CORE:sselect (opcode) | HTTP::Tiny::Handle::
2002 | 1 | 1 | 142ms | 19.3s | _request | HTTP::Tiny::
2002 | 1 | 1 | 104ms | 150ms | read_header_lines | HTTP::Tiny::Handle::
3002 | 2 | 1 | 75.7ms | 195ms | write | HTTP::Tiny::Handle::
9008 | 2 | 1 | 73.1ms | 17.4s | readline | HTTP::Tiny::Handle::
5004 | 2 | 1 | 72.0ms | 17.3s | _do_timeout | HTTP::Tiny::Handle::
2002 | 1 | 1 | 70.4ms | 953ms | connect | HTTP::Tiny::Handle::
3002 | 1 | 1 | 53.7ms | 53.7ms | CORE:syswrite (opcode) | HTTP::Tiny::Handle::
2002 | 1 | 1 | 44.4ms | 17.6s | read_response_header | HTTP::Tiny::Handle::
2002 | 1 | 1 | 42.6ms | 198ms | write_header_lines | HTTP::Tiny::Handle::
2002 | 1 | 1 | 41.3ms | 42.8ms | _prepare_headers_and_cb | HTTP::Tiny::
2002 | 1 | 1 | 38.6ms | 38.6ms | __ANON__[:85] | HTTP::Tiny::
1000 | 1 | 1 | 37.0ms | 82.5ms | write_content_body | HTTP::Tiny::Handle::
2002 | 1 | 1 | 36.7ms | 48.6ms | _split_url | HTTP::Tiny::
2002 | 1 | 1 | 29.9ms | 1.00s | _open_handle | HTTP::Tiny::
2002 | 1 | 1 | 29.7ms | 19.3s | request | HTTP::Tiny::
1001 | 1 | 1 | 28.8ms | 65.8ms | new | HTTP::Tiny::
2002 | 1 | 1 | 27.7ms | 17.3s | can_read | HTTP::Tiny::Handle::
2002 | 1 | 1 | 26.1ms | 27.3ms | _maybe_redirect | HTTP::Tiny::
1001 | 1 | 1 | 25.8ms | 38.5ms | read_content_body | HTTP::Tiny::Handle::
3002 | 1 | 1 | 24.9ms | 64.9ms | can_write | HTTP::Tiny::Handle::
11014 | 2 | 1 | 24.7ms | 24.7ms | CORE:subst (opcode) | HTTP::Tiny::Handle::
16019 | 5 | 1 | 22.4ms | 22.4ms | CORE:match (opcode) | HTTP::Tiny::Handle::
2002 | 1 | 1 | 22.1ms | 22.1ms | new | HTTP::Tiny::Handle::
2002 | 1 | 1 | 20.7ms | 24.0ms | _get_tid | HTTP::Tiny::Handle::
2002 | 1 | 1 | 18.2ms | 18.2ms | CORE:sysread (opcode) | HTTP::Tiny::Handle::
1001 | 1 | 1 | 16.3ms | 55.1ms | read_body | HTTP::Tiny::Handle::
2002 | 1 | 1 | 15.4ms | 312ms | write_request | HTTP::Tiny::Handle::
1001 | 1 | 1 | 13.0ms | 13.0ms | _set_proxies | HTTP::Tiny::
2002 | 1 | 1 | 10.7ms | 208ms | write_request_header | HTTP::Tiny::Handle::
8008 | 5 | 1 | 10.1ms | 10.1ms | CORE:match (opcode) | HTTP::Tiny::
1001 | 1 | 1 | 9.88ms | 9.88ms | _prepare_data_cb | HTTP::Tiny::
1001 | 1 | 1 | 9.80ms | 9.80ms | read | HTTP::Tiny::Handle::
1001 | 1 | 1 | 9.16ms | 18.1ms | _agent | HTTP::Tiny::
1000 | 1 | 1 | 5.67ms | 88.1ms | write_body | HTTP::Tiny::Handle::
3003 | 2 | 1 | 5.55ms | 5.55ms | CORE:subst (opcode) | HTTP::Tiny::
1001 | 1 | 1 | 5.40ms | 5.88ms | agent | HTTP::Tiny::
2000 | 1 | 1 | 4.50ms | 4.50ms | __ANON__[:692] | HTTP::Tiny::
1001 | 1 | 1 | 2.92ms | 2.92ms | __ANON__[:734] | HTTP::Tiny::
2002 | 1 | 1 | 2.84ms | 2.84ms | CORE:binmode (opcode) | HTTP::Tiny::Handle::
1 | 1 | 1 | 2.63ms | 13.6ms | BEGIN@866 | HTTP::Tiny::Handle::
1 | 1 | 1 | 446µs | 710µs | BEGIN@865 | HTTP::Tiny::Handle::
1 | 1 | 1 | 28µs | 28µs | BEGIN@66 | HTTP::Tiny::
1 | 1 | 1 | 24µs | 24µs | CORE:regcomp (opcode) | HTTP::Tiny::Handle::
1 | 1 | 1 | 17µs | 34µs | BEGIN@1418 | HTTP::Tiny::Handle::
1 | 1 | 1 | 9µs | 11µs | BEGIN@853 | HTTP::Tiny::
1 | 1 | 1 | 8µs | 9µs | BEGIN@3 | HTTP::Tiny::
1 | 1 | 1 | 7µs | 8µs | BEGIN@862 | HTTP::Tiny::Handle::
11 | 1 | 1 | 7µs | 7µs | CORE:substcont (opcode) | HTTP::Tiny::Handle::
1 | 1 | 1 | 6µs | 29µs | BEGIN@863 | HTTP::Tiny::Handle::
1 | 1 | 1 | 5µs | 12µs | BEGIN@195 | HTTP::Tiny::
1 | 1 | 1 | 4µs | 14µs | BEGIN@75 | HTTP::Tiny::
1 | 1 | 1 | 4µs | 11µs | BEGIN@76 | HTTP::Tiny::
1 | 1 | 1 | 4µs | 6µs | BEGIN@4 | HTTP::Tiny::
1 | 1 | 1 | 2µs | 2µs | BEGIN@9 | HTTP::Tiny::
1 | 1 | 1 | 2µs | 2µs | CORE:qr (opcode) | HTTP::Tiny::
1 | 1 | 1 | 900ns | 900ns | CORE:qr (opcode) | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | __ANON__[:885] | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | __ANON__[:957] | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | _assert_ssl | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | _find_CA_file | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | _ssl_args | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | can_reuse | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | close | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | read_chunked_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | start_ssl | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | write_chunked_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | __ANON__[:284] | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:731] | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _add_basic_auth_header | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _create_proxy_tunnel | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _http_date | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _parse_http_date | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _proxy_connect | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _split_proxy | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _update_cookie_jar | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _uri_escape | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | _validate_cookie_jar | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | mirror | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | post_form | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | www_form_urlencode | HTTP::Tiny::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # vim: ts=4 sts=4 sw=4 et: | ||||
2 | package HTTP::Tiny; | ||||
3 | 2 | 13µs | 2 | 10µs | # spent 9µs (8+1) within HTTP::Tiny::BEGIN@3 which was called:
# once (8µs+1µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 3 # spent 9µs making 1 call to HTTP::Tiny::BEGIN@3
# spent 1µs making 1 call to strict::import |
4 | 2 | 19µs | 2 | 9µs | # spent 6µs (4+3) within HTTP::Tiny::BEGIN@4 which was called:
# once (4µs+3µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 4 # spent 6µs making 1 call to HTTP::Tiny::BEGIN@4
# spent 3µs making 1 call to warnings::import |
5 | # ABSTRACT: A small, simple, correct HTTP/1.1 client | ||||
6 | |||||
7 | 1 | 400ns | our $VERSION = '0.054'; | ||
8 | |||||
9 | 2 | 56µs | 1 | 2µs | # spent 2µs within HTTP::Tiny::BEGIN@9 which was called:
# once (2µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 9 # spent 2µ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> — | ||||
19 | #pod A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended. | ||||
20 | #pod * C<cookie_jar> — | ||||
21 | #pod An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods | ||||
22 | #pod * C<default_headers> — | ||||
23 | #pod A hashref of default headers to apply to requests | ||||
24 | #pod * C<local_address> — | ||||
25 | #pod The local IP address to bind to | ||||
26 | #pod * C<keep_alive> — | ||||
27 | #pod Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) | ||||
28 | #pod * C<max_redirect> — | ||||
29 | #pod Maximum number of redirects allowed (defaults to 5) | ||||
30 | #pod * C<max_size> — | ||||
31 | #pod Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. | ||||
32 | #pod * C<http_proxy> — | ||||
33 | #pod URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set) | ||||
34 | #pod * C<https_proxy> — | ||||
35 | #pod URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set) | ||||
36 | #pod * C<proxy> — | ||||
37 | #pod URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set) | ||||
38 | #pod * C<no_proxy> — | ||||
39 | #pod List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —) | ||||
40 | #pod * C<timeout> — | ||||
41 | #pod Request timeout in seconds (default is 60) | ||||
42 | #pod * C<verify_SSL> — | ||||
43 | #pod A boolean that indicates whether to validate the SSL certificate of an C<https> — | ||||
44 | #pod connection (default is false) | ||||
45 | #pod * C<SSL_options> — | ||||
46 | #pod A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL> | ||||
47 | #pod | ||||
48 | #pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will | ||||
49 | #pod prevent getting the corresponding proxies from the environment. | ||||
50 | #pod | ||||
51 | #pod Exceptions from C<max_size>, C<timeout> or other errors will result in a | ||||
52 | #pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The | ||||
53 | #pod content field in the response will contain the text of the exception. | ||||
54 | #pod | ||||
55 | #pod The C<keep_alive> parameter enables a persistent connection, but only to a | ||||
56 | #pod single destination scheme, host and port. Also, if any connection-relevant | ||||
57 | #pod attributes are modified, or if the process ID or thread ID change, the | ||||
58 | #pod persistent connection will be dropped. If you want persistent connections | ||||
59 | #pod across multiple destinations, use multiple HTTP::Tiny objects. | ||||
60 | #pod | ||||
61 | #pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes. | ||||
62 | #pod | ||||
63 | #pod =cut | ||||
64 | |||||
65 | 1 | 200ns | my @attributes; | ||
66 | # spent 28µs within HTTP::Tiny::BEGIN@66 which was called:
# once (28µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 87 | ||||
67 | 1 | 1µs | @attributes = qw( | ||
68 | cookie_jar default_headers http_proxy https_proxy keep_alive | ||||
69 | local_address max_redirect max_size proxy no_proxy timeout | ||||
70 | SSL_options verify_SSL | ||||
71 | ); | ||||
72 | 1 | 3µs | my %persist_ok = map {; $_ => 1 } qw( | ||
73 | cookie_jar default_headers max_redirect max_size | ||||
74 | ); | ||||
75 | 2 | 15µs | 2 | 23µs | # spent 14µs (4+10) within HTTP::Tiny::BEGIN@75 which was called:
# once (4µs+10µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 75 # spent 14µs making 1 call to HTTP::Tiny::BEGIN@75
# spent 10µs making 1 call to strict::unimport |
76 | 2 | 60µs | 2 | 19µs | # spent 11µs (4+7) within HTTP::Tiny::BEGIN@76 which was called:
# once (4µs+7µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 76 # spent 11µs making 1 call to HTTP::Tiny::BEGIN@76
# spent 7µs making 1 call to warnings::unimport |
77 | 1 | 3µs | for my $accessor ( @attributes ) { | ||
78 | # spent 38.6ms within HTTP::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm:85] which was called 2002 times, avg 19µs/call:
# 2002 times (38.6ms+0s) by Search::Elasticsearch::Cxn::HTTPTiny::perform_request at line 32 of Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 19µs/call | ||||
79 | @_ > 1 | ||||
80 | ? do { | ||||
81 | 2002 | 32.8ms | delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor}; | ||
82 | 2002 | 1.81ms | $_[0]->{$accessor} = $_[1] | ||
83 | } | ||||
84 | 2002 | 26.1ms | : $_[0]->{$accessor}; | ||
85 | 13 | 22µs | }; | ||
86 | } | ||||
87 | 1 | 251µs | 1 | 28µs | } # spent 28µs making 1 call to HTTP::Tiny::BEGIN@66 |
88 | |||||
89 | # spent 5.88ms (5.40+481µs) within HTTP::Tiny::agent which was called 1001 times, avg 6µs/call:
# 1001 times (5.40ms+481µs) by HTTP::Tiny::new at line 117, avg 6µs/call | ||||
90 | 1001 | 508µs | my($self, $agent) = @_; | ||
91 | 1001 | 821µs | if( @_ > 1 ){ | ||
92 | $self->{agent} = | ||||
93 | 1001 | 3.15ms | 1001 | 481µs | (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent; # spent 481µs making 1001 calls to HTTP::Tiny::CORE:match, avg 481ns/call |
94 | } | ||||
95 | 1001 | 1.88ms | return $self->{agent}; | ||
96 | } | ||||
97 | |||||
98 | # spent 65.8ms (28.8+37.0) within HTTP::Tiny::new which was called 1001 times, avg 66µs/call:
# 1001 times (28.8ms+37.0ms) by Search::Elasticsearch::Cxn::HTTPTiny::_build_handle at line 69 of Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 66µs/call | ||||
99 | 1001 | 889µs | my($class, %args) = @_; | ||
100 | |||||
101 | my $self = { | ||||
102 | max_redirect => 5, | ||||
103 | timeout => 60, | ||||
104 | keep_alive => 1, | ||||
105 | verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default | ||||
106 | no_proxy => $ENV{no_proxy}, | ||||
107 | 1001 | 4.53ms | }; | ||
108 | |||||
109 | 1001 | 572µs | bless $self, $class; | ||
110 | |||||
111 | 1001 | 498µs | $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar}; | ||
112 | |||||
113 | 1001 | 895µs | for my $key ( @attributes ) { | ||
114 | 13013 | 4.96ms | $self->{$key} = $args{$key} if exists $args{$key} | ||
115 | } | ||||
116 | |||||
117 | 1001 | 4.76ms | 2002 | 24.0ms | $self->agent( exists $args{agent} ? $args{agent} : $class->_agent ); # spent 18.1ms making 1001 calls to HTTP::Tiny::_agent, avg 18µs/call
# spent 5.88ms making 1001 calls to HTTP::Tiny::agent, avg 6µs/call |
118 | |||||
119 | 1001 | 1.83ms | 1001 | 13.0ms | $self->_set_proxies; # spent 13.0ms making 1001 calls to HTTP::Tiny::_set_proxies, avg 13µs/call |
120 | |||||
121 | 1001 | 8.16ms | return $self; | ||
122 | } | ||||
123 | |||||
124 | # spent 13.0ms within HTTP::Tiny::_set_proxies which was called 1001 times, avg 13µs/call:
# 1001 times (13.0ms+0s) by HTTP::Tiny::new at line 119, avg 13µs/call | ||||
125 | 1001 | 432µs | my ($self) = @_; | ||
126 | |||||
127 | # get proxies from %ENV only if not provided; explicit undef will disable | ||||
128 | # getting proxies from the environment | ||||
129 | |||||
130 | # generic proxy | ||||
131 | 1001 | 2.41ms | if (! exists $self->{proxy} ) { | ||
132 | $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY}; | ||||
133 | } | ||||
134 | |||||
135 | 1001 | 751µs | if ( defined $self->{proxy} ) { | ||
136 | $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate | ||||
137 | } | ||||
138 | else { | ||||
139 | 1001 | 597µs | delete $self->{proxy}; | ||
140 | } | ||||
141 | |||||
142 | # http proxy | ||||
143 | 1001 | 525µs | if (! exists $self->{http_proxy} ) { | ||
144 | # under CGI, bypass HTTP_PROXY as request sets it from Proxy header | ||||
145 | 1001 | 699µs | local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD}; | ||
146 | 1001 | 1.26ms | $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy}; | ||
147 | } | ||||
148 | |||||
149 | 1001 | 650µs | if ( defined $self->{http_proxy} ) { | ||
150 | $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate | ||||
151 | $self->{_has_proxy}{http} = 1; | ||||
152 | } | ||||
153 | else { | ||||
154 | 1001 | 280µs | delete $self->{http_proxy}; | ||
155 | } | ||||
156 | |||||
157 | # https proxy | ||||
158 | 1001 | 1.65ms | if (! exists $self->{https_proxy} ) { | ||
159 | $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy}; | ||||
160 | } | ||||
161 | |||||
162 | 1001 | 509µs | if ( $self->{https_proxy} ) { | ||
163 | $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate | ||||
164 | $self->{_has_proxy}{https} = 1; | ||||
165 | } | ||||
166 | else { | ||||
167 | 1001 | 342µs | delete $self->{https_proxy}; | ||
168 | } | ||||
169 | |||||
170 | # Split no_proxy to array reference if not provided as such | ||||
171 | 1001 | 744µs | unless ( ref $self->{no_proxy} eq 'ARRAY' ) { | ||
172 | $self->{no_proxy} = | ||||
173 | 1001 | 1.00ms | (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : []; | ||
174 | } | ||||
175 | |||||
176 | 1001 | 2.24ms | return; | ||
177 | } | ||||
178 | |||||
179 | #pod =method get|head|put|post|delete | ||||
180 | #pod | ||||
181 | #pod $response = $http->get($url); | ||||
182 | #pod $response = $http->get($url, \%options); | ||||
183 | #pod $response = $http->head($url); | ||||
184 | #pod | ||||
185 | #pod These methods are shorthand for calling C<request()> for the given method. The | ||||
186 | #pod URL must have unsafe characters escaped and international domain names encoded. | ||||
187 | #pod See C<request()> for valid options and a description of the response. | ||||
188 | #pod | ||||
189 | #pod The C<success> field of the response will be true if the status code is 2XX. | ||||
190 | #pod | ||||
191 | #pod =cut | ||||
192 | |||||
193 | 1 | 500ns | for my $sub_name ( qw/get head put post delete/ ) { | ||
194 | 5 | 2µs | my $req_method = uc $sub_name; | ||
195 | 2 | 1.69ms | 2 | 19µs | # spent 12µs (5+7) within HTTP::Tiny::BEGIN@195 which was called:
# once (5µs+7µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 195 # spent 12µs making 1 call to HTTP::Tiny::BEGIN@195
# spent 7µs making 1 call to strict::unimport |
196 | 5 | 186µs | eval <<"HERE"; ## no critic | ||
197 | sub $sub_name { | ||||
198 | my (\$self, \$url, \$args) = \@_; | ||||
199 | \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH') | ||||
200 | or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n"); | ||||
201 | return \$self->request('$req_method', \$url, \$args || {}); | ||||
202 | } | ||||
203 | HERE | ||||
204 | } | ||||
205 | |||||
206 | #pod =method post_form | ||||
207 | #pod | ||||
208 | #pod $response = $http->post_form($url, $form_data); | ||||
209 | #pod $response = $http->post_form($url, $form_data, \%options); | ||||
210 | #pod | ||||
211 | #pod This method executes a C<POST> request and sends the key/value pairs from a | ||||
212 | #pod form data hash or array reference to the given URL with a C<content-type> of | ||||
213 | #pod C<application/x-www-form-urlencoded>. If data is provided as an array | ||||
214 | #pod reference, the order is preserved; if provided as a hash reference, the terms | ||||
215 | #pod are sorted on key and value for consistency. See documentation for the | ||||
216 | #pod C<www_form_urlencode> method for details on the encoding. | ||||
217 | #pod | ||||
218 | #pod The URL must have unsafe characters escaped and international domain names | ||||
219 | #pod encoded. See C<request()> for valid options and a description of the response. | ||||
220 | #pod Any C<content-type> header or content in the options hashref will be ignored. | ||||
221 | #pod | ||||
222 | #pod The C<success> field of the response will be true if the status code is 2XX. | ||||
223 | #pod | ||||
224 | #pod =cut | ||||
225 | |||||
226 | sub post_form { | ||||
227 | my ($self, $url, $data, $args) = @_; | ||||
228 | (@_ == 3 || @_ == 4 && ref $args eq 'HASH') | ||||
229 | or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n"); | ||||
230 | |||||
231 | my $headers = {}; | ||||
232 | while ( my ($key, $value) = each %{$args->{headers} || {}} ) { | ||||
233 | $headers->{lc $key} = $value; | ||||
234 | } | ||||
235 | delete $args->{headers}; | ||||
236 | |||||
237 | return $self->request('POST', $url, { | ||||
238 | %$args, | ||||
239 | content => $self->www_form_urlencode($data), | ||||
240 | headers => { | ||||
241 | %$headers, | ||||
242 | 'content-type' => 'application/x-www-form-urlencoded' | ||||
243 | }, | ||||
244 | } | ||||
245 | ); | ||||
246 | } | ||||
247 | |||||
248 | #pod =method mirror | ||||
249 | #pod | ||||
250 | #pod $response = $http->mirror($url, $file, \%options) | ||||
251 | #pod if ( $response->{success} ) { | ||||
252 | #pod print "$file is up to date\n"; | ||||
253 | #pod } | ||||
254 | #pod | ||||
255 | #pod Executes a C<GET> request for the URL and saves the response body to the file | ||||
256 | #pod name provided. The URL must have unsafe characters escaped and international | ||||
257 | #pod domain names encoded. If the file already exists, the request will include an | ||||
258 | #pod C<If-Modified-Since> header with the modification timestamp of the file. You | ||||
259 | #pod may specify a different C<If-Modified-Since> header yourself in the C<< | ||||
260 | #pod $options->{headers} >> hash. | ||||
261 | #pod | ||||
262 | #pod The C<success> field of the response will be true if the status code is 2XX | ||||
263 | #pod or if the status code is 304 (unmodified). | ||||
264 | #pod | ||||
265 | #pod If the file was modified and the server response includes a properly | ||||
266 | #pod formatted C<Last-Modified> header, the file modification time will | ||||
267 | #pod be updated accordingly. | ||||
268 | #pod | ||||
269 | #pod =cut | ||||
270 | |||||
271 | sub mirror { | ||||
272 | my ($self, $url, $file, $args) = @_; | ||||
273 | @_ == 3 || (@_ == 4 && ref $args eq 'HASH') | ||||
274 | or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n"); | ||||
275 | if ( -e $file and my $mtime = (stat($file))[9] ) { | ||||
276 | $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime); | ||||
277 | } | ||||
278 | my $tempfile = $file . int(rand(2**31)); | ||||
279 | |||||
280 | require Fcntl; | ||||
281 | sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY() | ||||
282 | or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/); | ||||
283 | binmode $fh; | ||||
284 | $args->{data_callback} = sub { print {$fh} $_[0] }; | ||||
285 | my $response = $self->request('GET', $url, $args); | ||||
286 | close $fh | ||||
287 | or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/); | ||||
288 | |||||
289 | if ( $response->{success} ) { | ||||
290 | rename $tempfile, $file | ||||
291 | or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/); | ||||
292 | my $lm = $response->{headers}{'last-modified'}; | ||||
293 | if ( $lm and my $mtime = $self->_parse_http_date($lm) ) { | ||||
294 | utime $mtime, $mtime, $file; | ||||
295 | } | ||||
296 | } | ||||
297 | $response->{success} ||= $response->{status} eq '304'; | ||||
298 | unlink $tempfile; | ||||
299 | return $response; | ||||
300 | } | ||||
301 | |||||
302 | #pod =method request | ||||
303 | #pod | ||||
304 | #pod $response = $http->request($method, $url); | ||||
305 | #pod $response = $http->request($method, $url, \%options); | ||||
306 | #pod | ||||
307 | #pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST', | ||||
308 | #pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and | ||||
309 | #pod international domain names encoded. | ||||
310 | #pod | ||||
311 | #pod If the URL includes a "user:password" stanza, they will be used for Basic-style | ||||
312 | #pod authorization headers. (Authorization headers will not be included in a | ||||
313 | #pod redirected request.) For example: | ||||
314 | #pod | ||||
315 | #pod $http->request('GET', 'http://Aladdin:open sesame@example.com/'); | ||||
316 | #pod | ||||
317 | #pod If the "user:password" stanza contains reserved characters, they must | ||||
318 | #pod be percent-escaped: | ||||
319 | #pod | ||||
320 | #pod $http->request('GET', 'http://john%40example.com:password@example.com/'); | ||||
321 | #pod | ||||
322 | #pod A hashref of options may be appended to modify the request. | ||||
323 | #pod | ||||
324 | #pod Valid options are: | ||||
325 | #pod | ||||
326 | #pod =for :list | ||||
327 | #pod * C<headers> — | ||||
328 | #pod A hashref containing headers to include with the request. If the value for | ||||
329 | #pod a header is an array reference, the header will be output multiple times with | ||||
330 | #pod each value in the array. These headers over-write any default headers. | ||||
331 | #pod * C<content> — | ||||
332 | #pod A scalar to include as the body of the request OR a code reference | ||||
333 | #pod that will be called iteratively to produce the body of the request | ||||
334 | #pod * C<trailer_callback> — | ||||
335 | #pod A code reference that will be called if it exists to provide a hashref | ||||
336 | #pod of trailing headers (only used with chunked transfer-encoding) | ||||
337 | #pod * C<data_callback> — | ||||
338 | #pod A code reference that will be called for each chunks of the response | ||||
339 | #pod body received. | ||||
340 | #pod | ||||
341 | #pod The C<Host> header is generated from the URL in accordance with RFC 2616. It | ||||
342 | #pod is a fatal error to specify C<Host> in the C<headers> option. Other headers | ||||
343 | #pod may be ignored or overwritten if necessary for transport compliance. | ||||
344 | #pod | ||||
345 | #pod If the C<content> option is a code reference, it will be called iteratively | ||||
346 | #pod to provide the content body of the request. It should return the empty | ||||
347 | #pod string or undef when the iterator is exhausted. | ||||
348 | #pod | ||||
349 | #pod If the C<content> option is the empty string, no C<content-type> or | ||||
350 | #pod C<content-length> headers will be generated. | ||||
351 | #pod | ||||
352 | #pod If the C<data_callback> option is provided, it will be called iteratively until | ||||
353 | #pod the entire response body is received. The first argument will be a string | ||||
354 | #pod containing a chunk of the response body, the second argument will be the | ||||
355 | #pod in-progress response hash reference, as described below. (This allows | ||||
356 | #pod customizing the action of the callback based on the C<status> or C<headers> | ||||
357 | #pod received prior to the content body.) | ||||
358 | #pod | ||||
359 | #pod The C<request> method returns a hashref containing the response. The hashref | ||||
360 | #pod will have the following keys: | ||||
361 | #pod | ||||
362 | #pod =for :list | ||||
363 | #pod * C<success> — | ||||
364 | #pod Boolean indicating whether the operation returned a 2XX status code | ||||
365 | #pod * C<url> — | ||||
366 | #pod URL that provided the response. This is the URL of the request unless | ||||
367 | #pod there were redirections, in which case it is the last URL queried | ||||
368 | #pod in a redirection chain | ||||
369 | #pod * C<status> — | ||||
370 | #pod The HTTP status code of the response | ||||
371 | #pod * C<reason> — | ||||
372 | #pod The response phrase returned by the server | ||||
373 | #pod * C<content> — | ||||
374 | #pod The body of the response. If the response does not have any content | ||||
375 | #pod or if a data callback is provided to consume the response body, | ||||
376 | #pod this will be the empty string | ||||
377 | #pod * C<headers> — | ||||
378 | #pod A hashref of header fields. All header field names will be normalized | ||||
379 | #pod to be lower case. If a header is repeated, the value will be an arrayref; | ||||
380 | #pod it will otherwise be a scalar string containing the value | ||||
381 | #pod | ||||
382 | #pod On an exception during the execution of the request, the C<status> field will | ||||
383 | #pod contain 599, and the C<content> field will contain the text of the exception. | ||||
384 | #pod | ||||
385 | #pod =cut | ||||
386 | |||||
387 | 1 | 6µs | my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/; | ||
388 | |||||
389 | # spent 19.3s (29.7ms+19.3) within HTTP::Tiny::request which was called 2002 times, avg 9.63ms/call:
# 2002 times (29.7ms+19.3s) by Search::Elasticsearch::Cxn::HTTPTiny::perform_request at line 34 of Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 9.63ms/call | ||||
390 | 2002 | 1.40ms | my ($self, $method, $url, $args) = @_; | ||
391 | 2002 | 2.94ms | @_ == 3 || (@_ == 4 && ref $args eq 'HASH') | ||
392 | or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n"); | ||||
393 | 2002 | 570µs | $args ||= {}; # we keep some state in this during _request | ||
394 | |||||
395 | # RFC 2616 Section 8.1.4 mandates a single retry on broken socket | ||||
396 | 2002 | 339µs | my $response; | ||
397 | 2002 | 2.88ms | for ( 0 .. 1 ) { | ||
398 | 4004 | 6.33ms | 2002 | 19.3s | $response = eval { $self->_request($method, $url, $args) }; # spent 19.3s making 2002 calls to HTTP::Tiny::_request, avg 9.62ms/call |
399 | 2002 | 1.86ms | last unless $@ && $idempotent{$method} | ||
400 | && $@ =~ m{^(?:Socket closed|Unexpected end)}; | ||||
401 | } | ||||
402 | |||||
403 | 2002 | 1.38ms | if (my $e = $@) { | ||
404 | # maybe we got a response hash thrown from somewhere deep | ||||
405 | if ( ref $e eq 'HASH' && exists $e->{status} ) { | ||||
406 | return $e; | ||||
407 | } | ||||
408 | |||||
409 | # otherwise, stringify it | ||||
410 | $e = "$e"; | ||||
411 | $response = { | ||||
412 | url => $url, | ||||
413 | success => q{}, | ||||
414 | status => 599, | ||||
415 | reason => 'Internal Exception', | ||||
416 | content => $e, | ||||
417 | headers => { | ||||
418 | 'content-type' => 'text/plain', | ||||
419 | 'content-length' => length $e, | ||||
420 | } | ||||
421 | }; | ||||
422 | } | ||||
423 | 2002 | 18.5ms | return $response; | ||
424 | } | ||||
425 | |||||
426 | #pod =method www_form_urlencode | ||||
427 | #pod | ||||
428 | #pod $params = $http->www_form_urlencode( $data ); | ||||
429 | #pod $response = $http->get("http://example.com/query?$params"); | ||||
430 | #pod | ||||
431 | #pod This method converts the key/value pairs from a data hash or array reference | ||||
432 | #pod into a C<x-www-form-urlencoded> string. The keys and values from the data | ||||
433 | #pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an | ||||
434 | #pod array reference, the key will be repeated with each of the values of the array | ||||
435 | #pod reference. If data is provided as a hash reference, the key/value pairs in the | ||||
436 | #pod resulting string will be sorted by key and value for consistent ordering. | ||||
437 | #pod | ||||
438 | #pod =cut | ||||
439 | |||||
440 | sub www_form_urlencode { | ||||
441 | my ($self, $data) = @_; | ||||
442 | (@_ == 2 && ref $data) | ||||
443 | or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n"); | ||||
444 | (ref $data eq 'HASH' || ref $data eq 'ARRAY') | ||||
445 | or Carp::croak("form data must be a hash or array reference\n"); | ||||
446 | |||||
447 | my @params = ref $data eq 'HASH' ? %$data : @$data; | ||||
448 | @params % 2 == 0 | ||||
449 | or Carp::croak("form data reference must have an even number of terms\n"); | ||||
450 | |||||
451 | my @terms; | ||||
452 | while( @params ) { | ||||
453 | my ($key, $value) = splice(@params, 0, 2); | ||||
454 | if ( ref $value eq 'ARRAY' ) { | ||||
455 | unshift @params, map { $key => $_ } @$value; | ||||
456 | } | ||||
457 | else { | ||||
458 | push @terms, join("=", map { $self->_uri_escape($_) } $key, $value); | ||||
459 | } | ||||
460 | } | ||||
461 | |||||
462 | return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) ); | ||||
463 | } | ||||
464 | |||||
465 | #--------------------------------------------------------------------------# | ||||
466 | # private methods | ||||
467 | #--------------------------------------------------------------------------# | ||||
468 | |||||
469 | 1 | 1µs | my %DefaultPort = ( | ||
470 | http => 80, | ||||
471 | https => 443, | ||||
472 | ); | ||||
473 | |||||
474 | # spent 18.1ms (9.16+8.98) within HTTP::Tiny::_agent which was called 1001 times, avg 18µs/call:
# 1001 times (9.16ms+8.98ms) by HTTP::Tiny::new at line 117, avg 18µs/call | ||||
475 | 1001 | 757µs | my $class = ref($_[0]) || $_[0]; | ||
476 | 1001 | 4.18ms | 1001 | 1.58ms | (my $default_agent = $class) =~ s{::}{-}g; # spent 1.58ms making 1001 calls to HTTP::Tiny::CORE:subst, avg 2µs/call |
477 | 1001 | 19.7ms | 1001 | 7.39ms | return $default_agent . "/" . $class->VERSION; # spent 7.39ms making 1001 calls to UNIVERSAL::VERSION, avg 7µs/call |
478 | } | ||||
479 | |||||
480 | # spent 19.3s (142ms+19.1) within HTTP::Tiny::_request which was called 2002 times, avg 9.62ms/call:
# 2002 times (142ms+19.1s) by HTTP::Tiny::request at line 398, avg 9.62ms/call | ||||
481 | 2002 | 962µs | my ($self, $method, $url, $args) = @_; | ||
482 | |||||
483 | 2002 | 5.87ms | 2002 | 48.6ms | my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url); # spent 48.6ms making 2002 calls to HTTP::Tiny::_split_url, avg 24µs/call |
484 | |||||
485 | my $request = { | ||||
486 | method => $method, | ||||
487 | scheme => $scheme, | ||||
488 | host => $host, | ||||
489 | port => $port, | ||||
490 | 2002 | 11.5ms | host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"), | ||
491 | uri => $path_query, | ||||
492 | headers => {}, | ||||
493 | }; | ||||
494 | |||||
495 | # We remove the cached handle so it is not reused in the case of redirect. | ||||
496 | # If all is well, it will be recached at the end of _request. We only | ||||
497 | # reuse for the same scheme, host and port | ||||
498 | 2002 | 1.31ms | my $handle = delete $self->{handle}; | ||
499 | 2002 | 831µs | if ( $handle ) { | ||
500 | unless ( $handle->can_reuse( $scheme, $host, $port ) ) { | ||||
501 | $handle->close; | ||||
502 | undef $handle; | ||||
503 | } | ||||
504 | } | ||||
505 | 2002 | 4.55ms | 2002 | 1.00s | $handle ||= $self->_open_handle( $request, $scheme, $host, $port ); # spent 1.00s making 2002 calls to HTTP::Tiny::_open_handle, avg 502µs/call |
506 | |||||
507 | 2002 | 4.93ms | 2002 | 42.8ms | $self->_prepare_headers_and_cb($request, $args, $url, $auth); # spent 42.8ms making 2002 calls to HTTP::Tiny::_prepare_headers_and_cb, avg 21µs/call |
508 | 2002 | 4.00ms | 2002 | 312ms | $handle->write_request($request); # spent 312ms making 2002 calls to HTTP::Tiny::Handle::write_request, avg 156µs/call |
509 | |||||
510 | 2002 | 483µs | my $response; | ||
511 | do { $response = $handle->read_response_header } | ||||
512 | 2002 | 9.56ms | 2002 | 17.6s | until (substr($response->{status},0,1) ne '1'); # spent 17.6s making 2002 calls to HTTP::Tiny::Handle::read_response_header, avg 8.80ms/call |
513 | |||||
514 | 2002 | 1.47ms | $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar}; | ||
515 | |||||
516 | 2002 | 8.24ms | 2002 | 27.3ms | if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) { # spent 27.3ms making 2002 calls to HTTP::Tiny::_maybe_redirect, avg 14µs/call |
517 | $handle->close; | ||||
518 | return $self->_request(@redir_args, $args); | ||||
519 | } | ||||
520 | |||||
521 | 2002 | 577µs | my $known_message_length; | ||
522 | 2002 | 4.47ms | 1001 | 618µs | if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) { # spent 618µs making 1001 calls to HTTP::Tiny::CORE:match, avg 617ns/call |
523 | # response has no message body | ||||
524 | $known_message_length = 1; | ||||
525 | } | ||||
526 | else { | ||||
527 | 1001 | 2.64ms | 1001 | 9.88ms | my $data_cb = $self->_prepare_data_cb($response, $args); # spent 9.88ms making 1001 calls to HTTP::Tiny::_prepare_data_cb, avg 10µs/call |
528 | 1001 | 5.05ms | 1001 | 55.1ms | $known_message_length = $handle->read_body($data_cb, $response); # spent 55.1ms making 1001 calls to HTTP::Tiny::Handle::read_body, avg 55µs/call |
529 | } | ||||
530 | |||||
531 | 2002 | 5.66ms | if ( $self->{keep_alive} | ||
532 | && $known_message_length | ||||
533 | && $response->{protocol} eq 'HTTP/1.1' | ||||
534 | && ($response->{headers}{connection} || '') ne 'close' | ||||
535 | ) { | ||||
536 | $self->{handle} = $handle; | ||||
537 | } | ||||
538 | else { | ||||
539 | $handle->close; | ||||
540 | } | ||||
541 | |||||
542 | 2002 | 2.94ms | $response->{success} = substr( $response->{status}, 0, 1 ) eq '2'; | ||
543 | 2002 | 1.17ms | $response->{url} = $url; | ||
544 | 2002 | 21.7ms | return $response; | ||
545 | } | ||||
546 | |||||
547 | # spent 1.00s (29.9ms+975ms) within HTTP::Tiny::_open_handle which was called 2002 times, avg 502µs/call:
# 2002 times (29.9ms+975ms) by HTTP::Tiny::_request at line 505, avg 502µs/call | ||||
548 | 2002 | 1.39ms | my ($self, $request, $scheme, $host, $port) = @_; | ||
549 | |||||
550 | my $handle = HTTP::Tiny::Handle->new( | ||||
551 | timeout => $self->{timeout}, | ||||
552 | SSL_options => $self->{SSL_options}, | ||||
553 | verify_SSL => $self->{verify_SSL}, | ||||
554 | local_address => $self->{local_address}, | ||||
555 | keep_alive => $self->{keep_alive} | ||||
556 | 2002 | 15.7ms | 2002 | 22.1ms | ); # spent 22.1ms making 2002 calls to HTTP::Tiny::Handle::new, avg 11µs/call |
557 | |||||
558 | 2002 | 1.99ms | if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) { | ||
559 | return $self->_proxy_connect( $request, $handle ); | ||||
560 | } | ||||
561 | else { | ||||
562 | 2002 | 16.7ms | 2002 | 953ms | return $handle->connect($scheme, $host, $port); # spent 953ms making 2002 calls to HTTP::Tiny::Handle::connect, avg 476µs/call |
563 | } | ||||
564 | } | ||||
565 | |||||
566 | sub _proxy_connect { | ||||
567 | my ($self, $request, $handle) = @_; | ||||
568 | |||||
569 | my @proxy_vars; | ||||
570 | if ( $request->{scheme} eq 'https' ) { | ||||
571 | Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy}; | ||||
572 | @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} ); | ||||
573 | if ( $proxy_vars[0] eq 'https' ) { | ||||
574 | Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}}); | ||||
575 | } | ||||
576 | } | ||||
577 | else { | ||||
578 | Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy}; | ||||
579 | @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} ); | ||||
580 | } | ||||
581 | |||||
582 | my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars; | ||||
583 | |||||
584 | if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) { | ||||
585 | $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth ); | ||||
586 | } | ||||
587 | |||||
588 | $handle->connect($p_scheme, $p_host, $p_port); | ||||
589 | |||||
590 | if ($request->{scheme} eq 'https') { | ||||
591 | $self->_create_proxy_tunnel( $request, $handle ); | ||||
592 | } | ||||
593 | else { | ||||
594 | # non-tunneled proxy requires absolute URI | ||||
595 | $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}"; | ||||
596 | } | ||||
597 | |||||
598 | return $handle; | ||||
599 | } | ||||
600 | |||||
601 | sub _split_proxy { | ||||
602 | my ($self, $type, $proxy) = @_; | ||||
603 | |||||
604 | my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) }; | ||||
605 | |||||
606 | unless( | ||||
607 | defined($scheme) && length($scheme) && length($host) && length($port) | ||||
608 | && $path_query eq '/' | ||||
609 | ) { | ||||
610 | Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n}); | ||||
611 | } | ||||
612 | |||||
613 | return ($scheme, $host, $port, $auth); | ||||
614 | } | ||||
615 | |||||
616 | sub _create_proxy_tunnel { | ||||
617 | my ($self, $request, $handle) = @_; | ||||
618 | |||||
619 | $handle->_assert_ssl; | ||||
620 | |||||
621 | my $agent = exists($request->{headers}{'user-agent'}) | ||||
622 | ? $request->{headers}{'user-agent'} : $self->{agent}; | ||||
623 | |||||
624 | my $connect_request = { | ||||
625 | method => 'CONNECT', | ||||
626 | uri => "$request->{host}:$request->{port}", | ||||
627 | headers => { | ||||
628 | host => "$request->{host}:$request->{port}", | ||||
629 | 'user-agent' => $agent, | ||||
630 | } | ||||
631 | }; | ||||
632 | |||||
633 | if ( $request->{headers}{'proxy-authorization'} ) { | ||||
634 | $connect_request->{headers}{'proxy-authorization'} = | ||||
635 | delete $request->{headers}{'proxy-authorization'}; | ||||
636 | } | ||||
637 | |||||
638 | $handle->write_request($connect_request); | ||||
639 | my $response; | ||||
640 | do { $response = $handle->read_response_header } | ||||
641 | until (substr($response->{status},0,1) ne '1'); | ||||
642 | |||||
643 | # if CONNECT failed, throw the response so it will be | ||||
644 | # returned from the original request() method; | ||||
645 | unless (substr($response->{status},0,1) eq '2') { | ||||
646 | die $response; | ||||
647 | } | ||||
648 | |||||
649 | # tunnel established, so start SSL handshake | ||||
650 | $handle->start_ssl( $request->{host} ); | ||||
651 | |||||
652 | return; | ||||
653 | } | ||||
654 | |||||
655 | # spent 42.8ms (41.3+1.48) within HTTP::Tiny::_prepare_headers_and_cb which was called 2002 times, avg 21µs/call:
# 2002 times (41.3ms+1.48ms) by HTTP::Tiny::_request at line 507, avg 21µs/call | ||||
656 | 2002 | 1.56ms | my ($self, $request, $args, $url, $auth) = @_; | ||
657 | |||||
658 | 2002 | 3.65ms | for ($self->{default_headers}, $args->{headers}) { | ||
659 | 4004 | 1.51ms | next unless defined; | ||
660 | 3002 | 8.45ms | while (my ($k, $v) = each %$_) { | ||
661 | $request->{headers}{lc $k} = $v; | ||||
662 | } | ||||
663 | } | ||||
664 | |||||
665 | 2002 | 1.03ms | if (exists $request->{headers}{'host'}) { | ||
666 | die(qq/The 'Host' header must not be provided as header option\n/); | ||||
667 | } | ||||
668 | |||||
669 | 2002 | 1.96ms | $request->{headers}{'host'} = $request->{host_port}; | ||
670 | 2002 | 2.11ms | $request->{headers}{'user-agent'} ||= $self->{agent}; | ||
671 | $request->{headers}{'connection'} = "close" | ||||
672 | 2002 | 884µs | unless $self->{keep_alive}; | ||
673 | |||||
674 | 2002 | 1.17ms | if ( defined $args->{content} ) { | ||
675 | 1000 | 2.96ms | if (ref $args->{content} eq 'CODE') { | ||
676 | $request->{headers}{'content-type'} ||= "application/octet-stream"; | ||||
677 | $request->{headers}{'transfer-encoding'} = 'chunked' | ||||
678 | unless $request->{headers}{'content-length'} | ||||
679 | || $request->{headers}{'transfer-encoding'}; | ||||
680 | $request->{cb} = $args->{content}; | ||||
681 | } | ||||
682 | elsif ( length $args->{content} ) { | ||||
683 | 1000 | 679µs | my $content = $args->{content}; | ||
684 | 1000 | 1.09ms | if ( $] ge '5.008' ) { | ||
685 | 1000 | 4.34ms | 1000 | 1.48ms | utf8::downgrade($content, 1) # spent 1.48ms making 1000 calls to utf8::downgrade, avg 1µs/call |
686 | or die(qq/Wide character in request message body\n/); | ||||
687 | } | ||||
688 | 1000 | 616µs | $request->{headers}{'content-type'} ||= "application/octet-stream"; | ||
689 | $request->{headers}{'content-length'} = length $content | ||||
690 | unless $request->{headers}{'content-length'} | ||||
691 | 1000 | 1.51ms | || $request->{headers}{'transfer-encoding'}; | ||
692 | 3000 | 23.7ms | # spent 4.50ms within HTTP::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm:692] which was called 2000 times, avg 2µs/call:
# 2000 times (4.50ms+0s) by HTTP::Tiny::Handle::write_content_body at line 1217, avg 2µs/call | ||
693 | } | ||||
694 | $request->{trailer_cb} = $args->{trailer_callback} | ||||
695 | 1000 | 641µs | if ref $args->{trailer_callback} eq 'CODE'; | ||
696 | } | ||||
697 | |||||
698 | ### If we have a cookie jar, then maybe add relevant cookies | ||||
699 | 2002 | 836µs | if ( $self->{cookie_jar} ) { | ||
700 | my $cookies = $self->cookie_jar->cookie_header( $url ); | ||||
701 | $request->{headers}{cookie} = $cookies if length $cookies; | ||||
702 | } | ||||
703 | |||||
704 | # if we have Basic auth parameters, add them | ||||
705 | 2002 | 998µs | if ( length $auth && ! defined $request->{headers}{authorization} ) { | ||
706 | $self->_add_basic_auth_header( $request, 'authorization' => $auth ); | ||||
707 | } | ||||
708 | |||||
709 | 2002 | 16.6ms | return; | ||
710 | } | ||||
711 | |||||
712 | sub _add_basic_auth_header { | ||||
713 | my ($self, $request, $header, $auth) = @_; | ||||
714 | require MIME::Base64; | ||||
715 | $request->{headers}{$header} = | ||||
716 | "Basic " . MIME::Base64::encode_base64($auth, ""); | ||||
717 | return; | ||||
718 | } | ||||
719 | |||||
720 | # spent 9.88ms within HTTP::Tiny::_prepare_data_cb which was called 1001 times, avg 10µs/call:
# 1001 times (9.88ms+0s) by HTTP::Tiny::_request at line 527, avg 10µs/call | ||||
721 | 1001 | 502µs | my ($self, $response, $args) = @_; | ||
722 | 1001 | 807µs | my $data_cb = $args->{data_callback}; | ||
723 | 1001 | 969µs | $response->{content} = ''; | ||
724 | |||||
725 | 1001 | 758µs | if (!$data_cb || $response->{status} !~ /^2/) { | ||
726 | 1001 | 942µs | if (defined $self->{max_size}) { | ||
727 | $data_cb = sub { | ||||
728 | $_[1]->{content} .= $_[0]; | ||||
729 | die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/) | ||||
730 | if length $_[1]->{content} > $self->{max_size}; | ||||
731 | }; | ||||
732 | } | ||||
733 | else { | ||||
734 | 2002 | 13.8ms | # spent 2.92ms within HTTP::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm:734] which was called 1001 times, avg 3µs/call:
# 1001 times (2.92ms+0s) by HTTP::Tiny::Handle::read_content_body at line 1199, avg 3µs/call | ||
735 | } | ||||
736 | } | ||||
737 | 1001 | 2.15ms | return $data_cb; | ||
738 | } | ||||
739 | |||||
740 | sub _update_cookie_jar { | ||||
741 | my ($self, $url, $response) = @_; | ||||
742 | |||||
743 | my $cookies = $response->{headers}->{'set-cookie'}; | ||||
744 | return unless defined $cookies; | ||||
745 | |||||
746 | my @cookies = ref $cookies ? @$cookies : $cookies; | ||||
747 | |||||
748 | $self->cookie_jar->add( $url, $_ ) for @cookies; | ||||
749 | |||||
750 | return; | ||||
751 | } | ||||
752 | |||||
753 | sub _validate_cookie_jar { | ||||
754 | my ($class, $jar) = @_; | ||||
755 | |||||
756 | # duck typing | ||||
757 | for my $method ( qw/add cookie_header/ ) { | ||||
758 | Carp::croak(qq/Cookie jar must provide the '$method' method\n/) | ||||
759 | unless ref($jar) && ref($jar)->can($method); | ||||
760 | } | ||||
761 | |||||
762 | return; | ||||
763 | } | ||||
764 | |||||
765 | # spent 27.3ms (26.1+1.18) within HTTP::Tiny::_maybe_redirect which was called 2002 times, avg 14µs/call:
# 2002 times (26.1ms+1.18ms) by HTTP::Tiny::_request at line 516, avg 14µs/call | ||||
766 | 2002 | 1.42ms | my ($self, $request, $response, $args) = @_; | ||
767 | 2002 | 1.30ms | my $headers = $response->{headers}; | ||
768 | 2002 | 2.81ms | my ($status, $method) = ($response->{status}, $request->{method}); | ||
769 | 2002 | 18.2ms | 2002 | 1.18ms | if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/)) # spent 1.18ms making 2002 calls to HTTP::Tiny::CORE:match, avg 588ns/call |
770 | and $headers->{location} | ||||
771 | and ++$args->{redirects} <= $self->{max_redirect} | ||||
772 | ) { | ||||
773 | my $location = ($headers->{location} =~ /^\//) | ||||
774 | ? "$request->{scheme}://$request->{host_port}$headers->{location}" | ||||
775 | : $headers->{location} ; | ||||
776 | return (($status eq '303' ? 'GET' : $method), $location); | ||||
777 | } | ||||
778 | 2002 | 20.4ms | return; | ||
779 | } | ||||
780 | |||||
781 | # spent 48.6ms (36.7+11.8) within HTTP::Tiny::_split_url which was called 2002 times, avg 24µs/call:
# 2002 times (36.7ms+11.8ms) by HTTP::Tiny::_request at line 483, avg 24µs/call | ||||
782 | 2002 | 843µs | my $url = pop; | ||
783 | |||||
784 | # URI regex adapted from the URI module | ||||
785 | 2002 | 17.5ms | 2002 | 6.15ms | my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> # spent 6.15ms making 2002 calls to HTTP::Tiny::CORE:match, avg 3µs/call |
786 | or die(qq/Cannot parse URL: '$url'\n/); | ||||
787 | |||||
788 | 2002 | 1.76ms | $scheme = lc $scheme; | ||
789 | 2002 | 9.64ms | 2002 | 1.70ms | $path_query = "/$path_query" unless $path_query =~ m<\A/>; # spent 1.70ms making 2002 calls to HTTP::Tiny::CORE:match, avg 851ns/call |
790 | |||||
791 | 2002 | 770µs | my $auth = ''; | ||
792 | 2002 | 2.44ms | if ( (my $i = index $host, '@') != -1 ) { | ||
793 | # user:pass@host | ||||
794 | $auth = substr $host, 0, $i, ''; # take up to the @ for auth | ||||
795 | substr $host, 0, 1, ''; # knock the @ off the host | ||||
796 | |||||
797 | # userinfo might be percent escaped, so recover real auth info | ||||
798 | $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; | ||||
799 | } | ||||
800 | 2002 | 9.84ms | 2002 | 3.97ms | my $port = $host =~ s/:(\d*)\z// && length $1 ? $1 # spent 3.97ms making 2002 calls to HTTP::Tiny::CORE:subst, avg 2µs/call |
801 | : $scheme eq 'http' ? 80 | ||||
802 | : $scheme eq 'https' ? 443 | ||||
803 | : undef; | ||||
804 | |||||
805 | 2002 | 14.8ms | return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth); | ||
806 | } | ||||
807 | |||||
808 | # Date conversions adapted from HTTP::Date | ||||
809 | 1 | 300ns | my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat"; | ||
810 | 1 | 200ns | my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec"; | ||
811 | sub _http_date { | ||||
812 | my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]); | ||||
813 | return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", | ||||
814 | substr($DoW,$wday*4,3), | ||||
815 | $mday, substr($MoY,$mon*4,3), $year+1900, | ||||
816 | $hour, $min, $sec | ||||
817 | ); | ||||
818 | } | ||||
819 | |||||
820 | sub _parse_http_date { | ||||
821 | my ($self, $str) = @_; | ||||
822 | require Time::Local; | ||||
823 | my @tl_parts; | ||||
824 | if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) { | ||||
825 | @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3); | ||||
826 | } | ||||
827 | elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) { | ||||
828 | @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3); | ||||
829 | } | ||||
830 | elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) { | ||||
831 | @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6); | ||||
832 | } | ||||
833 | return eval { | ||||
834 | my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1; | ||||
835 | $t < 0 ? undef : $t; | ||||
836 | }; | ||||
837 | } | ||||
838 | |||||
839 | # URI escaping adapted from URI::Escape | ||||
840 | # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1 | ||||
841 | # perl 5.6 ready UTF-8 encoding adapted from JSON::PP | ||||
842 | 257 | 207µs | my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; | ||
843 | 1 | 400ns | $escapes{' '}="+"; | ||
844 | 1 | 8µs | 1 | 2µs | my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/; # spent 2µs making 1 call to HTTP::Tiny::CORE:qr |
845 | |||||
846 | sub _uri_escape { | ||||
847 | my ($self, $str) = @_; | ||||
848 | if ( $] ge '5.008' ) { | ||||
849 | utf8::encode($str); | ||||
850 | } | ||||
851 | else { | ||||
852 | $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string | ||||
853 | 2 | 53µs | 2 | 13µs | # spent 11µs (9+2) within HTTP::Tiny::BEGIN@853 which was called:
# once (9µs+2µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 853 # spent 11µs making 1 call to HTTP::Tiny::BEGIN@853
# spent 2µs making 1 call to bytes::import |
854 | $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag | ||||
855 | } | ||||
856 | $str =~ s/($unsafe_char)/$escapes{$1}/ge; | ||||
857 | return $str; | ||||
858 | } | ||||
859 | |||||
860 | package | ||||
861 | HTTP::Tiny::Handle; # hide from PAUSE/indexers | ||||
862 | 2 | 17µs | 2 | 9µs | # spent 8µs (7+1) within HTTP::Tiny::Handle::BEGIN@862 which was called:
# once (7µs+1µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 862 # spent 8µs making 1 call to HTTP::Tiny::Handle::BEGIN@862
# spent 1µs making 1 call to strict::import |
863 | 2 | 26µs | 2 | 51µs | # spent 29µs (6+23) within HTTP::Tiny::Handle::BEGIN@863 which was called:
# once (6µs+23µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 863 # spent 29µs making 1 call to HTTP::Tiny::Handle::BEGIN@863
# spent 23µs making 1 call to warnings::import |
864 | |||||
865 | 2 | 68µs | 2 | 838µs | # spent 710µs (446+265) within HTTP::Tiny::Handle::BEGIN@865 which was called:
# once (446µs+265µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 865 # spent 710µs making 1 call to HTTP::Tiny::Handle::BEGIN@865
# spent 127µs making 1 call to Exporter::import |
866 | 2 | 1.96ms | 2 | 18.3ms | # spent 13.6ms (2.63+11.0) within HTTP::Tiny::Handle::BEGIN@866 which was called:
# once (2.63ms+11.0ms) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 866 # spent 13.6ms making 1 call to HTTP::Tiny::Handle::BEGIN@866
# spent 4.69ms making 1 call to IO::Socket::import |
867 | |||||
868 | # PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old | ||||
869 | # behavior if someone is unable to boostrap CPAN from a new perl install; it is | ||||
870 | # not intended for general, per-client use and may be removed in the future | ||||
871 | my $SOCKET_CLASS = | ||||
872 | $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' : | ||||
873 | 3 | 76µs | 1 | 7µs | eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' : # spent 7µs making 1 call to UNIVERSAL::VERSION |
874 | 'IO::Socket::INET'; | ||||
875 | |||||
876 | sub BUFSIZE () { 32768 } ## no critic | ||||
877 | |||||
878 | my $Printable = sub { | ||||
879 | local $_ = shift; | ||||
880 | s/\r/\\r/g; | ||||
881 | s/\n/\\n/g; | ||||
882 | s/\t/\\t/g; | ||||
883 | s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge; | ||||
884 | $_; | ||||
885 | 1 | 2µs | }; | ||
886 | |||||
887 | 1 | 4µs | 1 | 900ns | my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/; # spent 900ns making 1 call to HTTP::Tiny::Handle::CORE:qr |
888 | |||||
889 | # spent 22.1ms within HTTP::Tiny::Handle::new which was called 2002 times, avg 11µs/call:
# 2002 times (22.1ms+0s) by HTTP::Tiny::_open_handle at line 556, avg 11µs/call | ||||
890 | 2002 | 6.38ms | my ($class, %args) = @_; | ||
891 | 2002 | 17.2ms | return bless { | ||
892 | rbuf => '', | ||||
893 | timeout => 60, | ||||
894 | max_line_size => 16384, | ||||
895 | max_header_lines => 64, | ||||
896 | verify_SSL => 0, | ||||
897 | SSL_options => {}, | ||||
898 | %args | ||||
899 | }, $class; | ||||
900 | } | ||||
901 | |||||
902 | # spent 953ms (70.4+882) within HTTP::Tiny::Handle::connect which was called 2002 times, avg 476µs/call:
# 2002 times (70.4ms+882ms) by HTTP::Tiny::_open_handle at line 562, avg 476µs/call | ||||
903 | 2002 | 1.03ms | @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n"); | ||
904 | 2002 | 1.20ms | my ($self, $scheme, $host, $port) = @_; | ||
905 | |||||
906 | 2002 | 2.02ms | if ( $scheme eq 'https' ) { | ||
907 | $self->_assert_ssl; | ||||
908 | } | ||||
909 | elsif ( $scheme ne 'http' ) { | ||||
910 | die(qq/Unsupported URL scheme '$scheme'\n/); | ||||
911 | } | ||||
912 | $self->{fh} = $SOCKET_CLASS->new( | ||||
913 | PeerHost => $host, | ||||
914 | PeerPort => $port, | ||||
915 | $self->{local_address} ? | ||||
916 | ( LocalAddr => $self->{local_address} ) : (), | ||||
917 | Proto => 'tcp', | ||||
918 | Type => SOCK_STREAM, | ||||
919 | Timeout => $self->{timeout}, | ||||
920 | KeepAlive => !!$self->{keep_alive} | ||||
921 | 2002 | 18.1ms | 2002 | 856ms | ) or die(qq/Could not connect to '$host:$port': $@\n/); # spent 856ms making 2002 calls to IO::Socket::IP::new, avg 427µs/call |
922 | |||||
923 | binmode($self->{fh}) | ||||
924 | 2002 | 20.4ms | 2002 | 2.84ms | or die(qq/Could not binmode() socket: '$!'\n/); # spent 2.84ms making 2002 calls to HTTP::Tiny::Handle::CORE:binmode, avg 1µs/call |
925 | |||||
926 | 2002 | 1.24ms | $self->start_ssl($host) if $scheme eq 'https'; | ||
927 | |||||
928 | 2002 | 1.83ms | $self->{scheme} = $scheme; | ||
929 | 2002 | 1.07ms | $self->{host} = $host; | ||
930 | 2002 | 1.72ms | $self->{port} = $port; | ||
931 | 2002 | 2.24ms | $self->{pid} = $$; | ||
932 | 2002 | 4.11ms | 2002 | 24.0ms | $self->{tid} = _get_tid(); # spent 24.0ms making 2002 calls to HTTP::Tiny::Handle::_get_tid, avg 12µs/call |
933 | |||||
934 | 2002 | 5.26ms | return $self; | ||
935 | } | ||||
936 | |||||
937 | sub start_ssl { | ||||
938 | my ($self, $host) = @_; | ||||
939 | |||||
940 | # As this might be used via CONNECT after an SSL session | ||||
941 | # to a proxy, we shut down any existing SSL before attempting | ||||
942 | # the handshake | ||||
943 | if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { | ||||
944 | unless ( $self->{fh}->stop_SSL ) { | ||||
945 | my $ssl_err = IO::Socket::SSL->errstr; | ||||
946 | die(qq/Error halting prior SSL connection: $ssl_err/); | ||||
947 | } | ||||
948 | } | ||||
949 | |||||
950 | my $ssl_args = $self->_ssl_args($host); | ||||
951 | IO::Socket::SSL->start_SSL( | ||||
952 | $self->{fh}, | ||||
953 | %$ssl_args, | ||||
954 | SSL_create_ctx_callback => sub { | ||||
955 | my $ctx = shift; | ||||
956 | Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY()); | ||||
957 | }, | ||||
958 | ); | ||||
959 | |||||
960 | unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { | ||||
961 | my $ssl_err = IO::Socket::SSL->errstr; | ||||
962 | die(qq/SSL connection failed for $host: $ssl_err\n/); | ||||
963 | } | ||||
964 | } | ||||
965 | |||||
966 | sub close { | ||||
967 | @_ == 1 || die(q/Usage: $handle->close()/ . "\n"); | ||||
968 | my ($self) = @_; | ||||
969 | CORE::close($self->{fh}) | ||||
970 | or die(qq/Could not close socket: '$!'\n/); | ||||
971 | } | ||||
972 | |||||
973 | sub write { | ||||
974 | 3002 | 996µs | @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n"); | ||
975 | 3002 | 1.39ms | my ($self, $buf) = @_; | ||
976 | |||||
977 | 3002 | 1.95ms | if ( $] ge '5.008' ) { | ||
978 | 3002 | 12.1ms | 3002 | 1.05ms | utf8::downgrade($buf, 1) # spent 1.05ms making 3002 calls to utf8::downgrade, avg 350ns/call |
979 | or die(qq/Wide character in write()\n/); | ||||
980 | } | ||||
981 | |||||
982 | 3002 | 907µs | my $len = length $buf; | ||
983 | 3002 | 904µs | my $off = 0; | ||
984 | |||||
985 | 3002 | 15.2ms | local $SIG{PIPE} = 'IGNORE'; | ||
986 | |||||
987 | 3002 | 539µs | while () { | ||
988 | 3002 | 4.63ms | 3002 | 64.9ms | $self->can_write # spent 64.9ms making 3002 calls to HTTP::Tiny::Handle::can_write, avg 22µs/call |
989 | or die(qq/Timed out while waiting for socket to become ready for writing\n/); | ||||
990 | 3002 | 66.8ms | 3002 | 53.7ms | my $r = syswrite($self->{fh}, $buf, $len, $off); # spent 53.7ms making 3002 calls to HTTP::Tiny::Handle::CORE:syswrite, avg 18µs/call |
991 | 3002 | 1.30ms | if (defined $r) { | ||
992 | 3002 | 1.72ms | $len -= $r; | ||
993 | 3002 | 948µs | $off += $r; | ||
994 | 3002 | 2.57ms | last unless $len > 0; | ||
995 | } | ||||
996 | elsif ($! == EPIPE) { | ||||
997 | die(qq/Socket closed by remote server: $!\n/); | ||||
998 | } | ||||
999 | elsif ($! != EINTR) { | ||||
1000 | if ($self->{fh}->can('errstr')){ | ||||
1001 | my $err = $self->{fh}->errstr(); | ||||
1002 | die (qq/Could not write to SSL socket: '$err'\n /); | ||||
1003 | } | ||||
1004 | else { | ||||
1005 | die(qq/Could not write to socket: '$!'\n/); | ||||
1006 | } | ||||
1007 | |||||
1008 | } | ||||
1009 | } | ||||
1010 | 3002 | 26.2ms | return $off; | ||
1011 | } | ||||
1012 | |||||
1013 | # spent 9.80ms within HTTP::Tiny::Handle::read which was called 1001 times, avg 10µs/call:
# 1001 times (9.80ms+0s) by HTTP::Tiny::Handle::read_content_body at line 1199, avg 10µs/call | ||||
1014 | 1001 | 941µs | @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n"); | ||
1015 | 1001 | 575µs | my ($self, $len, $allow_partial) = @_; | ||
1016 | |||||
1017 | 1001 | 389µs | my $buf = ''; | ||
1018 | 1001 | 713µs | my $got = length $self->{rbuf}; | ||
1019 | |||||
1020 | 1001 | 650µs | if ($got) { | ||
1021 | 1001 | 592µs | my $take = ($got < $len) ? $got : $len; | ||
1022 | 1001 | 2.09ms | $buf = substr($self->{rbuf}, 0, $take, ''); | ||
1023 | 1001 | 776µs | $len -= $take; | ||
1024 | } | ||||
1025 | |||||
1026 | 1001 | 905µs | while ($len > 0) { | ||
1027 | $self->can_read | ||||
1028 | or die(q/Timed out while waiting for socket to become ready for reading/ . "\n"); | ||||
1029 | my $r = sysread($self->{fh}, $buf, $len, length $buf); | ||||
1030 | if (defined $r) { | ||||
1031 | last unless $r; | ||||
1032 | $len -= $r; | ||||
1033 | } | ||||
1034 | elsif ($! != EINTR) { | ||||
1035 | if ($self->{fh}->can('errstr')){ | ||||
1036 | my $err = $self->{fh}->errstr(); | ||||
1037 | die (qq/Could not read from SSL socket: '$err'\n /); | ||||
1038 | } | ||||
1039 | else { | ||||
1040 | die(qq/Could not read from socket: '$!'\n/); | ||||
1041 | } | ||||
1042 | } | ||||
1043 | } | ||||
1044 | 1001 | 342µs | if ($len && !$allow_partial) { | ||
1045 | die(qq/Unexpected end of stream\n/); | ||||
1046 | } | ||||
1047 | 1001 | 8.19ms | return $buf; | ||
1048 | } | ||||
1049 | |||||
1050 | # spent 17.4s (73.1ms+17.4) within HTTP::Tiny::Handle::readline which was called 9008 times, avg 1.94ms/call:
# 7006 times (25.8ms+9.96ms) by HTTP::Tiny::Handle::read_header_lines at line 1088, avg 5µs/call
# 2002 times (47.4ms+17.4s) by HTTP::Tiny::Handle::read_response_header at line 1293, avg 8.69ms/call | ||||
1051 | 9008 | 2.04ms | @_ == 1 || die(q/Usage: $handle->readline()/ . "\n"); | ||
1052 | 9008 | 2.06ms | my ($self) = @_; | ||
1053 | |||||
1054 | 9008 | 1.11ms | while () { | ||
1055 | 11010 | 88.5ms | 11010 | 24.7ms | if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) { # spent 24.7ms making 11010 calls to HTTP::Tiny::Handle::CORE:subst, avg 2µs/call |
1056 | return $1; | ||||
1057 | } | ||||
1058 | 2002 | 1.65ms | if (length $self->{rbuf} >= $self->{max_line_size}) { | ||
1059 | die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/); | ||||
1060 | } | ||||
1061 | $self->can_read | ||||
1062 | 2002 | 4.08ms | 2002 | 17.3s | or die(qq/Timed out while waiting for socket to become ready for reading\n/); # spent 17.3s making 2002 calls to HTTP::Tiny::Handle::can_read, avg 8.65ms/call |
1063 | 2002 | 29.8ms | 2002 | 18.2ms | my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf}); # spent 18.2ms making 2002 calls to HTTP::Tiny::Handle::CORE:sysread, avg 9µs/call |
1064 | 2002 | 2.69ms | if (defined $r) { | ||
1065 | 2002 | 896µs | last unless $r; | ||
1066 | } | ||||
1067 | elsif ($! != EINTR) { | ||||
1068 | if ($self->{fh}->can('errstr')){ | ||||
1069 | my $err = $self->{fh}->errstr(); | ||||
1070 | die (qq/Could not read from SSL socket: '$err'\n /); | ||||
1071 | } | ||||
1072 | else { | ||||
1073 | die(qq/Could not read from socket: '$!'\n/); | ||||
1074 | } | ||||
1075 | } | ||||
1076 | } | ||||
1077 | die(qq/Unexpected end of stream while looking for line\n/); | ||||
1078 | } | ||||
1079 | |||||
1080 | # spent 150ms (104+46.5) within HTTP::Tiny::Handle::read_header_lines which was called 2002 times, avg 75µs/call:
# 2002 times (104ms+46.5ms) by HTTP::Tiny::Handle::read_response_header at line 1304, avg 75µs/call | ||||
1081 | 2002 | 1.78ms | @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n"); | ||
1082 | 2002 | 1.42ms | my ($self, $headers) = @_; | ||
1083 | 2002 | 1.83ms | $headers ||= {}; | ||
1084 | 2002 | 722µs | my $lines = 0; | ||
1085 | 2002 | 437µs | my $val; | ||
1086 | |||||
1087 | 2002 | 739µs | while () { | ||
1088 | 7006 | 7.68ms | 7006 | 35.8ms | my $line = $self->readline; # spent 35.8ms making 7006 calls to HTTP::Tiny::Handle::readline, avg 5µs/call |
1089 | |||||
1090 | 7006 | 61.4ms | 11010 | 10.7ms | if (++$lines >= $self->{max_header_lines}) { # spent 10.7ms making 11010 calls to HTTP::Tiny::Handle::CORE:match, avg 972ns/call |
1091 | die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/); | ||||
1092 | } | ||||
1093 | elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) { | ||||
1094 | 5004 | 4.51ms | my ($field_name) = lc $1; | ||
1095 | 5004 | 2.88ms | if (exists $headers->{$field_name}) { | ||
1096 | for ($headers->{$field_name}) { | ||||
1097 | $_ = [$_] unless ref $_ eq "ARRAY"; | ||||
1098 | push @$_, $2; | ||||
1099 | $val = \$_->[-1]; | ||||
1100 | } | ||||
1101 | } | ||||
1102 | else { | ||||
1103 | 5004 | 7.93ms | $val = \($headers->{$field_name} = $2); | ||
1104 | } | ||||
1105 | } | ||||
1106 | elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) { | ||||
1107 | $val | ||||
1108 | or die(qq/Unexpected header continuation line\n/); | ||||
1109 | next unless length $1; | ||||
1110 | $$val .= ' ' if length $$val; | ||||
1111 | $$val .= $1; | ||||
1112 | } | ||||
1113 | elsif ($line =~ /\A \x0D?\x0A \z/x) { | ||||
1114 | 2002 | 1.28ms | last; | ||
1115 | } | ||||
1116 | else { | ||||
1117 | die(q/Malformed header line: / . $Printable->($line) . "\n"); | ||||
1118 | } | ||||
1119 | } | ||||
1120 | 2002 | 3.91ms | return $headers; | ||
1121 | } | ||||
1122 | |||||
1123 | # spent 312ms (15.4+296) within HTTP::Tiny::Handle::write_request which was called 2002 times, avg 156µs/call:
# 2002 times (15.4ms+296ms) by HTTP::Tiny::_request at line 508, avg 156µs/call | ||||
1124 | 2002 | 1.04ms | @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n"); | ||
1125 | 2002 | 886µs | my($self, $request) = @_; | ||
1126 | 2002 | 5.34ms | 2002 | 208ms | $self->write_request_header(@{$request}{qw/method uri headers/}); # spent 208ms making 2002 calls to HTTP::Tiny::Handle::write_request_header, avg 104µs/call |
1127 | 2002 | 3.53ms | 1000 | 88.1ms | $self->write_body($request) if $request->{cb}; # spent 88.1ms making 1000 calls to HTTP::Tiny::Handle::write_body, avg 88µs/call |
1128 | 2002 | 3.76ms | return; | ||
1129 | } | ||||
1130 | |||||
1131 | 1 | 2µs | my %HeaderCase = ( | ||
1132 | 'content-md5' => 'Content-MD5', | ||||
1133 | 'etag' => 'ETag', | ||||
1134 | 'te' => 'TE', | ||||
1135 | 'www-authenticate' => 'WWW-Authenticate', | ||||
1136 | 'x-xss-protection' => 'X-XSS-Protection', | ||||
1137 | ); | ||||
1138 | |||||
1139 | # to avoid multiple small writes and hence nagle, you can pass the method line or anything else to | ||||
1140 | # combine writes. | ||||
1141 | # spent 198ms (42.6+155) within HTTP::Tiny::Handle::write_header_lines which was called 2002 times, avg 99µs/call:
# 2002 times (42.6ms+155ms) by HTTP::Tiny::Handle::write_request_header at line 1315, avg 99µs/call | ||||
1142 | 2002 | 2.77ms | (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n"); | ||
1143 | 2002 | 916µs | my($self, $headers, $prefix_data) = @_; | ||
1144 | |||||
1145 | 2002 | 997µs | my $buf = (defined $prefix_data ? $prefix_data : ''); | ||
1146 | 2002 | 7.95ms | while (my ($k, $v) = each %$headers) { | ||
1147 | 6004 | 2.08ms | my $field_name = lc $k; | ||
1148 | 6004 | 4.88ms | if (exists $HeaderCase{$field_name}) { | ||
1149 | $field_name = $HeaderCase{$field_name}; | ||||
1150 | } | ||||
1151 | else { | ||||
1152 | 4 | 39µs | 5 | 29µs | $field_name =~ /\A $Token+ \z/xo # spent 24µs making 1 call to HTTP::Tiny::Handle::CORE:regcomp
# spent 5µs making 4 calls to HTTP::Tiny::Handle::CORE:match, avg 1µs/call |
1153 | or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n"); | ||||
1154 | 4 | 40µs | 15 | 11µs | $field_name =~ s/\b(\w)/\u$1/g; # spent 7µs making 11 calls to HTTP::Tiny::Handle::CORE:substcont, avg 618ns/call
# spent 4µs making 4 calls to HTTP::Tiny::Handle::CORE:subst, avg 975ns/call |
1155 | 4 | 4µs | $HeaderCase{lc $field_name} = $field_name; | ||
1156 | } | ||||
1157 | 6004 | 3.75ms | for (ref $v eq 'ARRAY' ? @$v : $v) { | ||
1158 | 6004 | 852µs | $_ = '' unless defined $_; | ||
1159 | 6004 | 3.88ms | $buf .= "$field_name: $_\x0D\x0A"; | ||
1160 | } | ||||
1161 | } | ||||
1162 | 2002 | 840µs | $buf .= "\x0D\x0A"; | ||
1163 | 2002 | 7.69ms | 2002 | 155ms | return $self->write($buf); # spent 155ms making 2002 calls to HTTP::Tiny::Handle::write, avg 77µs/call |
1164 | } | ||||
1165 | |||||
1166 | # return value indicates whether message length was defined; this is generally | ||||
1167 | # true unless there was no content-length header and we just read until EOF. | ||||
1168 | # Other message length errors are thrown as exceptions | ||||
1169 | # spent 55.1ms (16.3+38.9) within HTTP::Tiny::Handle::read_body which was called 1001 times, avg 55µs/call:
# 1001 times (16.3ms+38.9ms) by HTTP::Tiny::_request at line 528, avg 55µs/call | ||||
1170 | 1001 | 549µs | @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n"); | ||
1171 | 1001 | 503µs | my ($self, $cb, $response) = @_; | ||
1172 | 1001 | 1.08ms | my $te = $response->{headers}{'transfer-encoding'} || ''; | ||
1173 | 2002 | 5.15ms | 1001 | 332µs | my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ; # spent 332µs making 1001 calls to HTTP::Tiny::Handle::CORE:match, avg 332ns/call |
1174 | 1001 | 4.46ms | 1001 | 38.5ms | return $chunked # spent 38.5ms making 1001 calls to HTTP::Tiny::Handle::read_content_body, avg 38µs/call |
1175 | ? $self->read_chunked_body($cb, $response) | ||||
1176 | : $self->read_content_body($cb, $response); | ||||
1177 | } | ||||
1178 | |||||
1179 | # spent 88.1ms (5.67+82.5) within HTTP::Tiny::Handle::write_body which was called 1000 times, avg 88µs/call:
# 1000 times (5.67ms+82.5ms) by HTTP::Tiny::Handle::write_request at line 1127, avg 88µs/call | ||||
1180 | 1000 | 560µs | @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n"); | ||
1181 | 1000 | 543µs | my ($self, $request) = @_; | ||
1182 | 1000 | 4.47ms | 1000 | 82.5ms | if ($request->{headers}{'content-length'}) { # spent 82.5ms making 1000 calls to HTTP::Tiny::Handle::write_content_body, avg 82µs/call |
1183 | return $self->write_content_body($request); | ||||
1184 | } | ||||
1185 | else { | ||||
1186 | return $self->write_chunked_body($request); | ||||
1187 | } | ||||
1188 | } | ||||
1189 | |||||
1190 | # spent 38.5ms (25.8+12.7) within HTTP::Tiny::Handle::read_content_body which was called 1001 times, avg 38µs/call:
# 1001 times (25.8ms+12.7ms) by HTTP::Tiny::Handle::read_body at line 1174, avg 38µs/call | ||||
1191 | 1001 | 543µs | @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n"); | ||
1192 | 1001 | 554µs | my ($self, $cb, $response, $content_length) = @_; | ||
1193 | 1001 | 1.09ms | $content_length ||= $response->{headers}{'content-length'}; | ||
1194 | |||||
1195 | 1001 | 574µs | if ( defined $content_length ) { | ||
1196 | 1001 | 368µs | my $len = $content_length; | ||
1197 | 1001 | 1.65ms | while ($len > 0) { | ||
1198 | 1001 | 630µs | my $read = ($len > BUFSIZE) ? BUFSIZE : $len; | ||
1199 | 1001 | 3.95ms | 2002 | 12.7ms | $cb->($self->read($read, 0), $response); # spent 9.80ms making 1001 calls to HTTP::Tiny::Handle::read, avg 10µs/call
# spent 2.92ms making 1001 calls to HTTP::Tiny::__ANON__[HTTP/Tiny.pm:734], avg 3µs/call |
1200 | 1001 | 750µs | $len -= $read; | ||
1201 | } | ||||
1202 | 1001 | 8.04ms | return length($self->{rbuf}) == 0; | ||
1203 | } | ||||
1204 | |||||
1205 | my $chunk; | ||||
1206 | $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) ); | ||||
1207 | |||||
1208 | return; | ||||
1209 | } | ||||
1210 | |||||
1211 | # spent 82.5ms (37.0+45.4) within HTTP::Tiny::Handle::write_content_body which was called 1000 times, avg 82µs/call:
# 1000 times (37.0ms+45.4ms) by HTTP::Tiny::Handle::write_body at line 1182, avg 82µs/call | ||||
1212 | 1000 | 618µs | @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n"); | ||
1213 | 1000 | 437µs | my ($self, $request) = @_; | ||
1214 | |||||
1215 | 1000 | 1.04ms | my ($len, $content_length) = (0, $request->{headers}{'content-length'}); | ||
1216 | 1000 | 258µs | while () { | ||
1217 | 2000 | 3.27ms | 2000 | 4.50ms | my $data = $request->{cb}->(); # spent 4.50ms making 2000 calls to HTTP::Tiny::__ANON__[HTTP/Tiny.pm:692], avg 2µs/call |
1218 | |||||
1219 | 2000 | 1.44ms | defined $data && length $data | ||
1220 | or last; | ||||
1221 | |||||
1222 | 1000 | 749µs | if ( $] ge '5.008' ) { | ||
1223 | 1000 | 2.35ms | 1000 | 448µs | utf8::downgrade($data, 1) # spent 448µs making 1000 calls to utf8::downgrade, avg 448ns/call |
1224 | or die(qq/Wide character in write_content()\n/); | ||||
1225 | } | ||||
1226 | |||||
1227 | 1000 | 1.51ms | 1000 | 40.5ms | $len += $self->write($data); # spent 40.5ms making 1000 calls to HTTP::Tiny::Handle::write, avg 40µs/call |
1228 | } | ||||
1229 | |||||
1230 | 1000 | 494µs | $len == $content_length | ||
1231 | or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/); | ||||
1232 | |||||
1233 | 1000 | 2.01ms | return $len; | ||
1234 | } | ||||
1235 | |||||
1236 | sub read_chunked_body { | ||||
1237 | @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n"); | ||||
1238 | my ($self, $cb, $response) = @_; | ||||
1239 | |||||
1240 | while () { | ||||
1241 | my $head = $self->readline; | ||||
1242 | |||||
1243 | $head =~ /\A ([A-Fa-f0-9]+)/x | ||||
1244 | or die(q/Malformed chunk head: / . $Printable->($head) . "\n"); | ||||
1245 | |||||
1246 | my $len = hex($1) | ||||
1247 | or last; | ||||
1248 | |||||
1249 | $self->read_content_body($cb, $response, $len); | ||||
1250 | |||||
1251 | $self->read(2) eq "\x0D\x0A" | ||||
1252 | or die(qq/Malformed chunk: missing CRLF after chunk data\n/); | ||||
1253 | } | ||||
1254 | $self->read_header_lines($response->{headers}); | ||||
1255 | return 1; | ||||
1256 | } | ||||
1257 | |||||
1258 | sub write_chunked_body { | ||||
1259 | @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n"); | ||||
1260 | my ($self, $request) = @_; | ||||
1261 | |||||
1262 | my $len = 0; | ||||
1263 | while () { | ||||
1264 | my $data = $request->{cb}->(); | ||||
1265 | |||||
1266 | defined $data && length $data | ||||
1267 | or last; | ||||
1268 | |||||
1269 | if ( $] ge '5.008' ) { | ||||
1270 | utf8::downgrade($data, 1) | ||||
1271 | or die(qq/Wide character in write_chunked_body()\n/); | ||||
1272 | } | ||||
1273 | |||||
1274 | $len += length $data; | ||||
1275 | |||||
1276 | my $chunk = sprintf '%X', length $data; | ||||
1277 | $chunk .= "\x0D\x0A"; | ||||
1278 | $chunk .= $data; | ||||
1279 | $chunk .= "\x0D\x0A"; | ||||
1280 | |||||
1281 | $self->write($chunk); | ||||
1282 | } | ||||
1283 | $self->write("0\x0D\x0A"); | ||||
1284 | $self->write_header_lines($request->{trailer_cb}->()) | ||||
1285 | if ref $request->{trailer_cb} eq 'CODE'; | ||||
1286 | return $len; | ||||
1287 | } | ||||
1288 | |||||
1289 | # spent 17.6s (44.4ms+17.6) within HTTP::Tiny::Handle::read_response_header which was called 2002 times, avg 8.80ms/call:
# 2002 times (44.4ms+17.6s) by HTTP::Tiny::_request at line 512, avg 8.80ms/call | ||||
1290 | 2002 | 979µs | @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n"); | ||
1291 | 2002 | 965µs | my ($self) = @_; | ||
1292 | |||||
1293 | 2002 | 4.62ms | 2002 | 17.4s | my $line = $self->readline; # spent 17.4s making 2002 calls to HTTP::Tiny::Handle::readline, avg 8.69ms/call |
1294 | |||||
1295 | 2002 | 17.6ms | 2002 | 6.89ms | $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x # spent 6.89ms making 2002 calls to HTTP::Tiny::Handle::CORE:match, avg 3µs/call |
1296 | or die(q/Malformed Status-Line: / . $Printable->($line). "\n"); | ||||
1297 | |||||
1298 | 2002 | 6.43ms | my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); | ||
1299 | |||||
1300 | 2002 | 8.49ms | 2002 | 4.50ms | die (qq/Unsupported HTTP protocol: $protocol\n/) # spent 4.50ms making 2002 calls to HTTP::Tiny::Handle::CORE:match, avg 2µs/call |
1301 | unless $version =~ /0*1\.0*[01]/; | ||||
1302 | |||||
1303 | return { | ||||
1304 | 2002 | 16.5ms | 2002 | 150ms | status => $status, # spent 150ms making 2002 calls to HTTP::Tiny::Handle::read_header_lines, avg 75µs/call |
1305 | reason => $reason, | ||||
1306 | headers => $self->read_header_lines, | ||||
1307 | protocol => $protocol, | ||||
1308 | }; | ||||
1309 | } | ||||
1310 | |||||
1311 | # spent 208ms (10.7+198) within HTTP::Tiny::Handle::write_request_header which was called 2002 times, avg 104µs/call:
# 2002 times (10.7ms+198ms) by HTTP::Tiny::Handle::write_request at line 1126, avg 104µs/call | ||||
1312 | 2002 | 993µs | @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n"); | ||
1313 | 2002 | 1.17ms | my ($self, $method, $request_uri, $headers) = @_; | ||
1314 | |||||
1315 | 2002 | 8.65ms | 2002 | 198ms | return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A"); # spent 198ms making 2002 calls to HTTP::Tiny::Handle::write_header_lines, avg 99µs/call |
1316 | } | ||||
1317 | |||||
1318 | sub _do_timeout { | ||||
1319 | 5004 | 2.19ms | my ($self, $type, $timeout) = @_; | ||
1320 | $timeout = $self->{timeout} | ||||
1321 | 5004 | 2.86ms | unless defined $timeout && $timeout >= 0; | ||
1322 | |||||
1323 | 5004 | 2.35ms | my $fd = fileno $self->{fh}; | ||
1324 | 5004 | 1.56ms | defined $fd && $fd >= 0 | ||
1325 | or die(qq/select(2): 'Bad file descriptor'\n/); | ||||
1326 | |||||
1327 | 5004 | 1.50ms | my $initial = time; | ||
1328 | 5004 | 1.12ms | my $pending = $timeout; | ||
1329 | 5004 | 668µs | my $nfound; | ||
1330 | |||||
1331 | 5004 | 5.96ms | vec(my $fdset = '', $fd, 1) = 1; | ||
1332 | |||||
1333 | 5004 | 586µs | while () { | ||
1334 | 5004 | 17.3s | 5004 | 17.3s | $nfound = ($type eq 'read') # spent 17.3s making 5004 calls to HTTP::Tiny::Handle::CORE:sselect, avg 3.45ms/call |
1335 | ? select($fdset, undef, undef, $pending) | ||||
1336 | : select(undef, $fdset, undef, $pending) ; | ||||
1337 | 5004 | 1.96ms | if ($nfound == -1) { | ||
1338 | $! == EINTR | ||||
1339 | or die(qq/select(2): '$!'\n/); | ||||
1340 | redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; | ||||
1341 | $nfound = 0; | ||||
1342 | } | ||||
1343 | 5004 | 3.86ms | last; | ||
1344 | } | ||||
1345 | 5004 | 4.49ms | $! = 0; | ||
1346 | 5004 | 41.7ms | return $nfound; | ||
1347 | } | ||||
1348 | |||||
1349 | # spent 17.3s (27.7ms+17.3) within HTTP::Tiny::Handle::can_read which was called 2002 times, avg 8.65ms/call:
# 2002 times (27.7ms+17.3s) by HTTP::Tiny::Handle::readline at line 1062, avg 8.65ms/call | ||||
1350 | 2002 | 1.00ms | @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n"); | ||
1351 | 2002 | 960µs | my $self = shift; | ||
1352 | 2002 | 2.02ms | if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { | ||
1353 | return 1 if $self->{fh}->pending; | ||||
1354 | } | ||||
1355 | 2002 | 8.15ms | 2002 | 17.3s | return $self->_do_timeout('read', @_) # spent 17.3s making 2002 calls to HTTP::Tiny::Handle::_do_timeout, avg 8.64ms/call |
1356 | } | ||||
1357 | |||||
1358 | # spent 64.9ms (24.9+40.0) within HTTP::Tiny::Handle::can_write which was called 3002 times, avg 22µs/call:
# 3002 times (24.9ms+40.0ms) by HTTP::Tiny::Handle::write at line 988, avg 22µs/call | ||||
1359 | 3002 | 1.04ms | @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n"); | ||
1360 | 3002 | 1.12ms | my $self = shift; | ||
1361 | 3002 | 14.5ms | 3002 | 40.0ms | return $self->_do_timeout('write', @_) # spent 40.0ms making 3002 calls to HTTP::Tiny::Handle::_do_timeout, avg 13µs/call |
1362 | } | ||||
1363 | |||||
1364 | sub _assert_ssl { | ||||
1365 | # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback | ||||
1366 | die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/) | ||||
1367 | unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}; | ||||
1368 | # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY | ||||
1369 | die(qq/Net::SSLeay 1.49 must be installed for https support\n/) | ||||
1370 | unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}; | ||||
1371 | } | ||||
1372 | |||||
1373 | sub can_reuse { | ||||
1374 | my ($self,$scheme,$host,$port) = @_; | ||||
1375 | return 0 if | ||||
1376 | $self->{pid} != $$ | ||||
1377 | || $self->{tid} != _get_tid() | ||||
1378 | || length($self->{rbuf}) | ||||
1379 | || $scheme ne $self->{scheme} | ||||
1380 | || $host ne $self->{host} | ||||
1381 | || $port ne $self->{port} | ||||
1382 | || eval { $self->can_read(0) } | ||||
1383 | || $@ ; | ||||
1384 | return 1; | ||||
1385 | } | ||||
1386 | |||||
1387 | # Try to find a CA bundle to validate the SSL cert, | ||||
1388 | # prefer Mozilla::CA or fallback to a system file | ||||
1389 | sub _find_CA_file { | ||||
1390 | my $self = shift(); | ||||
1391 | |||||
1392 | return $self->{SSL_options}->{SSL_ca_file} | ||||
1393 | if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file}; | ||||
1394 | |||||
1395 | return Mozilla::CA::SSL_ca_file() | ||||
1396 | if eval { require Mozilla::CA }; | ||||
1397 | |||||
1398 | # cert list copied from golang src/crypto/x509/root_unix.go | ||||
1399 | foreach my $ca_bundle ( | ||||
1400 | "/etc/ssl/certs/ca-certificates.crt", # Debian/Ubuntu/Gentoo etc. | ||||
1401 | "/etc/pki/tls/certs/ca-bundle.crt", # Fedora/RHEL | ||||
1402 | "/etc/ssl/ca-bundle.pem", # OpenSUSE | ||||
1403 | "/etc/openssl/certs/ca-certificates.crt", # NetBSD | ||||
1404 | "/etc/ssl/cert.pem", # OpenBSD | ||||
1405 | "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly | ||||
1406 | "/etc/pki/tls/cacert.pem", # OpenELEC | ||||
1407 | "/etc/certs/ca-certificates.crt", # Solaris 11.2+ | ||||
1408 | ) { | ||||
1409 | return $ca_bundle if -e $ca_bundle; | ||||
1410 | } | ||||
1411 | |||||
1412 | die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/ | ||||
1413 | . qq/Try installing Mozilla::CA from CPAN\n/; | ||||
1414 | } | ||||
1415 | |||||
1416 | # for thread safety, we need to know thread id if threads are loaded | ||||
1417 | # spent 24.0ms (20.7+3.24) within HTTP::Tiny::Handle::_get_tid which was called 2002 times, avg 12µs/call:
# 2002 times (20.7ms+3.24ms) by HTTP::Tiny::Handle::connect at line 932, avg 12µs/call | ||||
1418 | 2 | 143µs | 2 | 52µs | # spent 34µs (17+17) within HTTP::Tiny::Handle::BEGIN@1418 which was called:
# once (17µs+17µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 1418 # spent 34µs making 1 call to HTTP::Tiny::Handle::BEGIN@1418
# spent 17µs making 1 call to warnings::unimport |
1419 | 2002 | 31.3ms | 2002 | 3.24ms | return threads->can("tid") ? threads->tid : 0; # spent 3.24ms making 2002 calls to UNIVERSAL::can, avg 2µs/call |
1420 | } | ||||
1421 | |||||
1422 | sub _ssl_args { | ||||
1423 | my ($self, $host) = @_; | ||||
1424 | |||||
1425 | my %ssl_args; | ||||
1426 | |||||
1427 | # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't | ||||
1428 | # added until IO::Socket::SSL 1.84 | ||||
1429 | if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) { | ||||
1430 | $ssl_args{SSL_hostname} = $host, # Sane SNI support | ||||
1431 | } | ||||
1432 | |||||
1433 | if ($self->{verify_SSL}) { | ||||
1434 | $ssl_args{SSL_verifycn_scheme} = 'http'; # enable CN validation | ||||
1435 | $ssl_args{SSL_verifycn_name} = $host; # set validation hostname | ||||
1436 | $ssl_args{SSL_verify_mode} = 0x01; # enable cert validation | ||||
1437 | $ssl_args{SSL_ca_file} = $self->_find_CA_file; | ||||
1438 | } | ||||
1439 | else { | ||||
1440 | $ssl_args{SSL_verifycn_scheme} = 'none'; # disable CN validation | ||||
1441 | $ssl_args{SSL_verify_mode} = 0x00; # disable cert validation | ||||
1442 | } | ||||
1443 | |||||
1444 | # user options override settings from verify_SSL | ||||
1445 | for my $k ( keys %{$self->{SSL_options}} ) { | ||||
1446 | $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/; | ||||
1447 | } | ||||
1448 | |||||
1449 | return \%ssl_args; | ||||
1450 | } | ||||
1451 | |||||
1452 | 1 | 14µs | 1; | ||
1453 | |||||
1454 | __END__ | ||||
# spent 10.1ms within HTTP::Tiny::CORE:match which was called 8008 times, avg 1µs/call:
# 2002 times (6.15ms+0s) by HTTP::Tiny::_split_url at line 785, avg 3µs/call
# 2002 times (1.70ms+0s) by HTTP::Tiny::_split_url at line 789, avg 851ns/call
# 2002 times (1.18ms+0s) by HTTP::Tiny::_maybe_redirect at line 769, avg 588ns/call
# 1001 times (618µs+0s) by HTTP::Tiny::_request at line 522, avg 617ns/call
# 1001 times (481µs+0s) by HTTP::Tiny::agent at line 93, avg 481ns/call | |||||
# spent 2µs within HTTP::Tiny::CORE:qr which was called:
# once (2µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 844 | |||||
sub HTTP::Tiny::CORE:subst; # opcode | |||||
# spent 2.84ms within HTTP::Tiny::Handle::CORE:binmode which was called 2002 times, avg 1µs/call:
# 2002 times (2.84ms+0s) by HTTP::Tiny::Handle::connect at line 924, avg 1µs/call | |||||
# spent 22.4ms within HTTP::Tiny::Handle::CORE:match which was called 16019 times, avg 1µs/call:
# 11010 times (10.7ms+0s) by HTTP::Tiny::Handle::read_header_lines at line 1090, avg 972ns/call
# 2002 times (6.89ms+0s) by HTTP::Tiny::Handle::read_response_header at line 1295, avg 3µs/call
# 2002 times (4.50ms+0s) by HTTP::Tiny::Handle::read_response_header at line 1300, avg 2µs/call
# 1001 times (332µs+0s) by HTTP::Tiny::Handle::read_body at line 1173, avg 332ns/call
# 4 times (5µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1152, avg 1µs/call | |||||
# spent 900ns within HTTP::Tiny::Handle::CORE:qr which was called:
# once (900ns+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 887 | |||||
# spent 24µs within HTTP::Tiny::Handle::CORE:regcomp which was called:
# once (24µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1152 | |||||
# spent 17.3s within HTTP::Tiny::Handle::CORE:sselect which was called 5004 times, avg 3.45ms/call:
# 5004 times (17.3s+0s) by HTTP::Tiny::Handle::_do_timeout at line 1334, avg 3.45ms/call | |||||
sub HTTP::Tiny::Handle::CORE:subst; # opcode | |||||
# spent 7µs within HTTP::Tiny::Handle::CORE:substcont which was called 11 times, avg 618ns/call:
# 11 times (7µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1154, avg 618ns/call | |||||
# spent 18.2ms within HTTP::Tiny::Handle::CORE:sysread which was called 2002 times, avg 9µs/call:
# 2002 times (18.2ms+0s) by HTTP::Tiny::Handle::readline at line 1063, avg 9µs/call | |||||
# spent 53.7ms within HTTP::Tiny::Handle::CORE:syswrite which was called 3002 times, avg 18µs/call:
# 3002 times (53.7ms+0s) by HTTP::Tiny::Handle::write at line 990, avg 18µs/call |