package URI::otpauth;
use warnings;
use strict;
use MIME::Base32();
use URI::Split();
use URI::Escape();
use parent qw( URI URI::_query );
our $VERSION = '5.31';
sub new {
my ($class, @parameters) = @_;
my %fields = $class->_set(@parameters);
my $uri = URI::Split::uri_join(
'otpauth', $fields{type},
$class->_path(%fields),
$class->_query(%fields),
);
return bless \$uri, $class;
}
sub _parse {
my $self = shift;
my ($scheme, $type, $path, $query, $frag) = URI::Split::uri_split(${$self});
$path =~ s/^\///smxg;
my @path_parts = split /:/smx, $path;
my ($issuer_prefix, $account_name);
if (scalar @path_parts == 1) {
$account_name = $path_parts[0];
}
else {
$issuer_prefix = $path_parts[0];
$account_name = $path_parts[1];
}
my %fields = (label => $path, type => $type, account_name => $account_name);
my $issuer_parameter = $self->query_param('issuer');
if (defined $issuer_parameter) {
if ((defined $issuer_prefix) && ($issuer_prefix ne $issuer_parameter)) {
Carp::carp(
"Issuer prefix from label '$issuer_prefix' does not match issuer parameter '$issuer_parameter'"
);
}
$fields{issuer} = $issuer_parameter;
}
elsif (defined $issuer_prefix) {
$fields{issuer} = URI::Escape::uri_unescape($issuer_prefix);
}
if (my $encoded_secret = $self->query_param('secret')) {
$fields{secret} = MIME::Base32::decode_base32($encoded_secret);
}
foreach my $name (qw(algorithm digits counter period)) {
if (my $value = $self->query_param($name)) {
$fields{$name} = $value;
}
}
%fields = $self->_set(%fields);
return ($scheme, $fields{type}, \%fields, $query, $frag);
}
my $label_escape_regex = qr/[^[:alnum:]@.]/smx;
sub _set {
my ($self, %fields) = @_;
delete $fields{label};
if (defined $fields{account_name}) {
if (defined $fields{issuer}) {
$fields{label} = $fields{issuer} . q[:] . $fields{account_name};
}
else {
$fields{label} = $fields{account_name};
}
}
if (!length $fields{type}) {
$fields{type} = 'totp';
}
return %fields;
}
my %field_names = map { $_ => 1 }
qw(secret label counter algorithm period digits issuer type account_name);
my @query_names = qw(secret issuer algorithm digits counter period);
my %defaults = (algorithm => 'SHA1', digits => 6, type => 'totp', period => 30);
sub _field {
my ($self, $name, @remainder) = @_;
my ($scheme, $type, $fields, $query, $frag) = $self->_parse();
if (!@remainder) {
if (defined $fields->{$name}) {
return $fields->{$name};
}
else {
return $defaults{$name};
}
}
$fields->{$name} = shift @remainder;
${$self} = URI::Split::uri_join(
$scheme, $fields->{type},
$self->_path(%{$fields}),
$self->_query(%{$fields}), $frag
);
return $self;
}
sub _query {
my ($class, %fields) = @_;
if (defined $fields{secret}) {
$fields{secret} = MIME::Base32::encode_base32($fields{secret});
}
else {
Carp::croak('secret is a mandatory parameter for ' . __PACKAGE__);
}
return join q[&],
map { join q[=], $_ => $fields{$_} }
grep { exists $fields{$_} } @query_names;
}
sub _path {
my ($class, %fields) = @_;
my $path = $fields{label};
return $path;
}
sub type {
my ($self, @parameters) = @_;
return $self->_field('type', @parameters);
}
sub label {
my ($self, @parameters) = @_;
return $self->_field('label', @parameters);
}
sub account_name {
my ($self, @parameters) = @_;
return $self->_field('account_name', @parameters);
}
sub issuer {
my ($self, @parameters) = @_;
return $self->_field('issuer', @parameters);
}
sub secret {
my ($self, @parameters) = @_;
return $self->_field('secret', @parameters);
}
sub algorithm {
my ($self, @parameters) = @_;
return $self->_field('algorithm', @parameters);
}
sub counter {
my ($self, @parameters) = @_;
return $self->_field('counter', @parameters);
}
sub digits {
my ($self, @parameters) = @_;
return $self->_field('digits', @parameters);
}
sub period {
my ($self, @parameters) = @_;
return $self->_field('period', @parameters);
}
1;
__END__
=head1 NAME
URI::otpauth - URI scheme for secret keys for OTP secrets. Usually found in QR codes
=head1 VERSION
Version 5.29
=head1 SYNOPSIS
use URI;
# optauth URI from textual uri
my $uri = URI->new( 'otpauth://totp/Example:alice@google.com?secret=NFZS25DINFZV643VOAZXELLTGNRXEM3UH4&issuer=Example' );
# same URI but created from arguments
my $uri = URI::otpauth->new( type => 'totp', issuer => 'Example', account_name => 'alice@google.com', secret => 'is-this_sup3r-s3cr3t?' );
=head1 DESCRIPTION
This URI scheme is defined in L:
=head1 SUBROUTINES/METHODS
=head2 C<< new >>
Create a new URI::otpauth. The available arguments are listed below;
=over
=item * account_name - this can be the account name (probably an email address) used when authenticating with this secret. It is an optional field.
=item * algorithm - this is the L that should be used. Current values are L, L or L. It is an optional field and will default to SHA1.
=item * counter - this is only required when the type is HOTP.
=item * digits - this determines the L of the code presented to the user. It is an optional field and will default to 6 digits.
=item * issuer - this can be the L that this secret can be used to authenticate to. It is an optional field.
=item * label - this is the L joined with a ":" character. It is an optional field.
=item * period - this is the L. It is an optional field and will default to 30 seconds.
=item * secret - this is the L that the L/L algorithm uses to derive the value. It is an arbitrary byte string and must remain private. This field is mandatory.
=item * type - this can be 'L' or 'L'. This field will default to 'totp'.
=back
=head2 C
Get or set the algorithm of this otpauth URI.
=head2 C
Get or set the account_name of this otpauth URI.
=head2 C
Get or set the counter of this otpauth URI.
=head2 C
Get or set the digits of this otpauth URI.
=head2 C
Get or set the issuer of this otpauth URI.
=head2 C