diff options
author | dakkar <dakkar@thenautilus.net> | 2014-12-21 11:34:04 +0000 |
---|---|---|
committer | dakkar <dakkar@thenautilus.net> | 2014-12-21 11:34:04 +0000 |
commit | aa127d020cc85e790c6caa158860a298142ed85d (patch) | |
tree | 9a08f5c7fc947558315751cdbc7485c753bedaed /lib/Net/Hawk/Utils.pm | |
parent | more client tests (diff) | |
download | net-hawk-aa127d020cc85e790c6caa158860a298142ed85d.tar.gz net-hawk-aa127d020cc85e790c6caa158860a298142ed85d.tar.bz2 net-hawk-aa127d020cc85e790c6caa158860a298142ed85d.zip |
authenticate client tests
Diffstat (limited to 'lib/Net/Hawk/Utils.pm')
-rw-r--r-- | lib/Net/Hawk/Utils.pm | 58 |
1 files changed, 55 insertions, 3 deletions
diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm index 2b50043..0c5e2fd 100644 --- a/lib/Net/Hawk/Utils.pm +++ b/lib/Net/Hawk/Utils.pm @@ -4,9 +4,14 @@ use warnings; use Time::HiRes qw(gettimeofday); use 5.010; use Moo; +use Types::Standard 1.000003 qw(Str Int Object ArrayRef Optional Undef); +use Types::URI qw(Uri); +use Type::Params qw(compile); +use Net::Hawk::Errors; sub parse_content_type { - my ($self,$header) = @_; + state $argcheck = compile(Object,Str|Undef); + my ($self,$header) = $argcheck->(@_); return '' unless defined $header; my ($ret) = $header =~ m{^\s*(\S+?)\s*(;|$)}; @@ -14,16 +19,63 @@ sub parse_content_type { } sub now_msecs { - my ($self,$offset_ms) = @_; + state $argcheck = compile(Object,Int); + my ($self,$offset_ms) = $argcheck->(@_); my ($sec,$usec) = gettimeofday; return $sec + int($usec/1000) + $offset_ms//0; } sub now_secs { - my ($self,$offset_ms) = @_; + state $argcheck = compile(Object,Int); + my ($self,$offset_ms) = $argcheck->(@_); return int(now_msecs($offset_ms)/1000); } +sub parse_authorization_header { + state $argcheck = compile(Object,Str|Undef,Optional[ArrayRef]); + my ($self,$header,$keys) = $argcheck->(@_); + $keys //= [qw(id ts nonce hash ext mac app dlg)]; + my %valid_keys; @valid_keys{@$keys}=(); + + Net::Hawk::Errors::UnAuthorized->throw(message=>'no header') + unless $header; + my ($attr_string) = $header =~ m{^hawk(?:\s+(.+))?$}i + or Net::Hawk::Errors::BadRequest->throw( + message => 'invalid header syntax', + value => $header, + ); + + my %attributes; + + my @attr_strings = split /\s*,\s*/, $attr_string; + for my $attr (@attr_strings) { + my ($key,$value) = $attr =~ m{^(\w+)="([^"\\]*)"} + or Net::Hawk::Errors::BadRequest->throw( + message => 'Bad header format', + value => $header, + ); + + Net::Hawk::Errors::BadRequest->throw( + message => "Unknown attribute $key", + value => $header, + ) unless exists $valid_keys{$key}; + + Net::Hawk::Errors::BadRequest->throw( + message => "Bad attribute value $value", + value => $header, + ) unless $value =~ m{^[ \w\!#\$%&'\(\)\*\+,\-\.\/\:;<\=>\?@\[\]\^`\{\|\}~]+$}; + + Net::Hawk::Errors::BadRequest->throw( + message => "Duplicate attribute $key", + value => $header, + ) if exists $attributes{$key}; + + $attributes{$key}=$value; + } + + return \%attributes; +} + 1; |