diff options
Diffstat (limited to 'lib/Net/Hawk/Server.pm')
| -rw-r--r-- | lib/Net/Hawk/Server.pm | 278 |
1 files changed, 269 insertions, 9 deletions
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); }; }; |