File Coverage

blib/lib/Akamai/Edgegrid.pm
Criterion Covered Total %
statement 102 115 88.7
branch 12 20 60.0
condition 4 6 66.6
subroutine 22 23 95.6
pod 1 1 100.0
total 141 165 85.4


line stmt bran cond sub pod time code
1             package Akamai::Edgegrid;
2              
3 7     7   137542 use 5.006;
  7         24  
4 7     7   32 use strict;
  7         10  
  7         163  
5 7     7   30 use warnings FATAL => 'all';
  7         28  
  7         282  
6              
7 7     7   29 use base 'LWP::UserAgent';
  7         12  
  7         17193  
8 7     7   430222 use Data::Dumper;
  7         50812  
  7         448  
9 7     7   6746 use Digest::SHA qw(hmac_sha256_base64 sha256_base64);
  7         28528  
  7         830  
10 7     7   5361 use POSIX qw(strftime);
  7         46537  
  7         38  
11 7     7   13475 use Data::UUID;
  7         4540  
  7         608  
12 7     7   7366 use Config::IniFiles;
  7         283167  
  7         9456  
13              
14             =head1 NAME
15              
16             Akamai::Edgegrid - User agent for Akamai {OPEN} Edgegrid
17              
18             =head1 VERSION
19              
20             Version 1.0
21              
22             =cut
23              
24             our $VERSION = '1.0.5';
25              
26             =head1 SYNOPSIS
27              
28             use Akamai::Edgegrid;
29              
30             my $agent = new Akamai::Edgegrid(
31             config_file => "$ENV{HOME}/.edgerc",
32             section => "default");
33             my $baseurl = "https://" . $agent->{host};
34              
35             my $resp = $agent->get("$baseurl/diagnostic-tools/v1/locations");
36             print $resp->content;
37              
38             =head1 DESCRIPTION
39              
40             This module implements the Akamai {OPEN} Edgegrid Authentication scheme as specified by L.
41              
42             =cut
43              
44             sub _eg_timestamp {
45 1     1   563 return strftime('%Y%m%dT%H:%M:%S+0000', gmtime(time));
46             }
47              
48             sub _new_nonce {
49 100     100   54931 my $ug = new Data::UUID;
50 100         17686 return $ug->create_str;
51             }
52              
53             # see http://search.cpan.org/~mshelor/Digest-SHA-5.88/lib/Digest/SHA.pm#PADDING_OF_BASE64_DIGESTS
54             sub _pad_digest {
55 27     27   63 my $digest = shift;
56 27         94 while (length($digest) % 4) {
57 27         97 $digest .= '=';
58             }
59 27         135 return $digest;
60             }
61              
62             sub _padded_hmac_sha256_base64 {
63 24     24   55 my ($data, $key) = @_;
64 24         342 return _pad_digest(hmac_sha256_base64($data, $key));
65             }
66              
67             sub _padded_sha256_base64 {
68 3     3   6 my ($data) = @_;
69 3         71 return _pad_digest(sha256_base64($data));
70             }
71              
72             ## methods
73              
74             sub _debug {
75 50     50   116 my ($self, $msg) = @_;
76 50 50       173 if ($self->{debug}) {
77 0         0 $msg =~ s/\n$//;
78 0         0 warn "$msg\n";
79             }
80             }
81              
82             sub _make_signing_key {
83 12     12   22 my ($self, $timestamp) = @_;
84 12         39 my $signing_key = _padded_hmac_sha256_base64($timestamp, $self->{client_secret});
85 12         57 $self->_debug("signing_key: $signing_key");
86              
87 12         40 return $signing_key;
88             }
89              
90             sub _canonicalize_headers {
91 12     12   975 my ($self, $r) = @_;
92             return join("\t",
93             map {
94 9         235 my $header_name = lc($_);
95 9         27 my $header_val = $r->header($_);
96 9         350 $header_val =~ s/^\s+//g;
97 9         19 $header_val =~ s/\s+$//g;
98 9         19 $header_val =~ s/\s+/ /g;
99              
100 9         79 "$header_name:$header_val";
101              
102             } grep {
103 36         1327 defined $r->header($_)
104 12         17 } @{$self->{headers_to_sign}}
  12         32  
105             );
106             }
107              
108             sub _make_content_hash {
109 12     12   413 my ($self, $r) = @_;
110 12 100 100     40 if ($r->method eq 'POST' and length($r->content) > 0) {
111 3         116 my $body = $r->content;
112 3 100       42 if (length($body) > $self->{max_body}) {
113             $self->_debug(
114             "data length " . length($body) . " is larger than maximum " . $self->{max_body}
115 1         12 );
116              
117 1         6 $body = substr($body, 0, $self->{max_body});
118              
119 1         6 $self->_debug(
120             "data truncated to " . length($body) . " for computing the hash"
121             );
122             }
123 3         9 return _padded_sha256_base64($body);
124             }
125 9         179 return "";
126             }
127              
128             sub _make_data_to_sign {
129 12     12   22 my ($self, $r, $auth_header) = @_;
130 12         42 my $data_to_sign = join("\t", (
131             $r->method,
132             $r->url->scheme,
133             $r->url->host,
134             $r->url->path_query,
135             $self->_canonicalize_headers($r),
136             $self->_make_content_hash($r),
137             $auth_header
138             ));
139              
140 12         44 my $display_to_sign = $data_to_sign;
141 12         79 $display_to_sign =~ s/\t/\\t/g;
142 12         50 $self->_debug("data to sign: $display_to_sign");
143              
144 12         53 return $data_to_sign;
145             }
146              
147             sub _sign_request {
148 12     12   35 my ($self, $r, $timestamp, $auth_header) = @_;
149              
150 12         64 return _padded_hmac_sha256_base64(
151             $self->_make_data_to_sign($r, $auth_header),
152             $self->_make_signing_key($timestamp)
153             );
154             }
155              
156             sub _make_auth_header {
157 12     12   22431 my ($self, $r, $timestamp, $nonce) = @_;
158             my @kvps = (
159             ['client_token' => $self->{client_token}],
160 12         90 ['access_token' => $self->{access_token}],
161             ['timestamp' => $timestamp],
162             ['nonce' => $nonce]
163             );
164             my $auth_header = "EG1-HMAC-SHA256 " . join(';', map {
165 12         27 my ($k,$v) = @$_;
  48         136  
166 48         253 "$k=$v";
167             } @kvps) . ';';
168              
169 12         68 $self->_debug("unsigned authorization header: $auth_header");
170              
171 12         45 my $signed_auth_header =
172             $auth_header . 'signature=' . $self->_sign_request($r, $timestamp, $auth_header);
173              
174 12         61 $self->_debug("signed authorization header: $signed_auth_header");
175              
176 12         83 return $signed_auth_header;
177             }
178              
179             =head1 CONSTRUCTOR METHOD
180              
181             =over 2
182              
183             =item $ua = Akamai::Edgegrid->new( %options )
184              
185             This method constructs a new C object and returns it. This
186             is a subclass of C and accepts all Key/value pair arguments
187             accepted by the parent class. In addition The following required key/value
188             pairs must be provided:
189              
190             KEY SOURCE
191             ------------- -----------------------------------------------
192             client_token from "Credentials" section of Manage APIs UI
193             client_secret from "Credentials" section of Manage APIs UI
194             access_token from "Authorizations" section of Manage APIs UI
195              
196             The following optional key/value pairs may be provided:
197              
198             KEY DESCRIPTION
199             --------------- -------------------------------------------------------
200             debug if true enables additional logging
201             headers_to_sign listref of header names to sign (in order) (default [])
202             max_body maximum body size for POSTS (default 2048)
203              
204             =cut
205              
206             sub new {
207 17     17 1 12920 my $class = shift @_;
208 17         90 my %args = @_;
209              
210 17         57 my @local_args = qw(config_file section client_token client_secret access_token headers_to_sign max_body debug);
211 17         39 my @required_args = qw(client_token client_secret access_token);
212 17         42 my @cred_args = qw(client_token client_secret access_token host);
213 17         24 my %local = ();
214              
215 17         36 for my $arg (@local_args) {
216 136         341 $local{$arg} = delete $args{$arg};
217             }
218              
219 17         75 my $self = LWP::UserAgent::new($class, %args);
220              
221 17         12049 for my $arg (@local_args) {
222 136         331 $self->{$arg} = $local{$arg};
223             }
224              
225             # defaults
226 17 50       54 unless ($self->{config_file}) {
227 17         71 $self->{config_file} = "$ENV{HOME}/.edgerc";
228             }
229 17 0 33     342 if (-f $self->{config_file} and $self->{section} ) {
230 0         0 my $cfg = Config::IniFiles->new( -file => $self->{config_file} );
231 0         0 for my $variable (@cred_args) {
232 0 0       0 if ($cfg->val($self->{section}, $variable)) {
233 0         0 $self->{$variable} = $cfg->val($self->{section}, $variable);
234             } else {
235             die ("Config file " . $self->{config_file} .
236             " is missing required argument " . $variable .
237 0         0 " in section " . $self->{section} );
238             }
239             }
240 0 0       0 if ( $cfg->val($self->{section}, "max_body") ) {
241 0         0 $self->{max_body} = $cfg->val($self->{section}, "max_body");
242             }
243             }
244              
245 17         40 for my $arg (@required_args) {
246 46 100       214 unless ($self->{$arg}) {
247 4         92 die "missing required argument $arg";
248             }
249             }
250              
251 13 100       38 unless ($self->{headers_to_sign}) {
252 1         2 $self->{headers_to_sign} = [];
253             }
254 13 100       35 unless ($self->{max_body}) {
255 1         3 $self->{max_body} = 131072;
256             }
257              
258             $self->add_handler('request_prepare' => sub {
259 0     0   0 my ($r, $ua, $h) = @_;
260              
261 0         0 my $nonce = _new_nonce();
262 0         0 my $timestamp = _eg_timestamp();
263              
264 0         0 $r->header('Authorization', $ua->_make_auth_header($r, $timestamp, $nonce));
265 13         81 });
266              
267 13         372 return $self;
268             }
269              
270             =back
271              
272             =head1 AUTHOR
273              
274             Jonathan Landis, C<< >>
275              
276             =head1 BUGS
277              
278             Please report any bugs or feature requests to the web interface at L.
279              
280             =head1 SUPPORT
281              
282             You can find documentation for this module with the perldoc command.
283              
284             perldoc Akamai::Edgegrid
285              
286              
287             You can also look for information at:
288              
289             =over 4
290              
291             =item * Akamai's OPEN Developer Community
292              
293             L
294              
295             =item * Github issues (report bugs here)
296              
297             L
298              
299             =item * AnnoCPAN: Annotated CPAN documentation
300              
301             L
302              
303             =item * CPAN Ratings
304              
305             L
306              
307             =item * Search CPAN
308              
309             L
310              
311             =back
312              
313              
314             =head1 LICENSE AND COPYRIGHT
315              
316             Copyright 2014 Akamai Technologies, Inc. All rights reserved
317              
318             Licensed under the Apache License, Version 2.0 (the "License");
319             you may not use this file except in compliance with the License.
320             You may obtain a copy of the License at
321              
322             L
323              
324             Unless required by applicable law or agreed to in writing, software
325             distributed under the License is distributed on an "AS IS" BASIS,
326             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
327             See the License for the specific language governing permissions and
328             limitations under the License.
329              
330              
331             =cut
332              
333             1; # End of Akamai::Edgegrid