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(
%req!,
&credentials_func:($,&)!,
%options!,
&callback:($,%,%)!,
) {
%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> {
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> {
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>;
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;
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> {
return &callback.(
Net::Hawk::Errors::UnAuthorized.new(
text => 'Bad mac',
),
%credentials,
%bewit,
);
};
return &callback.(Nil,%credentials,%bewit);
},
);
};
};