File Coverage

blib/lib/OpenTelemetry/Instrumentation/HTTP/Tiny.pm
Criterion Covered Total %
statement 117 117 100.0
branch 25 26 96.1
condition 9 11 81.8
subroutine 22 22 100.0
pod 2 3 66.6
total 175 179 97.7


line stmt bran cond sub pod time code
1             package OpenTelemetry::Instrumentation::HTTP::Tiny;
2             # ABSTRACT: OpenTelemetry instrumentation for HTTP::Tiny
3              
4             our $VERSION = '0.033';
5              
6 2     2   220426 use strict;
  2         4  
  2         73  
7 2     2   9 use warnings;
  2         3  
  2         108  
8 2     2   373 use experimental 'signatures';
  2         2846  
  2         15  
9              
10 2     2   734 use Class::Inspector;
  2         2403  
  2         66  
11 2     2   1071 use Class::Method::Modifiers 'install_modifier';
  2         4599  
  2         152  
12 2     2   388 use Feature::Compat::Defer;
  2         289  
  2         80  
13 2     2   150 use List::Util 'any';
  2         5  
  2         143  
14 2     2   358 use OpenTelemetry::Constants qw( SPAN_KIND_CLIENT SPAN_STATUS_ERROR );
  2         15  
  2         22  
15 2     2   2327 use OpenTelemetry::Context;
  2         7  
  2         116  
16 2     2   998 use OpenTelemetry::Trace;
  2         8  
  2         102  
17 2     2   973 use OpenTelemetry;
  2         13  
  2         50  
18 2     2   830 use Ref::Util qw( is_arrayref is_coderef );
  2         6  
  2         153  
19 2     2   16 use Syntax::Keyword::Dynamically;
  2         5  
  2         20  
20 2     2   158 use isa 'URI::http';
  2         5  
  2         18  
21              
22 2     2   428 use parent 'OpenTelemetry::Instrumentation';
  2         5  
  2         19  
