| 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 | HTTP::Tiny::Handle::CORE:sselect (opcode) |
| 2002 | 1 | 1 | 142ms | 19.3s | HTTP::Tiny::_request |
| 2002 | 1 | 1 | 104ms | 150ms | HTTP::Tiny::Handle::read_header_lines |
| 3002 | 2 | 1 | 75.7ms | 195ms | HTTP::Tiny::Handle::write |
| 9008 | 2 | 1 | 73.1ms | 17.4s | HTTP::Tiny::Handle::readline |
| 5004 | 2 | 1 | 72.0ms | 17.3s | HTTP::Tiny::Handle::_do_timeout |
| 2002 | 1 | 1 | 70.4ms | 953ms | HTTP::Tiny::Handle::connect |
| 3002 | 1 | 1 | 53.7ms | 53.7ms | HTTP::Tiny::Handle::CORE:syswrite (opcode) |
| 2002 | 1 | 1 | 44.4ms | 17.6s | HTTP::Tiny::Handle::read_response_header |
| 2002 | 1 | 1 | 42.6ms | 198ms | HTTP::Tiny::Handle::write_header_lines |
| 2002 | 1 | 1 | 41.3ms | 42.8ms | HTTP::Tiny::_prepare_headers_and_cb |
| 2002 | 1 | 1 | 38.6ms | 38.6ms | HTTP::Tiny::__ANON__[:85] |
| 1000 | 1 | 1 | 37.0ms | 82.5ms | HTTP::Tiny::Handle::write_content_body |
| 2002 | 1 | 1 | 36.7ms | 48.6ms | HTTP::Tiny::_split_url |
| 2002 | 1 | 1 | 29.9ms | 1.00s | HTTP::Tiny::_open_handle |
| 2002 | 1 | 1 | 29.7ms | 19.3s | HTTP::Tiny::request |
| 1001 | 1 | 1 | 28.8ms | 65.8ms | HTTP::Tiny::new |
| 2002 | 1 | 1 | 27.7ms | 17.3s | HTTP::Tiny::Handle::can_read |
| 2002 | 1 | 1 | 26.1ms | 27.3ms | HTTP::Tiny::_maybe_redirect |
| 1001 | 1 | 1 | 25.8ms | 38.5ms | HTTP::Tiny::Handle::read_content_body |
| 3002 | 1 | 1 | 24.9ms | 64.9ms | HTTP::Tiny::Handle::can_write |
| 11014 | 2 | 1 | 24.7ms | 24.7ms | HTTP::Tiny::Handle::CORE:subst (opcode) |
| 16019 | 5 | 1 | 22.4ms | 22.4ms | HTTP::Tiny::Handle::CORE:match (opcode) |
| 2002 | 1 | 1 | 22.1ms | 22.1ms | HTTP::Tiny::Handle::new |
| 2002 | 1 | 1 | 20.7ms | 24.0ms | HTTP::Tiny::Handle::_get_tid |
| 2002 | 1 | 1 | 18.2ms | 18.2ms | HTTP::Tiny::Handle::CORE:sysread (opcode) |
| 1001 | 1 | 1 | 16.3ms | 55.1ms | HTTP::Tiny::Handle::read_body |
| 2002 | 1 | 1 | 15.4ms | 312ms | HTTP::Tiny::Handle::write_request |
| 1001 | 1 | 1 | 13.0ms | 13.0ms | HTTP::Tiny::_set_proxies |
| 2002 | 1 | 1 | 10.7ms | 208ms | HTTP::Tiny::Handle::write_request_header |
| 8008 | 5 | 1 | 10.1ms | 10.1ms | HTTP::Tiny::CORE:match (opcode) |
| 1001 | 1 | 1 | 9.88ms | 9.88ms | HTTP::Tiny::_prepare_data_cb |
| 1001 | 1 | 1 | 9.80ms | 9.80ms | HTTP::Tiny::Handle::read |
| 1001 | 1 | 1 | 9.16ms | 18.1ms | HTTP::Tiny::_agent |
| 1000 | 1 | 1 | 5.67ms | 88.1ms | HTTP::Tiny::Handle::write_body |
| 3003 | 2 | 1 | 5.55ms | 5.55ms | HTTP::Tiny::CORE:subst (opcode) |
| 1001 | 1 | 1 | 5.40ms | 5.88ms | HTTP::Tiny::agent |
| 2000 | 1 | 1 | 4.50ms | 4.50ms | HTTP::Tiny::__ANON__[:692] |
| 1001 | 1 | 1 | 2.92ms | 2.92ms | HTTP::Tiny::__ANON__[:734] |
| 2002 | 1 | 1 | 2.84ms | 2.84ms | HTTP::Tiny::Handle::CORE:binmode (opcode) |
| 1 | 1 | 1 | 2.63ms | 13.6ms | HTTP::Tiny::Handle::BEGIN@866 |
| 1 | 1 | 1 | 446µs | 710µs | HTTP::Tiny::Handle::BEGIN@865 |
| 1 | 1 | 1 | 28µs | 28µs | HTTP::Tiny::BEGIN@66 |
| 1 | 1 | 1 | 24µs | 24µs | HTTP::Tiny::Handle::CORE:regcomp (opcode) |
| 1 | 1 | 1 | 17µs | 34µs | HTTP::Tiny::Handle::BEGIN@1418 |
| 1 | 1 | 1 | 9µs | 11µs | HTTP::Tiny::BEGIN@853 |
| 1 | 1 | 1 | 8µs | 9µs | HTTP::Tiny::BEGIN@3 |
| 1 | 1 | 1 | 7µs | 8µs | HTTP::Tiny::Handle::BEGIN@862 |
| 11 | 1 | 1 | 7µs | 7µs | HTTP::Tiny::Handle::CORE:substcont (opcode) |
| 1 | 1 | 1 | 6µs | 29µs | HTTP::Tiny::Handle::BEGIN@863 |
| 1 | 1 | 1 | 5µs | 12µs | HTTP::Tiny::BEGIN@195 |
| 1 | 1 | 1 | 4µs | 14µs | HTTP::Tiny::BEGIN@75 |
| 1 | 1 | 1 | 4µs | 11µs | HTTP::Tiny::BEGIN@76 |
| 1 | 1 | 1 | 4µs | 6µs | HTTP::Tiny::BEGIN@4 |
| 1 | 1 | 1 | 2µs | 2µs | HTTP::Tiny::BEGIN@9 |
| 1 | 1 | 1 | 2µs | 2µs | HTTP::Tiny::CORE:qr (opcode) |
| 1 | 1 | 1 | 900ns | 900ns | HTTP::Tiny::Handle::CORE:qr (opcode) |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::__ANON__[:885] |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::__ANON__[:957] |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::_assert_ssl |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::_find_CA_file |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::_ssl_args |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::can_reuse |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::close |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::read_chunked_body |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::start_ssl |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::Handle::write_chunked_body |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::__ANON__[:284] |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::__ANON__[:731] |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_add_basic_auth_header |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_create_proxy_tunnel |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_http_date |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_parse_http_date |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_proxy_connect |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_split_proxy |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_update_cookie_jar |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_uri_escape |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::_validate_cookie_jar |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::mirror |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::post_form |
| 0 | 0 | 0 | 0s | 0s | HTTP::Tiny::www_form_urlencode |
| 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 |