From 9e8b9ce470c26d0578cf65db3cd3da7bab74b6d7 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sat, 17 Jan 2015 16:30:02 +0000 Subject: Uri seems to pass a few tests also it now has a proper implementation --- lib/Net/Hawk/Client.pm | 49 +++++++-- lib/Net/Hawk/Crypto.pm | 19 +++- lib/Net/Hawk/Errors.pm | 6 +- lib/Net/Hawk/Server.pm | 278 +++++++++++++++++++++++++++++++++++++++++++++++-- lib/Net/Hawk/Uri.pm | 2 +- lib/Net/Hawk/Utils.pm | 36 +++++++ t/tests/Net/Hawk/Uri.t | 187 ++++++++++++++++++++++++++++++--- 7 files changed, 541 insertions(+), 36 deletions(-) diff --git a/lib/Net/Hawk/Client.pm b/lib/Net/Hawk/Client.pm index fd28532..f307681 100644 --- a/lib/Net/Hawk/Client.pm +++ b/lib/Net/Hawk/Client.pm @@ -1,6 +1,8 @@ package Net::Hawk::Client { use v6; use URI; + use URI::Escape; + use MIME::Base64; use Net::Hawk::Utils; use Net::Hawk::Crypto; @@ -35,7 +37,7 @@ package Net::Hawk::Client { 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); @@ -98,7 +100,7 @@ package Net::Hawk::Client { if ($www_auth) { my $attributes = try { - $attributes = parse_authorization_header( + parse_authorization_header( $www_auth,, ); }; @@ -128,8 +130,7 @@ package Net::Hawk::Client { $credentials, %( %$artifacts, - ext => $attributes, - hash => $attributes, + $attributes :p, ), ); return False unless $mac eq $attributes; @@ -146,13 +147,39 @@ package Net::Hawk::Client { }; our proto getBewit(*@,*%) {*}; - multi getBewit(Str:D $uri!,*%nam) { - return getBewit(URI.new($uri),|%nam); + multi getBewit(Str:D $uri!,*@pos,*%nam) { + return getBewit(URI.new($uri),|@pos,|%nam); }; multi getBewit( - URI:D $uri!, - :%credentials!, - Int:D :$ttl_sec!, - Str :$ext, - ) { return "$ext" }; + URI $uri!, + %options, + ) returns Str { + return '' + unless $uri && %options + && %options.defined + && %options + && %options{all }.defined + && is_valid_hash_algorithm(%options) + ; + + %options //= ''; + my $now = now_msecs(%options//0); + my $exp = floor($now/1000)+%options; + my $mac = calculate_mac( + 'bewit', + %options, + { + ts => $exp, + nonce => '', + method => 'GET', + resource => $uri.path_query, + host => $uri.host, + port => +($uri.port) // ($uri.scheme eq 'http' ?? 80 !! 443), + %options :p, + } + ); + + my $bewit = "%options\\$exp\\$mac\\%options"; + return uri_escape(MIME::Base64.new.encode-str($bewit)); + }; } diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm index f69c78e..6f820dd 100644 --- a/lib/Net/Hawk/Crypto.pm +++ b/lib/Net/Hawk/Crypto.pm @@ -50,6 +50,13 @@ package Net::Hawk::Crypto { return $normalized; }; + sub is_valid_hash_algorithm(Str $algorithm) is export { + return False unless $algorithm; + return True if $algorithm eq 'sha1'; + return True if $algorithm eq 'sha256'; + return False; + } + sub digest_for(Str:D $algorithm) { if ($algorithm eq 'sha1') { return &sha1 } elsif ($algorithm eq 'sha256') { return &sha256 } @@ -86,7 +93,6 @@ 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, @@ -110,5 +116,14 @@ package Net::Hawk::Crypto { $algorithm, $key, ); - } + }; + + sub timestamp_message( + %credentials, + Int $localtime_offset_msec + ) is export { + my $ts = now_msecs($localtime_offset_msec); + my $tsm = calculate_ts_mac($ts,%credentials); + return { :$ts, :$tsm }; + }; } diff --git a/lib/Net/Hawk/Errors.pm b/lib/Net/Hawk/Errors.pm index a06c5cc..0394893 100644 --- a/lib/Net/Hawk/Errors.pm +++ b/lib/Net/Hawk/Errors.pm @@ -13,5 +13,9 @@ package Net::Hawk::Errors { } } - class UnAuthorized is base {} + class UnAuthorized is base { + has $.tsm; + } + + class Internal is base {} } diff --git a/lib/Net/Hawk/Server.pm b/lib/Net/Hawk/Server.pm index 1b39352..fdff714 100644 --- a/lib/Net/Hawk/Server.pm +++ b/lib/Net/Hawk/Server.pm @@ -1,18 +1,278 @@ package Net::Hawk::Server { use v6; + use Net::Hawk::Utils; + use Net::Hawk::Crypto; + use URI; + use URI::Escape; + use MIME::Base64; our sub authenticate( - %request!, - &credentialsFunc:($,&)!, - %whatever!, + %req!, + &credentials_func:($,&)!, + %options!, &callback:($,%,%)!, ) { - my %creds; - &credentialsFunc.('some id', sub ($err,%credentials) { %creds = %credentials }); - %request ~~ m{'bewit=' $=(.*?) ['&'|$]}; - my %attributes = ( - ext => $/; + + %options //= sub ($,$,&nonceCallback) { return &nonceCallback.() }; + %options //= 60; + my $now = now_msecs(%options//0); + my %request = parse_request(%req,%options); + my $attributes = try { + parse_authorization_header(%request); + }; + warn $attributes.perl; + return &callback.($!,{},{}) unless $attributes; + + my %artifacts = ( + %request :p, + resource => %request, + $attributes :p, + ); + + if not $attributes{all()} :exists { + return &callback.( + Net::Hawk::Errors::BadRequest.new( + text => 'Missing attributes', + value => %request, + ), + Nil, + %artifacts, + ); + }; + + &credentials_func.( + $attributes, + sub ($err,%credentials) { + if $err { + return &callback.($err,%credentials,%artifacts); + }; + if not %credentials { + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Unknown credentials', + ), + Nil, + %artifacts, + ); + }; + if not %credentials{all()}.defined { + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Invalid credentials', + ), + %credentials, + %artifacts, + ); + }; + if not is_valid_hash_algorithm %credentials { + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Unknown algorithm', + ), + %credentials, + %artifacts, + ); + }; + + my $mac = calculate_mac('header',%credentials,%artifacts); + unless $mac eq $attributes { # DANGER! this should be a fixed-time comparison! + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Bad mac', + ), + %credentials, + %artifacts, + ); + }; + + if (%options.defined) { + if not $attributes { + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Missing required payload hash', + ), + %credentials, + %artifacts, + ); + }; + + my $hash = calculate_payload_hash( + %options, + %credentials, + %request, + ); + unless $hash eq $attributes { # DANGER! this should be a fixed-time comparison! + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Bad payload hash', + ), + %credentials, + %artifacts, + ); + }; + }; + + %options.( + $attributes, + $attributes, + sub ($err) { + if $err { + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Invalid nonce', + ), + %credentials, + %artifacts, + ); + }; + + if abs(($attributes * 1000) - $now) > + (%options * 1000) { + my $tsm = timestamp_message( + %credentials, + %options, + ); + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Stale timestamp', + tsm => $tsm, + ), + %credentials, + %artifacts, + ); + }; + + return &callback.(Nil,%credentials,%artifacts); + }, + ); + }, + ); + }; + + our sub authenticateBewit( + %req, + &credentials_func:($,&)!, + %options!, + &callback:($,%,%)!, + ) { + my $now = now_msecs(%options//0); + my %request = parse_request(%req,%options); + my $resource = URI.new(%request); + return &callback.(Net::Hawk::Errors::UnAuthorized.new,{},{}) + unless $resource; + my $bewit_param = $resource.query_form; + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Empty bewit', + ), + {}, + {}, + ) unless $bewit_param; + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Invalid method', + ), + {}, + {}, + ) unless %request eq any(); + return &callback.( + Net::Hawk::Errors::BadRequest.new( + text => 'Multiple authentications', + ), + {}, + {}, + ) if %request; + + # we should throw if bad b64 encoding… + my $bewit_str = MIME::Base64.new.decode-str($bewit_param); + my @bewit_parts = $bewit_str.split('\\'); + return &callback.( + Net::Hawk::Errors::BadRequest.new( + text => 'Invalid bewit structure', + value => $bewit_str, + ), + {}, + {}, + ) unless @bewit_parts == 4; + + my %bewit = ( + id => @bewit_parts[0], + exp => try { :10(@bewit_parts[1]) }, + mac => @bewit_parts[2], + ext => @bewit_parts[3] // '', + ); + return &callback.( + Net::Hawk::Errors::BadRequest.new( + text => 'Missing bewit attributes', + ), + {}, + {}, + ) unless %bewit{all }.defined; + + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Access expired', + ), + {}, + {}, + ) if %bewit*1000 <= $now; + + # the URI object is immutable, and all its attributes are + # private so I can't even use 'clone' to get a modified object + my $url = %request.subst( + /( | '&') bewit\=.*? ( '&'| $ )/, + { $1 && $2 ?? '&' !! '' } + ); + + &credentials_func.( + %bewit, + sub ($err,%credentials) { + return &callback.($err,%credentials//{},%bewit//{}) + if $err; + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Unknown credentials', + ), + {}, + %bewit, + ) unless %credentials; + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Invalid credentials', + ), + %credentials, + %bewit, + ) unless %credentials{all }.defined; + if not is_valid_hash_algorithm %credentials { + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Unknown algorithm', + ), + %credentials, + %bewit, + ); + }; + + my $mac = calculate_mac('bewit',%credentials,{ + ts => %bewit, + nonce => '', + method => 'GET', + resource => $url, + %request :p, + %bewit :p, + }); + unless $mac eq %bewit { # DANGER! this should be a fixed-time comparison! + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Bad mac', + ), + %credentials, + %bewit, + ); + }; + + return &callback.(Nil,%credentials,%bewit); + }, ); - &callback.(Nil,%creds,%attributes); }; }; diff --git a/lib/Net/Hawk/Uri.pm b/lib/Net/Hawk/Uri.pm index 544afd9..45b0188 100644 --- a/lib/Net/Hawk/Uri.pm +++ b/lib/Net/Hawk/Uri.pm @@ -3,5 +3,5 @@ package Net::Hawk::Uri { use Net::Hawk::Client; use Net::Hawk::Server; our constant &getBewit := &Net::Hawk::Client::getBewit; - our constant &authenticate := &Net::Hawk::Server::authenticate; + our constant &authenticate := &Net::Hawk::Server::authenticateBewit; } diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm index bf81b10..21fc33f 100644 --- a/lib/Net/Hawk/Utils.pm +++ b/lib/Net/Hawk/Utils.pm @@ -65,6 +65,42 @@ package Net::Hawk::Utils { return %attributes; } + + sub parse_host(%req,Str $header_host_name) { + $header_host_name //= 'host'; + $header_host_name .= lc; + my $host = %req<$header_host_name>; + return Nil unless $host; + my $scheme = %req ?? 'https' !! 'http'; + my $uri = try { URI.new("{$scheme}://{$host}",:is_validating) }; + return Nil unless $uri; + return { + name => $uri.host, + port => $uri.port, + }; + }; + + sub parse_request(%req,%options) is export { + return %req unless %req; + + my %host; + unless %options{all()}.defined { + %host = parse_host(%req,%options); + Net::Hawk::Errors::BadRequest.new( + text => 'Invalid Host header', + value => %req, + ).throw unless %host; + }; + + my %request = ( + %req :p, + host => %options // %host, + port => %options // %host, + authorization => %req, + content_type => %req // '', + ); + return %request; + }; } 1; diff --git a/t/tests/Net/Hawk/Uri.t b/t/tests/Net/Hawk/Uri.t index d63954c..1d191dd 100644 --- a/t/tests/Net/Hawk/Uri.t +++ b/t/tests/Net/Hawk/Uri.t @@ -2,17 +2,23 @@ use v6; use Test; use Net::Hawk::Uri; +use Net::Hawk::Utils; +use Net::Hawk::Crypto; +use URI::Escape; +use MIME::Base64; -subtest { - my sub credentialsFunc($id,&callback) { - &callback.(Nil,{ - id => $id, - key => 'werxhqb98rpaxn39848xrunpaw3489ruxnpa98w4rxn', - algorithm => 'sha256', - user => 'steve', - }); - }; +my MIME::Base64 $mime .= new; + +my sub credentialsFunc($id,&callback) { + &callback.(Nil,{ + id => $id, + key => 'werxhqb98rpaxn39848xrunpaw3489ruxnpa98w4rxn', + algorithm => 'sha256', + user => 'steve', + }); +}; +subtest { my %req = ( method => 'GET', url => '/resource/4?a=1&b=2', @@ -23,9 +29,11 @@ subtest { credentialsFunc('123456', sub ($err, %credentials) { my $bewit = Net::Hawk::Uri::getBewit( 'http://example.com/resource/4?a=1&b=2', - credentials => %credentials, - ttl_sec => 60 * 60 * 24 * 365 * 100, - ext => 'some-app-data', + { + credentials => %credentials, + ttl_sec => 60 * 60 * 24 * 365 * 100, + ext => 'some-app-data', + }, ); %req ~= "\&bewit=$bewit"; @@ -42,4 +50,159 @@ subtest { }); }, 'generate a bewit then successfully authenticate it'; +subtest { + my %req = ( + method => 'GET', + url => '/resource/4?a=1&b=2', + host => 'example.com', + port => 80, + ); + + credentialsFunc('123456', sub ($err, %credentials) { + my $bewit = Net::Hawk::Uri::getBewit( + 'http://example.com/resource/4?a=1&b=2', + { + credentials => %credentials, + ttl_sec => 60 * 60 * 24 * 365 * 100, + }, + ); + %req ~= "\&bewit=$bewit"; + + Net::Hawk::Uri::authenticate( + %req, + &credentialsFunc, + {}, + sub ($err, %credentials, %attributes) { + ok(!$err,"no error"); + is(%credentials,'steve','correct user'); + }, + ); + }); +}, 'generate a bewit then successfully authenticate it (no ext)'; + +subtest { + my %req = ( + method => 'GET', + url => '/resource/4?a=1&b=2&bewit=MTIzNDU2XDQ1MTE0ODQ2MjFcMzFjMmNkbUJFd1NJRVZDOVkva1NFb2c3d3YrdEVNWjZ3RXNmOGNHU2FXQT1cc29tZS1hcHAtZGF0YQ', + host => 'example.com', + port => 8080, + ); + + Net::Hawk::Uri::authenticate( + %req, + &credentialsFunc, + {}, + sub ($err, %credentials, %attributes) { + ok(!$err,"no error"); + is(%credentials,'steve','correct user'); + is(%attributes,'some-app-data','ext passed on'); + }, + ); +}, 'authenticate a request (last param)'; + +subtest { + my %req = ( + method => 'GET', + url => '/resource/4?bewit=MTIzNDU2XDQ1MTE0ODQ2MjFcMzFjMmNkbUJFd1NJRVZDOVkva1NFb2c3d3YrdEVNWjZ3RXNmOGNHU2FXQT1cc29tZS1hcHAtZGF0YQ&a=1&b=2', + host => 'example.com', + port => 8080, + ); + + Net::Hawk::Uri::authenticate( + %req, + &credentialsFunc, + {}, + sub ($err, %credentials, %attributes) { + ok(!$err,"no error"); + is(%credentials,'steve','correct user'); + is(%attributes,'some-app-data','ext passed on'); + }, + ); +}, 'authenticate a request (first param)'; + +subtest { + my %req = ( + method => 'GET', + url => '/resource/4?bewit=MTIzNDU2XDQ1MTE0ODQ2NDFcZm1CdkNWT3MvcElOTUUxSTIwbWhrejQ3UnBwTmo4Y1VrSHpQd3Q5OXJ1cz1cc29tZS1hcHAtZGF0YQ', + host => 'example.com', + port => 8080, + ); + + Net::Hawk::Uri::authenticate( + %req, + &credentialsFunc, + {}, + sub ($err, %credentials, %attributes) { + ok(!$err,"no error"); + is(%credentials,'steve','correct user'); + is(%attributes,'some-app-data','ext passed on'); + }, + ); +}, 'authenticate a request (only param)'; + +subtest { + my %req = ( + method => 'GET', + url => '/resource/4?bewit=MTIzNDU2XDQ1MTE0ODQ2NDFcZm1CdkNWT3MvcElOTUUxSTIwbWhrejQ3UnBwTmo4Y1VrSHpQd3Q5OXJ1cz1cc29tZS1hcHAtZGF0YQ', + host => 'example.com', + port => 8080, + authorization => 'Basic asdasdasdasd', + ); + + Net::Hawk::Uri::authenticate( + %req, + &credentialsFunc, + {}, + sub ($err, %credentials, %attributes) { + ok($err,"error detected"); + is($err.text, + 'Multiple authentications', + 'correct error message'); + }, + ); +}, 'fail on multiple authentication'; + +subtest { + my %req = ( + method => 'POST', + url => '/resource/4?filter=a', + host => 'example.com', + port => 8080, + ); + + credentialsFunc('123456', sub ($err, %credentials) { + my $exp = floor(now_msecs() / 1000) + 60; + my $ext = 'some-app-data'; + my $mac = calculate_mac( + 'bewit', + %credentials, + { + ts => $exp, + nonce=> '', + method=> %req, + resource=> %req, + host => %req, + port=> %req, + ext=> $ext, + }, + ); + + my $bewit = "%credentials\\$exp\\$mac\\$ext"; + $bewit = uri_escape($mime.encode-str($bewit)); + %req ~= "\&bewit=$bewit"; + + Net::Hawk::Uri::authenticate( + %req, + &credentialsFunc, + {}, + sub ($err, %credentials, %attributes) { + ok($err,"error detected"); + is($err.text, + 'Invalid method', + 'correct error message'); + }, + ); + }); +}, 'fail on method other than GET'; + done; -- cgit v1.2.3