23              
24 2     2 1 410455 sub dependencies { 'HTTP::Tiny' }
25              
26 24     24   25012 my sub get_headers ( $have, $want, $prefix ) {
  24         85  
  24         41  
  24         41  
  24         31  
27 24 100       206 return unless @$want;
28              
29             map {
30 5         12 my ( $k, $v ) = ( $_->[0], $have->{ $_->[1] } );
31 5 100       33 "$prefix.$k" => is_arrayref $v ? $v : [ $v ]
32             }
33 9         14 grep { my $k = $_->[0]; any { $k =~ $_ } @$want }
  9         31  
  23         75  
34 3         8 map { [ lc tr/-/_/r, $_ ] }
  9         24  
35             keys %$have;
36             }
37              
38             my ( $original, $loaded );
39              
40 8     8 0 2729 sub uninstall ( $class ) {
  8         22  
  8         19  
41 8 100       36 return unless $original;
42 2     2   1197 no strict 'refs';
  2         5  
  2         98  
43 2     2   12 no warnings 'redefine';
  2         5  
  2         3960  
44 7         41 delete $Class::Method::Modifiers::MODIFIER_CACHE{'HTTP::Tiny'}{request};
45 7         14 *{'HTTP::Tiny::request'} = $original;
  7         282  
46 7         26 undef $loaded;
47 7         24 return;
48             }
49              
50 8     8 1 1438 sub install ( $class, %config ) {
  8         22  
  8         18  
  8         15  
51 8 50       39 return if $loaded;
52 8 100       65 return unless Class::Inspector->loaded('HTTP::Tiny');
53              
54 7         1997 require URI;
55              
56             my @wanted_request_headers = map qr/^\Q$_\E$/i, map tr/-/_/r,
57 7   100     19265 @{ delete $config{request_headers} // [] };
  7         119  
58              
59             my @wanted_response_headers = map qr/^\Q$_\E$/i, map tr/-/_/r,
60 7   100     240 @{ delete $config{response_headers} // [] };
  7         67  
61              
62 7         72 $original = \&HTTP::Tiny::request;
63             install_modifier 'HTTP::Tiny' => around => request => sub {
64 8     8   7790 my ( $code, $self, $method, $url, $options ) = @_;
65              
66 8         50 my $uri = URI->new("$url");
67              
68 8         18413 my %url_data;
69 8 100       75 if ( isa_URI_http $uri ) {
70 7 100       29 $uri->userinfo('REDACTED:REDACTED') if $uri->userinfo;
71 7         855 %url_data = (
72             'server.address' => $uri->host,
73             'server.port' => $uri->port,
74             );
75             }
76              
77             my $span = OpenTelemetry->tracer_provider->tracer(
78             name => __PACKAGE__,
79             version => $VERSION,
80             )->create_span(
81             name => $method,
82             kind => SPAN_KIND_CLIENT,
83             attributes => {
84             %url_data,
85             # As per https://github.com/open-telemetry/semantic-conventions/blob/main/docs/http/http-spans.md
86             'http.request.method' => $method,
87             'network.protocol.name' => 'http',
88             'network.protocol.version' => '1.1',
89             'network.transport' => 'tcp',
90             'url.full' => "$uri", # redacted
91             'user_agent.original' => $self->agent,
92              
93             # This does not include auto-generated headers
94             # Capturing those would require to hook into the
95             # handle's write_request method
96             get_headers(
97             $self->{default_headers}, # Apologies to the encapsulation gods
98             \@wanted_request_headers,
99             'http.request.header'
100             ),
101              
102             get_headers(
103             $options->{headers},
104             \@wanted_request_headers,
105             'http.request.header'
106             ),
107              
108             # Request body can be generated by setting content to a
109             # code reference, in which case we don't set this attribute
110             # Setting it would likely involve us hooking into the
111             # handle's write_body method
112             defined $options->{content} && ! is_coderef $options->{content}
113             ? ( 'http.request.body.size' => length $options->{content} )
114 8 100 100     500 : (),
115             },
116             );
117              
118 8         26133 dynamically OpenTelemetry::Context->current
119             = OpenTelemetry::Trace->context_with_span($span);
120              
121 8         64 OpenTelemetry->propagator->inject( \my %carrier );
122 8 100 50     62 $options->{headers} = { %{ $options->{headers} // {} }, %carrier }
  1         12  
123             if %carrier;
124              
125 8         17 defer { $span->end }
  8         23  
126              
127 8         33 my $res = $self->$code( $method, $url, $options );
128 8         165 $span->set_attribute( 'http.response.status_code' => $res->{status} );
129              
130             # TODO: this should include retries
131 1         33 $span->set_attribute( 'http.resend_count' => scalar @{ $res->{redirects} } )
132 8 100       183 if $res->{redirects};
133              
134 8         45 my $length = $res->{headers}{'content-length'};
135 8 100       25 $span->set_attribute( 'http.response.body.size' => $length )
136             if defined $length;
137              
138 8 100       54 unless ( $res->{success} ) {
139 3         3 my $description;
140 3 100       8 if ( $res->{status} == 599 ) {
141 2   50     29 my $error = ( $res->{content} // '' ) =~ s/^\s+|\s+$//r;
142 2         7 ($description) = split /\n/, $error, 2;
143 2         5 $description =~ s/ at \S+ line \d+\.$//a;
144              
145             }
146             else {
147 1         3 $description = $res->{status};
148             }
149              
150 3         8 $span->set_status( SPAN_STATUS_ERROR, $description );
151             }
152              
153             $span->set_attribute(
154             get_headers(
155             $res->{headers},
156 8         53 \@wanted_response_headers,
157             'http.response.header'
158             )
159             );
160              
161 8         143 return $res;
162 7         95 };
163              
164 7         3588 return $loaded = 1;
165             }
166              
167             1;