Filename | /opt/flows/lib/lib/perl5/HTTP/Tiny.pm |
Statements | Executed 823 statements in 14.0ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5 | 1 | 1 | 2.63ms | 2.63ms | CORE:sselect (opcode) | HTTP::Tiny::Handle::
2 | 1 | 1 | 124µs | 4.36ms | _request | HTTP::Tiny::
8 | 2 | 1 | 112µs | 2.86ms | readline | HTTP::Tiny::Handle::
5 | 2 | 1 | 91µs | 2.72ms | _do_timeout | HTTP::Tiny::Handle::
2 | 1 | 1 | 87µs | 285µs | write_header_lines | HTTP::Tiny::Handle::
2 | 1 | 1 | 84µs | 144µs | read_header_lines | HTTP::Tiny::Handle::
2 | 1 | 1 | 70µs | 169µs | write | HTTP::Tiny::Handle::
2 | 1 | 1 | 64µs | 3.04ms | read_response_header | HTTP::Tiny::Handle::
1 | 1 | 1 | 56µs | 56µs | BEGIN@65 | HTTP::Tiny::
2 | 1 | 1 | 48µs | 48µs | CORE:syswrite (opcode) | HTTP::Tiny::Handle::
1 | 1 | 1 | 47µs | 683µs | connect | HTTP::Tiny::Handle::
2 | 1 | 1 | 36µs | 51µs | _split_url | HTTP::Tiny::
16 | 4 | 1 | 35µs | 35µs | CORE:match (opcode) | HTTP::Tiny::Handle::
3 | 2 | 1 | 35µs | 2.72ms | can_read | HTTP::Tiny::Handle::
2 | 1 | 1 | 31µs | 31µs | _prepare_headers_and_cb | HTTP::Tiny::
1 | 1 | 1 | 30µs | 81µs | new | HTTP::Tiny::
12 | 2 | 1 | 30µs | 30µs | CORE:subst (opcode) | HTTP::Tiny::Handle::
2 | 1 | 1 | 29µs | 4.39ms | request | HTTP::Tiny::
2 | 1 | 1 | 27µs | 27µs | CORE:sysread (opcode) | HTTP::Tiny::Handle::
2 | 1 | 1 | 26µs | 27µs | _maybe_redirect | HTTP::Tiny::
1 | 1 | 1 | 26µs | 39µs | timeout | HTTP::Tiny::Handle::
2 | 1 | 1 | 20µs | 20µs | CORE:regcomp (opcode) | HTTP::Tiny::Handle::
1 | 1 | 1 | 20µs | 54µs | can_reuse | HTTP::Tiny::Handle::
1 | 1 | 1 | 18µs | 715µs | _open_handle | HTTP::Tiny::
2 | 1 | 1 | 18µs | 318µs | write_request | HTTP::Tiny::Handle::
2 | 2 | 1 | 17µs | 21µs | _get_tid | HTTP::Tiny::Handle::
1 | 1 | 1 | 17µs | 17µs | _set_proxies | HTTP::Tiny::
1 | 1 | 1 | 16µs | 24µs | _agent | HTTP::Tiny::
2 | 1 | 1 | 16µs | 50µs | can_write | HTTP::Tiny::Handle::
2 | 1 | 1 | 15µs | 301µs | write_request_header | HTTP::Tiny::Handle::
1 | 1 | 1 | 15µs | 33µs | BEGIN@3 | HTTP::Tiny::
1 | 1 | 1 | 15µs | 28µs | BEGIN@205 | HTTP::Tiny::
2 | 1 | 1 | 14µs | 53µs | timeout | HTTP::Tiny::
1 | 1 | 1 | 13µs | 13µs | new | HTTP::Tiny::Handle::
7 | 4 | 1 | 13µs | 13µs | CORE:match (opcode) | HTTP::Tiny::
1 | 1 | 1 | 12µs | 24µs | BEGIN@1594 | HTTP::Tiny::Handle::
1 | 1 | 1 | 12µs | 14µs | BEGIN@969 | HTTP::Tiny::
1 | 1 | 1 | 11µs | 23µs | BEGIN@74 | HTTP::Tiny::
1 | 1 | 1 | 10µs | 322µs | BEGIN@981 | HTTP::Tiny::Handle::
1 | 1 | 1 | 10µs | 611µs | BEGIN@982 | HTTP::Tiny::Handle::
1 | 1 | 1 | 10µs | 39µs | BEGIN@983 | HTTP::Tiny::Handle::
1 | 1 | 1 | 9µs | 16µs | BEGIN@979 | HTTP::Tiny::Handle::
1 | 1 | 1 | 9µs | 9µs | agent | HTTP::Tiny::
1 | 1 | 1 | 8µs | 13µs | BEGIN@4 | HTTP::Tiny::
1 | 1 | 1 | 8µs | 19µs | BEGIN@75 | HTTP::Tiny::
1 | 1 | 1 | 8µs | 22µs | BEGIN@978 | HTTP::Tiny::Handle::
3 | 2 | 1 | 7µs | 7µs | CORE:subst (opcode) | HTTP::Tiny::
1 | 1 | 1 | 4µs | 4µs | BEGIN@9 | HTTP::Tiny::
1 | 1 | 1 | 3µs | 3µs | CORE:qr (opcode) | HTTP::Tiny::
2 | 2 | 1 | 2µs | 2µs | CORE:qr (opcode) | HTTP::Tiny::Handle::
1 | 1 | 1 | 2µs | 2µs | CORE:binmode (opcode) | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | __ANON__[:1002] | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | __ANON__[:1093] | 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 | close | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | read | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | read_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | read_chunked_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | read_content_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | start_ssl | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | write_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | write_chunked_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | write_content_body | HTTP::Tiny::Handle::
0 | 0 | 0 | 0s | 0s | __ANON__[:294] | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:806] | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:845] | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:848] | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:84] | 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 | _prepare_data_cb | 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 | can_ssl | HTTP::Tiny::
0 | 0 | 0 | 0s | 0s | connected | 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 | 29µs | 2 | 51µ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 # spent 33µs making 1 call to HTTP::Tiny::BEGIN@3
# spent 18µs making 1 call to strict::import |
4 | 2 | 42µs | 2 | 18µ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 # 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 | |||||
7 | 1 | 700ns | our $VERSION = '0.058'; | ||
8 | |||||
9 | 2 | 106µs | 1 | 4µ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 # 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 | |||||
64 | 1 | 200ns | my @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 | ||||
66 | 1 | 7µ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 | ); | ||||
71 | 1 | 5µs | my %persist_ok = map {; $_ => 1 } qw( | ||
72 | cookie_jar default_headers max_redirect max_size | ||||
73 | ); | ||||
74 | 2 | 30µs | 2 | 35µ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 # spent 23µs making 1 call to HTTP::Tiny::BEGIN@74
# spent 12µs making 1 call to strict::unimport |
75 | 2 | 109µs | 2 | 29µ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 # spent 19µs making 1 call to HTTP::Tiny::BEGIN@75
# spent 10µs making 1 call to warnings::unimport |
76 | 1 | 6µ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}; | ||||
84 | 12 | 40µs | }; | ||
85 | } | ||||
86 | 1 | 537µs | 1 | 56µ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 | ||||
89 | 1 | 700ns | my($self, $agent) = @_; | ||
90 | 1 | 1µs | if( @_ > 1 ){ | ||
91 | 1 | 6µs | 1 | 600ns | $self->{agent} = # spent 600ns making 1 call to HTTP::Tiny::CORE:match |
92 | (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent; | ||||
93 | } | ||||
94 | 1 | 3µ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 | ||||
98 | 2 | 1µs | my ($self, $timeout) = @_; | ||
99 | 2 | 2µs | if ( @_ > 1 ) { | ||
100 | 2 | 2µs | $self->{timeout} = $timeout; | ||
101 | 2 | 4µs | 1 | 39µs | if ($self->{handle}) { # spent 39µs making 1 call to HTTP::Tiny::Handle::timeout |
102 | $self->{handle}->timeout($timeout); | ||||
103 | } | ||||
104 | } | ||||
105 | 2 | 6µ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 | ||||
109 | 1 | 2µs | my($class, %args) = @_; | ||
110 | |||||
111 | 1 | 4µ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 | |||||
119 | 1 | 1µs | bless $self, $class; | ||
120 | |||||
121 | 1 | 600ns | $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar}; | ||
122 | |||||
123 | 1 | 1µs | for my $key ( @attributes ) { | ||
124 | 12 | 7µs | $self->{$key} = $args{$key} if exists $args{$key} | ||
125 | } | ||||
126 | |||||
127 | 1 | 6µs | 2 | 34µ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 | |||||
129 | 1 | 2µs | 1 | 17µs | $self->_set_proxies; # spent 17µs making 1 call to HTTP::Tiny::_set_proxies |
130 | |||||
131 | 1 | 4µ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 | ||||
135 | 1 | 400ns | 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 | ||||
141 | 1 | 4µs | if (! exists $self->{proxy} ) { | ||
142 | $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY}; | ||||
143 | } | ||||
144 | |||||
145 | 1 | 1µs | if ( defined $self->{proxy} ) { | ||
146 | $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate | ||||
147 | } | ||||
148 | else { | ||||
149 | 1 | 900ns | delete $self->{proxy}; | ||
150 | } | ||||
151 | |||||
152 | # http proxy | ||||
153 | 1 | 700ns | if (! exists $self->{http_proxy} ) { | ||
154 | # under CGI, bypass HTTP_PROXY as request sets it from Proxy header | ||||
155 | 1 | 500ns | local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD}; | ||
156 | 1 | 1µs | $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy}; | ||
157 | } | ||||
158 | |||||
159 | 1 | 900ns | if ( defined $self->{http_proxy} ) { | ||
160 | $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate | ||||
161 | $self->{_has_proxy}{http} = 1; | ||||
162 | } | ||||
163 | else { | ||||
164 | 1 | 700ns | delete $self->{http_proxy}; | ||
165 | } | ||||
166 | |||||
167 | # https proxy | ||||
168 | 1 | 2µs | if (! exists $self->{https_proxy} ) { | ||
169 | $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy}; | ||||
170 | } | ||||
171 | |||||
172 | 1 | 500ns | if ( $self->{https_proxy} ) { | ||
173 | $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate | ||||
174 | $self->{_has_proxy}{https} = 1; | ||||
175 | } | ||||
176 | else { | ||||
177 | 1 | 500ns | delete $self->{https_proxy}; | ||
178 | } | ||||
179 | |||||
180 | # Split no_proxy to array reference if not provided as such | ||||
181 | 1 | 900ns | unless ( ref $self->{no_proxy} eq 'ARRAY' ) { | ||
182 | 1 | 1µs | $self->{no_proxy} = | ||
183 | (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : []; | ||||
184 | } | ||||
185 | |||||
186 | 1 | 3µ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 | |||||
203 | 1 | 1µs | for my $sub_name ( qw/get head put post delete/ ) { | ||
204 | 5 | 4µs | my $req_method = uc $sub_name; | ||
205 | 2 | 3.81ms | 2 | 41µ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 # spent 28µs making 1 call to HTTP::Tiny::BEGIN@205
# spent 13µs making 1 call to strict::unimport |
206 | 5 | 386µ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 | } | ||||
213 | HERE | ||||
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 | |||||
236 | sub 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 | |||||
281 | sub 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 | |||||
406 | 1 | 6µs | my %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 | ||||
409 | 2 | 2µs | my ($self, $method, $url, $args) = @_; | ||
410 | 2 | 4µs | @_ == 3 || (@_ == 4 && ref $args eq 'HASH') | ||
411 | or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n"); | ||||
412 | 2 | 500ns | $args ||= {}; # we keep some state in this during _request | ||
413 | |||||
414 | # RFC 2616 Section 8.1.4 mandates a single retry on broken socket | ||||
415 | 2 | 200ns | my $response; | ||
416 | 2 | 2µs | for ( 0 .. 1 ) { | ||
417 | 4 | 8µs | 2 | 4.36ms | $response = eval { $self->_request($method, $url, $args) }; # spent 4.36ms making 2 calls to HTTP::Tiny::_request, avg 2.18ms/call |
418 | 2 | 2µs | last unless $@ && $idempotent{$method} | ||
419 | && $@ =~ m{^(?:Socket closed|Unexpected end)}; | ||||
420 | } | ||||
421 | |||||
422 | 2 | 2µ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 | } | ||||
442 | 2 | 10µ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 | |||||
459 | sub 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 | |||||
501 | sub 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 | |||||
551 | sub 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 | |||||
572 | 1 | 1µs | my %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 | ||||
578 | 1 | 1µs | my $class = ref($_[0]) || $_[0]; | ||
579 | 1 | 8µs | 1 | 3µs | (my $default_agent = $class) =~ s{::}{-}g; # spent 3µs making 1 call to HTTP::Tiny::CORE:subst |
580 | 1 | 17µs | 1 | 5µ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 | ||||
584 | 2 | 2µs | my ($self, $method, $url, $args) = @_; | ||
585 | |||||
586 | 2 | 7µs | 2 | 51µ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 | |||||
588 | 2 | 15µ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 | |||||
598 | 2 | 2µ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 | ||||
603 | 2 | 2µs | my $handle = delete $self->{handle}; | ||
604 | 2 | 900ns | if ( $handle ) { | ||
605 | 1 | 4µs | 1 | 54µ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 | } | ||||
610 | 2 | 3µs | 1 | 715µs | $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer ); # spent 715µs making 1 call to HTTP::Tiny::_open_handle |
611 | |||||
612 | 2 | 6µs | 2 | 31µ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 |
613 | 2 | 5µs | 2 | 318µs | $handle->write_request($request); # spent 318µs making 2 calls to HTTP::Tiny::Handle::write_request, avg 159µs/call |
614 | |||||
615 | 2 | 500ns | my $response; | ||
616 | 2 | 12µs | 2 | 3.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 | |||||
619 | 2 | 2µs | $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar}; | ||
620 | 2 | 10µs | 2 | 27µ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 | |||||
622 | 2 | 400ns | my $known_message_length; | ||
623 | 2 | 2µ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 | |||||
634 | 2 | 9µ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 | |||||
645 | 2 | 5µs | $response->{success} = substr( $response->{status}, 0, 1 ) eq '2'; | ||
646 | 2 | 2µs | $response->{url} = $url; | ||
647 | |||||
648 | # Push the current response onto the stack of redirects if redirecting. | ||||
649 | 2 | 900ns | 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} | ||||
656 | 2 | 2µs | if @{$args->{_redirects}}; | ||
657 | 2 | 20µ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 | ||||
661 | 1 | 1µs | my ($self, $request, $scheme, $host, $port, $peer) = @_; | ||
662 | |||||
663 | 1 | 8µs | 1 | 13µ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 | |||||
671 | 1 | 1µs | if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) { | ||
672 | return $self->_proxy_connect( $request, $handle ); | ||||
673 | } | ||||
674 | else { | ||||
675 | 1 | 5µs | 1 | 683µs | return $handle->connect($scheme, $host, $port, $peer); # spent 683µs making 1 call to HTTP::Tiny::Handle::connect |
676 | } | ||||
677 | } | ||||
678 | |||||
679 | sub _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 | |||||
714 | sub _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 | |||||
729 | sub _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 | ||||
769 | 2 | 2µs | my ($self, $request, $args, $url, $auth) = @_; | ||
770 | |||||
771 | 2 | 6µs | for ($self->{default_headers}, $args->{headers}) { | ||
772 | 4 | 2µs | next unless defined; | ||
773 | 2 | 4µs | while (my ($k, $v) = each %$_) { | ||
774 | $request->{headers}{lc $k} = $v; | ||||
775 | $request->{header_case}{lc $k} = $k; | ||||
776 | } | ||||
777 | } | ||||
778 | |||||
779 | 2 | 2µs | if (exists $request->{headers}{'host'}) { | ||
780 | die(qq/The 'Host' header must not be provided as header option\n/); | ||||
781 | } | ||||
782 | |||||
783 | 2 | 3µs | $request->{headers}{'host'} = $request->{host_port}; | ||
784 | 2 | 3µs | $request->{headers}{'user-agent'} ||= $self->{agent}; | ||
785 | 2 | 1µs | $request->{headers}{'connection'} = "close" | ||
786 | unless $self->{keep_alive}; | ||||
787 | |||||
788 | 2 | 2µ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 | ||||
813 | 2 | 1µ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 | ||||
819 | 2 | 1µs | if ( length $auth && ! defined $request->{headers}{authorization} ) { | ||
820 | $self->_add_basic_auth_header( $request, 'authorization' => $auth ); | ||||
821 | } | ||||
822 | |||||
823 | 2 | 6µs | return; | ||
824 | } | ||||
825 | |||||
826 | sub _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 | |||||
834 | sub _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 | |||||
854 | sub _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 | |||||
867 | sub _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 | ||||
880 | 2 | 2µs | my ($self, $request, $response, $args) = @_; | ||
881 | 2 | 1µs | my $headers = $response->{headers}; | ||
882 | 2 | 5µs | my ($status, $method) = ($response->{status}, $request->{method}); | ||
883 | 2 | 4µs | $args->{_redirects} ||= []; | ||
884 | |||||
885 | 2 | 10µs | 2 | 1µ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 | } | ||||
894 | 2 | 10µ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 | ||||
898 | 2 | 2µs | my $url = pop; | ||
899 | |||||
900 | # URI regex adapted from the URI module | ||||
901 | 2 | 16µs | 2 | 8µ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 | |||||
904 | 2 | 2µs | $scheme = lc $scheme; | ||
905 | 2 | 7µs | 2 | 2µ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 | |||||
907 | 2 | 1µs | my $auth = ''; | ||
908 | 2 | 2µ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 | } | ||||
916 | 2 | 14µs | 2 | 4µ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 | |||||
921 | 2 | 9µs | return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth); | ||
922 | } | ||||
923 | |||||
924 | # Date conversions adapted from HTTP::Date | ||||
925 | 1 | 400ns | my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat"; | ||
926 | 1 | 200ns | my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec"; | ||
927 | sub _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 | |||||
936 | sub _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 | ||||
958 | 257 | 307µs | my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; | ||
959 | 1 | 800ns | $escapes{' '}="+"; | ||
960 | 1 | 11µs | 1 | 3µs | my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/; # spent 3µs making 1 call to HTTP::Tiny::CORE:qr |
961 | |||||
962 | sub _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 | ||||
969 | 2 | 100µs | 2 | 16µ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 # 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 | |||||
976 | package | ||||
977 | HTTP::Tiny::Handle; # hide from PAUSE/indexers | ||||
978 | 2 | 28µs | 2 | 36µ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 # spent 22µs making 1 call to HTTP::Tiny::Handle::BEGIN@978
# spent 14µs making 1 call to strict::import |
979 | 2 | 38µs | 2 | 23µ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 # spent 16µs making 1 call to HTTP::Tiny::Handle::BEGIN@979
# spent 7µs making 1 call to warnings::import |
980 | |||||
981 | 2 | 37µs | 2 | 634µ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 # spent 322µs making 1 call to HTTP::Tiny::Handle::BEGIN@981
# spent 312µs making 1 call to Exporter::import |
982 | 2 | 43µs | 2 | 1.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 # spent 611µs making 1 call to HTTP::Tiny::Handle::BEGIN@982
# spent 600µs making 1 call to IO::Socket::import |
983 | 2 | 4.07ms | 2 | 69µ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 # 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 | ||||
988 | my $SOCKET_CLASS = | ||||
989 | $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' : | ||||
990 | 2 | 43µs | eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' : | ||
991 | 'IO::Socket::INET'; | ||||
992 | |||||
993 | sub BUFSIZE () { 32768 } ## no critic | ||||
994 | |||||
995 | my $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 | $_; | ||||
1002 | 1 | 3µs | }; | ||
1003 | |||||
1004 | 1 | 7µs | 1 | 2µs | my $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 |
1005 | 1 | 3µs | 1 | 800ns | my $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 | ||||
1008 | 1 | 3µs | my ($class, %args) = @_; | ||
1009 | 1 | 13µ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 | ||||
1021 | 1 | 800ns | my ($self, $timeout) = @_; | ||
1022 | 1 | 1µs | if ( @_ > 1 ) { | ||
1023 | 1 | 1µs | $self->{timeout} = $timeout; | ||
1024 | 1 | 21µs | 2 | 13µ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 | } | ||||
1028 | 1 | 4µ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 | ||||
1032 | 1 | 600ns | @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n"); | ||
1033 | 1 | 4µs | my ($self, $scheme, $host, $port, $peer) = @_; | ||
1034 | |||||
1035 | 1 | 800ns | if ( $scheme eq 'https' ) { | ||
1036 | $self->_assert_ssl; | ||||
1037 | } | ||||
1038 | elsif ( $scheme ne 'http' ) { | ||||
1039 | die(qq/Unsupported URL scheme '$scheme'\n/); | ||||
1040 | } | ||||
1041 | 1 | 13µs | 1 | 610µ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 | |||||
1051 | 1 | 7µs | 1 | 2µ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 | |||||
1054 | 1 | 1µs | if ( $self->{keep_alive} ) { | ||
1055 | 1 | 8µs | 1 | 13µ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 | |||||
1061 | 1 | 700ns | $self->start_ssl($host) if $scheme eq 'https'; | ||
1062 | |||||
1063 | 1 | 1µs | $self->{scheme} = $scheme; | ||
1064 | 1 | 700ns | $self->{host} = $host; | ||
1065 | 1 | 4µs | $self->{peer} = $peer; | ||
1066 | 1 | 700ns | $self->{port} = $port; | ||
1067 | 1 | 1µs | $self->{pid} = $$; | ||
1068 | 1 | 3µs | 1 | 11µs | $self->{tid} = _get_tid(); # spent 11µs making 1 call to HTTP::Tiny::Handle::_get_tid |
1069 | |||||
1070 | 1 | 3µs | return $self; | ||
1071 | } | ||||
1072 | |||||
1073 | sub 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 | |||||
1102 | sub 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 | ||||
1110 | 2 | 1µs | @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n"); | ||
1111 | 2 | 2µs | my ($self, $buf) = @_; | ||
1112 | |||||
1113 | 2 | 2µs | if ( $] ge '5.008' ) { | ||
1114 | 2 | 7µs | 2 | 2µ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 | |||||
1118 | 2 | 1µs | my $len = length $buf; | ||
1119 | 2 | 800ns | my $off = 0; | ||
1120 | |||||
1121 | 2 | 19µs | local $SIG{PIPE} = 'IGNORE'; | ||
1122 | |||||
1123 | 2 | 400ns | while () { | ||
1124 | 2 | 5µs | 2 | 50µ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/); | ||||
1126 | 2 | 62µs | 2 | 48µ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 |
1127 | 2 | 1µs | if (defined $r) { | ||
1128 | 2 | 1µs | $len -= $r; | ||
1129 | 2 | 800ns | $off += $r; | ||
1130 | 2 | 2µ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 | } | ||||
1146 | 2 | 14µs | return $off; | ||
1147 | } | ||||
1148 | |||||
1149 | sub 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 | sub readline { | ||||
1187 | 8 | 3µs | @_ == 1 || die(q/Usage: $handle->readline()/ . "\n"); | ||
1188 | 8 | 2µs | my ($self) = @_; | ||
1189 | |||||
1190 | 8 | 1µs | while () { | ||
1191 | 10 | 97µs | 10 | 28µ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 | } | ||||
1194 | 2 | 3µ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 | ||||
1198 | 2 | 4µs | 2 | 2.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 |
1199 | 2 | 57µs | 2 | 27µ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 |
1200 | 2 | 4µs | if (defined $r) { | ||
1201 | 2 | 1µ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 | ||||
1217 | 2 | 2µs | @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n"); | ||
1218 | 2 | 2µs | my ($self, $headers) = @_; | ||
1219 | 2 | 3µs | $headers ||= {}; | ||
1220 | 2 | 1µs | my $lines = 0; | ||
1221 | 2 | 500ns | my $val; | ||
1222 | |||||
1223 | 2 | 700ns | while () { | ||
1224 | 6 | 10µs | 6 | 45µs | my $line = $self->readline; # spent 45µs making 6 calls to HTTP::Tiny::Handle::readline, avg 7µs/call |
1225 | |||||
1226 | 6 | 44µs | 10 | 16µ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) { | ||||
1230 | 4 | 9µs | my ($field_name) = lc $1; | ||
1231 | 4 | 4µ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 { | ||||
1239 | 4 | 8µ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) { | ||||
1250 | 2 | 2µs | last; | ||
1251 | } | ||||
1252 | else { | ||||
1253 | die(q/Malformed header line: / . $Printable->($line) . "\n"); | ||||
1254 | } | ||||
1255 | } | ||||
1256 | 2 | 10µ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 | ||||
1260 | 2 | 1µs | @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n"); | ||
1261 | 2 | 900ns | my($self, $request) = @_; | ||
1262 | 2 | 10µs | 2 | 301µ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 |
1263 | 2 | 2µs | $self->write_body($request) if $request->{cb}; | ||
1264 | 2 | 5µs | return; | ||
1265 | } | ||||
1266 | |||||
1267 | # Standard request header names/case from HTTP/1.1 RFCs | ||||
1268 | 1 | 4µs | my @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 | |||||
1276 | 1 | 1µs | my @other_request_headers = qw( | ||
1277 | Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin | ||||
1278 | X-XSS-Protection | ||||
1279 | ); | ||||
1280 | |||||
1281 | 1 | 27µs | my %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 | ||||
1286 | 2 | 4µs | (@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n"); | ||
1287 | 2 | 2µs | my($self, $headers, $header_case, $prefix_data) = @_; | ||
1288 | 2 | 2µs | $header_case ||= {}; | ||
1289 | |||||
1290 | 2 | 1µs | my $buf = (defined $prefix_data ? $prefix_data : ''); | ||
1291 | |||||
1292 | # Per RFC, control fields should be listed first | ||||
1293 | 2 | 600ns | my %seen; | ||
1294 | 2 | 5µs | for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) { | ||
1295 | 14 | 4µs | next unless exists $headers->{$k}; | ||
1296 | 2 | 2µs | $seen{$k}++; | ||
1297 | 2 | 2µs | my $field_name = $HeaderCase{$k}; | ||
1298 | 2 | 1µs | my $v = $headers->{$k}; | ||
1299 | 2 | 3µs | for (ref $v eq 'ARRAY' ? @$v : $v) { | ||
1300 | 2 | 400ns | $_ = '' unless defined $_; | ||
1301 | 2 | 3µs | $buf .= "$field_name: $_\x0D\x0A"; | ||
1302 | } | ||||
1303 | } | ||||
1304 | |||||
1305 | # Other headers sent in arbitrary order | ||||
1306 | 2 | 8µs | while (my ($k, $v) = each %$headers) { | ||
1307 | 4 | 2µs | my $field_name = lc $k; | ||
1308 | 4 | 2µs | next if $seen{$field_name}; | ||
1309 | 2 | 2µ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 | } | ||||
1323 | 2 | 3µs | for (ref $v eq 'ARRAY' ? @$v : $v) { | ||
1324 | # unwrap a field value if pre-wrapped by user | ||||
1325 | 2 | 11µs | 2 | 2µs | s/\x0D?\x0A\s+/ /g; # spent 2µs making 2 calls to HTTP::Tiny::Handle::CORE:subst, avg 1µs/call |
1326 | 2 | 42µs | 4 | 26µ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; | ||||
1328 | 2 | 700ns | $_ = '' unless defined $_; | ||
1329 | 2 | 5µs | $buf .= "$field_name: $_\x0D\x0A"; | ||
1330 | } | ||||
1331 | } | ||||
1332 | 2 | 1µs | $buf .= "\x0D\x0A"; | ||
1333 | 2 | 12µs | 2 | 169µ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 | ||||
1339 | sub 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 | |||||
1349 | sub 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 | |||||
1360 | sub 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 | |||||
1381 | sub 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 | |||||
1406 | sub 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 | |||||
1428 | sub 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 | ||||
1460 | 2 | 1µs | @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n"); | ||
1461 | 2 | 1µs | my ($self) = @_; | ||
1462 | |||||
1463 | 2 | 5µs | 2 | 2.82ms | my $line = $self->readline; # spent 2.82ms making 2 calls to HTTP::Tiny::Handle::readline, avg 1.41ms/call |
1464 | |||||
1465 | 2 | 18µs | 2 | 9µ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 | |||||
1468 | 2 | 9µs | my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); | ||
1469 | |||||
1470 | 2 | 11µs | 2 | 5µ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 { | ||||
1474 | 2 | 26µs | 2 | 144µ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 | ||||
1482 | 2 | 900ns | @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n"); | ||
1483 | 2 | 2µs | my ($self, $method, $request_uri, $headers, $header_case) = @_; | ||
1484 | |||||
1485 | 2 | 11µs | 2 | 285µ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 | sub _do_timeout { | ||||
1489 | 5 | 3µs | my ($self, $type, $timeout) = @_; | ||
1490 | 5 | 4µs | $timeout = $self->{timeout} | ||
1491 | unless defined $timeout && $timeout >= 0; | ||||
1492 | |||||
1493 | 5 | 4µs | my $fd = fileno $self->{fh}; | ||
1494 | 5 | 2µs | defined $fd && $fd >= 0 | ||
1495 | or die(qq/select(2): 'Bad file descriptor'\n/); | ||||
1496 | |||||
1497 | 5 | 2µs | my $initial = time; | ||
1498 | 5 | 1µs | my $pending = $timeout; | ||
1499 | 5 | 600ns | my $nfound; | ||
1500 | |||||
1501 | 5 | 9µs | vec(my $fdset = '', $fd, 1) = 1; | ||
1502 | |||||
1503 | 5 | 900ns | while () { | ||
1504 | 5 | 2.67ms | 5 | 2.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) ; | ||||
1507 | 5 | 3µ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 | } | ||||
1513 | 5 | 5µs | last; | ||
1514 | } | ||||
1515 | 5 | 6µs | $! = 0; | ||
1516 | 5 | 37µs | return $nfound; | ||
1517 | } | ||||
1518 | |||||
1519 | sub can_read { | ||||
1520 | 3 | 2µs | @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n"); | ||
1521 | 3 | 1µs | my $self = shift; | ||
1522 | 3 | 3µs | if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { | ||
1523 | return 1 if $self->{fh}->pending; | ||||
1524 | } | ||||
1525 | 3 | 22µs | 3 | 2.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 | ||||
1529 | 2 | 1µs | @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n"); | ||
1530 | 2 | 1µs | my $self = shift; | ||
1531 | 2 | 8µs | 2 | 34µs | return $self->_do_timeout('write', @_) # spent 34µs making 2 calls to HTTP::Tiny::Handle::_do_timeout, avg 17µs/call |
1532 | } | ||||
1533 | |||||
1534 | sub _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 | ||||
1540 | 1 | 1µ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} | ||||
1549 | 2 | 14µs | 2 | 34µ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 | || $@ ; | ||||
1551 | 1 | 4µ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 | ||||
1556 | sub _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 | sub _get_tid { | ||||
1594 | 2 | 246µs | 2 | 36µ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 # spent 24µs making 1 call to HTTP::Tiny::Handle::BEGIN@1594
# spent 12µs making 1 call to warnings::unimport |
1595 | 2 | 24µs | 2 | 4µs | return threads->can("tid") ? threads->tid : 0; # spent 4µs making 2 calls to UNIVERSAL::can, avg 2µs/call |
1596 | } | ||||
1597 | |||||
1598 | sub _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 | |||||
1628 | 1 | 24µs | 1; | ||
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 | |||||
# 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: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 | |||||
# 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: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 | |||||
# 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: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 | |||||
# 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 |