diff options
Diffstat (limited to 'lib/Net')
-rw-r--r-- | lib/Net/Hawk/Client.pm | 49 | ||||
-rw-r--r-- | lib/Net/Hawk/Crypto.pm | 19 | ||||
-rw-r--r-- | lib/Net/Hawk/Errors.pm | 6 | ||||
-rw-r--r-- | lib/Net/Hawk/Server.pm | 278 | ||||
-rw-r--r-- | lib/Net/Hawk/Uri.pm | 2 | ||||
-rw-r--r-- | lib/Net/Hawk/Utils.pm | 36 |
6 files changed, 366 insertions, 24 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 <hash ext app dlg> -> $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,<ts tsm error>, ); }; @@ -128,8 +130,7 @@ package Net::Hawk::Client { $credentials, %( %$artifacts, - ext => $attributes<ext>, - hash => $attributes<hash>, + $attributes<ext hash> :p, ), ); return False unless $mac eq $attributes<mac>; @@ -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<ttl_sec>.defined + && %options<credentials> + && %options<credentials>{all <id key algorithm>}.defined + && is_valid_hash_algorithm(%options<credentials><algorithm>) + ; + + %options<ext> //= ''; + my $now = now_msecs(%options<localtime_offset_msec>//0); + my $exp = floor($now/1000)+%options<ttl_sec>; + my $mac = calculate_mac( + 'bewit', + %options<credentials>, + { + ts => $exp, + nonce => '', + method => 'GET', + resource => $uri.path_query, + host => $uri.host, + port => +($uri.port) // ($uri.scheme eq 'http' ?? 80 !! 443), + %options<ext> :p, + } + ); + + my $bewit = "%options<credentials><id>\\$exp\\$mac\\%options<ext>"; + 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<url> ~~ m{'bewit=' $<ext>=(.*?) ['&'|$]}; - my %attributes = ( - ext => $/<ext>; + + %options<nonce_func> //= sub ($,$,&nonceCallback) { return &nonceCallback.() }; + %options<timestamp_skew_sec> //= 60; + my $now = now_msecs(%options<localtime_offset_msec>//0); + my %request = parse_request(%req,%options); + my $attributes = try { + parse_authorization_header(%request<authorization>); + }; + warn $attributes.perl; + return &callback.($!,{},{}) unless $attributes; + + my %artifacts = ( + %request<method host port> :p, + resource => %request<url>, + $attributes<ts nonce hash ext app dlg mac id> :p, + ); + + if not $attributes{all(<id ts nonce mac>)} :exists { + return &callback.( + Net::Hawk::Errors::BadRequest.new( + text => 'Missing attributes', + value => %request<authorization>, + ), + Nil, + %artifacts, + ); + }; + + &credentials_func.( + $attributes<id>, + 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(<key algorithm>)}.defined { + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Invalid credentials', + ), + %credentials, + %artifacts, + ); + }; + if not is_valid_hash_algorithm %credentials<algorithm> { + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Unknown algorithm', + ), + %credentials, + %artifacts, + ); + }; + + my $mac = calculate_mac('header',%credentials,%artifacts); + unless $mac eq $attributes<mac> { # DANGER! this should be a fixed-time comparison! + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Bad mac', + ), + %credentials, + %artifacts, + ); + }; + + if (%options<payload>.defined) { + if not $attributes<hash> { + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Missing required payload hash', + ), + %credentials, + %artifacts, + ); + }; + + my $hash = calculate_payload_hash( + %options<payload>, + %credentials<algorithm>, + %request<content_type>, + ); + unless $hash eq $attributes<hash> { # DANGER! this should be a fixed-time comparison! + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Bad payload hash', + ), + %credentials, + %artifacts, + ); + }; + }; + + %options<nonce_func>.( + $attributes<nonce>, + $attributes<ts>, + sub ($err) { + if $err { + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Invalid nonce', + ), + %credentials, + %artifacts, + ); + }; + + if abs(($attributes<ts> * 1000) - $now) > + (%options<timestamp_skew_sec> * 1000) { + my $tsm = timestamp_message( + %credentials, + %options<localtime_offset_msec>, + ); + 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<localtime_offset_msec>//0); + my %request = parse_request(%req,%options); + my $resource = URI.new(%request<url>); + return &callback.(Net::Hawk::Errors::UnAuthorized.new,{},{}) + unless $resource; + my $bewit_param = $resource.query_form<bewit>; + 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<method> eq any(<GET HEAD>); + return &callback.( + Net::Hawk::Errors::BadRequest.new( + text => 'Multiple authentications', + ), + {}, + {}, + ) if %request<authorization>; + + # 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 <id exp mac>}.defined; + + return &callback.( + Net::Hawk::Errors::UnAuthorized.new( + text => 'Access expired', + ), + {}, + {}, + ) if %bewit<exp>*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<url>.subst( + /( <?after '?'> | '&') bewit\=.*? ( '&'| $ )/, + { $1 && $2 ?? '&' !! '' } + ); + + &credentials_func.( + %bewit<id>, + sub ($err,%credentials) { + return &callback.($err,%credentials//{},%bewit<ext>//{}) + 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 <key algorithm>}.defined; + if not is_valid_hash_algorithm %credentials<algorithm> { + return &callback.( + Net::Hawk::Errors::Internal.new( + text => 'Unknown algorithm', + ), + %credentials, + %bewit, + ); + }; + + my $mac = calculate_mac('bewit',%credentials,{ + ts => %bewit<exp>, + nonce => '', + method => 'GET', + resource => $url, + %request<host port> :p, + %bewit<ext> :p, + }); + unless $mac eq %bewit<mac> { # 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<connection><encrypted> ?? '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<headers>; + + my %host; + unless %options{all(<host port>)}.defined { + %host = parse_host(%req,%options<host_header_name>); + Net::Hawk::Errors::BadRequest.new( + text => 'Invalid Host header', + value => %req, + ).throw unless %host; + }; + + my %request = ( + %req<method url> :p, + host => %options<host> // %host<name>, + port => %options<port> // %host<port>, + authorization => %req<headers><authorization>, + content_type => %req<headers><content_type> // '', + ); + return %request; + }; } 1; |