From c38481cb9f06bf85e29b7676370468d56cdc858a Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 28 Dec 2014 17:55:17 +0000 Subject: everything ported to p6 --- lib/Net/Hawk/Client.pm | 129 ++++++++++++++++++++++++---------------------- lib/Net/Hawk/Crypto.pm | 61 +++++++--------------- lib/Net/Hawk/Utils.pm | 2 +- t/tests/Net/Hawk/Client.t | 32 +++++------- 4 files changed, 100 insertions(+), 124 deletions(-) diff --git a/lib/Net/Hawk/Client.pm b/lib/Net/Hawk/Client.pm index a543422..2a9d4c9 100644 --- a/lib/Net/Hawk/Client.pm +++ b/lib/Net/Hawk/Client.pm @@ -30,12 +30,12 @@ package Net::Hawk::Client { $timestamp //= now_secs($localtime_offset_msec); my %artifacts = ( - ts => $timestamp, - nonce => $nonce // ['a'..'z','A'..'Z',0..9].pick(6).join(''), + ts => +($timestamp), + nonce => $nonce // ['a'..'z','A'..'Z','_',0..9].pick(6).join(''), method => $method, resource => $uri.path_query, host => $uri.host, - port => $uri.port // ($uri.scheme eq 'http:' ?? 80 !! 443), + port => +($uri.port) // ($uri.scheme eq 'http:' ?? 80 !! 443), ); for -> $k { next unless defined $::($k); @@ -80,65 +80,70 @@ package Net::Hawk::Client { artifacts => %artifacts, }; } -}; - -=begin finish - -sub authenticate { - state $argcheck = compile( - Object, - HTTPHeaders, - HashRef, - Optional[HashRef], - Optional[HashRef], - ); - my ($self,$headers,$credentials,$artifacts,$options) = $argcheck->(@_); - - $artifacts //= {}; $options //= {}; - - my $www_auth = $headers->header('www-authenticate'); - if ($www_auth) { - my $attributes = try { $self->_utils->parse_authorization_header( - $www_auth,[qw(ts tsm error)], - ) }; - return unless $attributes; - - if ($attributes->{ts}) { - my $tsm = $self->_crypto->calculate_ts_mac( - $attributes->{ts},$credentials, - ); - return unless $tsm eq $attributes->{tsm}; + + my sub get_header(Str:D $key, @headers) returns Str { + @headers \ + ==> grep { .key eq $key } \ + ==> map { .value } \ + ==> join ','; } - } + our sub authenticate( + Array:D $headers, + Hash:D $credentials, + Hash $artifacts?, + Hash $options?, + ) returns Bool { + + my $www_auth = get_header('www-authenticate',$headers); + + if ($www_auth) { + my $attributes; + try { + $attributes = parse_authorization_header( + $www_auth,, + ); + CATCH { default { return False } } + }; + + if ($attributes) { + my $tsm = calculate_ts_mac( + +$attributes,$credentials, + ); + return False unless $tsm eq $attributes; + } + } - my $serv_auth = $headers->header('server-authorization'); - return 1 unless $serv_auth || $options->{required}; - - my $attributes = try { $self->_utils->parse_authorization_header( - $serv_auth, - [qw(mac ext hash)], - ) }; - return unless $attributes; - - my $mac = $self->_crypto->calculate_mac( - response => $credentials, - { - %$artifacts, - ext => $attributes->{ext}, - hash => $attributes->{hash}, - }, - ); - return unless $mac eq $attributes->{mac}; - - return 1 unless defined $options->{payload}; - return unless $attributes->{hash}; - - my $calculated_hash = $self->_crypto->calculated_payload_hash( - $options->{payload}, - $credentials->{algorithm}, - scalar $headers->header('content-type'), - ); - return $calculated_hash eq $attributes->{hash}; -} + my $serv_auth = get_header('server-authorization',$headers); + return True unless $serv_auth || $options; + + my $attributes; + try { + $attributes = parse_authorization_header( + $serv_auth, + , + ); + CATCH { default { return False } } + }; + + my $mac = calculate_mac( + 'response', + $credentials, + %( + %$artifacts, + ext => $attributes, + hash => $attributes, + ), + ); + return False unless $mac eq $attributes; -1; + return True unless defined $options; + return False unless $attributes; + + my $calculated_hash = calculate_payload_hash( + $options, + $credentials, + get_header('content-type',$headers), + ); + return $calculated_hash eq $attributes; + }; +} diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm index 1cd5a8d..240a6f7 100644 --- a/lib/Net/Hawk/Crypto.pm +++ b/lib/Net/Hawk/Crypto.pm @@ -14,7 +14,7 @@ package Net::Hawk::Crypto { }; multi generate_normalized_string( Str:D :$type!, - URI:D :$resource!, + URI :$resource, Int:D :$ts!, Str:D :$nonce!, Str :$method, @@ -32,7 +32,7 @@ package Net::Hawk::Crypto { $ts, $nonce, uc($method // ''), - $resource.path_query, + ( $resource ?? $resource.path_query !! ''), lc($host), $port, $hash // '', @@ -86,52 +86,29 @@ package Net::Hawk::Crypto { Hash:D $options ) returns Str is export { my $normalized = generate_normalized_string(:$type,|$options); + CATCH { warn $type;warn $options.perl;die $_ } return calc_hmac( $normalized, $algorithm, $key, ); - } - -} -=begin finish -sub calculate_ts_mac { - state $argcheck = compile( - Object,Int, - Dict[ - algorithm => Algorithm, - key => Str, - slurpy Any, - ], - ); - my ($self,$ts,$credentials) = $argcheck->(@_); - - my $string = sprintf( - "hawk.%s.ts\n%d\n", - header_version(), - $ts, - ); - - return $self->calc_hmac( - $string, - $credentials->{algorithm}, - $credentials->{key}, - ); -} - -sub make_digest { - state $argcheck = compile(Object,Algorithm); - my ($self,$algorithm) = $argcheck->(@_); - - return Digest::SHA->new($algorithm =~ s{^sha}{}r); -} + }; -sub _pad_b64 { - my ($b64) = @_; + sub calculate_ts_mac( + Int:D $ts, + Hash:D $credentials ( Str :$algorithm, Str :$key, *% ), + ) returns Str is export { + my $string = sprintf( + "hawk.%s.ts\n%d\n", + header_version(), + $ts, + ); - $b64 .= '=' while length($b64) % 4; - return $b64; + return calc_hmac( + $string, + $algorithm, + $key, + ); + } } - -1; diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm index 76478df..bf81b10 100644 --- a/lib/Net/Hawk/Utils.pm +++ b/lib/Net/Hawk/Utils.pm @@ -53,7 +53,7 @@ package Net::Hawk::Utils { Net::Hawk::Errors::BadRequest.new( text => "Bad attribute value $value", value => $header, - ).throw unless $value ~~ m{^<[ \w !#$%&'()*+,\-./:;\<=\>?@\[\]^`{|}~ ]>+$}; + ).throw unless $value ~~ m{^<[ \w \ !#$%&'()*+,\-./:;\<=\>?@\[\]^`{|}~ ]>+$}; Net::Hawk::Errors::BadRequest.new( text => "Duplicate attribute $key", diff --git a/t/tests/Net/Hawk/Client.t b/t/tests/Net/Hawk/Client.t index 784b7a0..ca8476d 100644 --- a/t/tests/Net/Hawk/Client.t +++ b/t/tests/Net/Hawk/Client.t @@ -117,13 +117,9 @@ subtest { ); }; -done; - -=begin finish - -subtest authenticate => sub { +subtest { ok( - ! $c->authenticate([ + ! Net::Hawk::Client::authenticate([ 'server-authorization' => 'Hawk mac="abc", bad="xyz"', ],{}), 'returns false on invalid header', @@ -132,14 +128,12 @@ subtest authenticate => sub { my %artifacts = ( method => 'POST', host => 'example.com', - port => '8080', + port => 8080, resource => '/resource/4?filter=a', - ts => '1362336900', + ts => 1362336900, nonce => 'eb5S_L', hash => 'nJjkVtBE5Y/Bk38Aiokwn0jiJxt/0S2WRSUwWLCf5xk=', ext => 'some-app-data', - app => undef, - dlg => undef, mac => 'BlmSe8K+pbKIb6YsZCnt4E1GrYvY1AaYayNR82dGpIk=', id => '123456', ); @@ -152,41 +146,41 @@ subtest authenticate => sub { ); ok( - ! $c->authenticate([ + ! Net::Hawk::Client::authenticate([ 'content-type' => 'text/plain', 'server-authorization' => 'Hawk mac="_IJRsMl/4oL+nn+vKoeVZPdCHXB4yJkNnBbTbHFZUYE=", hash="f9cDF/TDm7TkYRLnGwRMfeDzT6LixQVLvrIKhh0vgmM=", ext="response-specific"', - ],\%credentials,\%artifacts), + ],%credentials,%artifacts), 'returns false on invalid mac', ); ok( - $c->authenticate([ + Net::Hawk::Client::authenticate([ 'content-type' => 'text/plain', 'server-authorization' => 'Hawk mac="XIJRsMl/4oL+nn+vKoeVZPdCHXB4yJkNnBbTbHFZUYE=", hash="f9cDF/TDm7TkYRLnGwRMfeDzT6LixQVLvrIKhh0vgmM=", ext="response-specific"', - ],\%credentials,\%artifacts), + ],%credentials,%artifacts), 'returns true on ignoring hash', ); ok( - ! $c->authenticate([ + ! Net::Hawk::Client::authenticate([ 'www-authenticate' => 'Hawk ts="1362346425875", tsm="PhwayS28vtnn3qbv0mqRBYSXebN/zggEtucfeZ620Zo=", x="Stale timestamp"', ],{}), 'fails on invalid WWW-Authenticate header format', ); ok( - ! $c->authenticate([ + ! Net::Hawk::Client::authenticate([ 'www-authenticate' => 'Hawk ts="1362346425875", tsm="hwayS28vtnn3qbv0mqRBYSXebN/zggEtucfeZ620Zo=", error="Stale timestamp"', - ],\%credentials), + ],%credentials), 'fails on invalid WWW-Authenticate header format', ); ok( - $c->authenticate([ + Net::Hawk::Client::authenticate([ 'www-authenticate' => 'Hawk error="Stale timestamp"', ],{}), 'skips tsm validation when missing ts', ); }; -done_testing(); +done; -- cgit v1.2.3