aboutsummaryrefslogtreecommitdiff
path: root/lib/Net
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/Hawk/Client.pm49
-rw-r--r--lib/Net/Hawk/Crypto.pm19
-rw-r--r--lib/Net/Hawk/Errors.pm6
-rw-r--r--lib/Net/Hawk/Server.pm278
-rw-r--r--lib/Net/Hawk/Uri.pm2
-rw-r--r--lib/Net/Hawk/Utils.pm36
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;