<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;_set(@parameters);
    my $uri    = URI::Split::uri_join(
        'otpauth', $fields{type},
        $class-&gt;_path(%fields),
        $class-&gt;_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 =&gt; $path, type =&gt; $type, account_name =&gt; $account_name);
    my $issuer_parameter = $self-&gt;query_param('issuer');
    if (defined $issuer_parameter) {
        if ((defined $issuer_prefix) &amp;&amp; ($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-&gt;query_param('secret')) {
        $fields{secret} = MIME::Base32::decode_base32($encoded_secret);
    }
    foreach my $name (qw(algorithm digits counter period)) {
        if (my $value = $self-&gt;query_param($name)) {
            $fields{$name} = $value;
        }
    }
    %fields = $self-&gt;_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 { $_ =&gt; 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 =&gt; 'SHA1', digits =&gt; 6, type =&gt; 'totp', period =&gt; 30);

sub _field {
    my ($self, $name, @remainder) = @_;
    my ($scheme, $type, $fields, $query, $frag) = $self-&gt;_parse();

    if (!@remainder) {
        if (defined $fields-&gt;{$name}) {
            return $fields-&gt;{$name};
        }
        else {
            return $defaults{$name};
        }
    }
    $fields-&gt;{$name} = shift @remainder;
    ${$self} = URI::Split::uri_join(
        $scheme, $fields-&gt;{type},
        $self-&gt;_path(%{$fields}),
        $self-&gt;_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[&amp;],
        map { join q[=], $_ =&gt; $fields{$_} }
        grep { exists $fields{$_} } @query_names;
}

sub _path {
    my ($class, %fields) = @_;
    my $path = $fields{label};
    return $path;
}

sub type {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('type', @parameters);
}

sub label {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('label', @parameters);
}

sub account_name {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('account_name', @parameters);
}

sub issuer {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('issuer', @parameters);
}

sub secret {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('secret', @parameters);
}

sub algorithm {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('algorithm', @parameters);
}

sub counter {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('counter', @parameters);
}

sub digits {
    my ($self, @parameters) = @_;
    return $self-&gt;_field('digits', @parameters);
}

sub period {
    my ($self, @parameters) = @_;
    return $self-&gt;_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-&gt;new( 'otpauth://totp/Example:alice@google.com?secret=NFZS25DINFZV643VOAZXELLTGNRXEM3UH4&amp;issuer=Example' );

  # same URI but created from arguments
  my $uri = URI::otpauth-&gt;new( type =&gt; 'totp', issuer =&gt; 'Example', account_name =&gt; 'alice@google.com', secret =&gt; 'is-this_sup3r-s3cr3t?' );
  
=head1 DESCRIPTION

This URI scheme is defined in L&lt;https://github.com/google/google-authenticator/wiki/Key-Uri-Format/&gt;:

=head1 SUBROUTINES/METHODS

=head2 C&lt;&lt; new &gt;&gt;

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&lt;cryptographic hash function|https://en.wikipedia.org/wiki/Cryptographic_hash_function&gt; that should be used.  Current values are L&lt;SHA1|https://en.wikipedia.org/wiki/SHA-1&gt;, L&lt;SHA256|https://en.wikipedia.org/wiki/SHA-2&gt; or L&lt;SHA512|https://en.wikipedia.org/wiki/SHA-2&gt;.  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&lt;length|https://github.com/google/google-authenticator/wiki/Key-Uri-Format/#digits&gt; 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&lt;application / system|https://github.com/google/google-authenticator/wiki/Key-Uri-Format/#issuer&gt; that this secret can be used to authenticate to.  It is an optional field.

=item * label - this is the L&lt;issuer and the account name|https://github.com/google/google-authenticator/wiki/Key-Uri-Format/#label&gt; joined with a ":" character.  It is an optional field.

=item * period - this is the L&lt;period that the TOTP code is valid for|https://github.com/google/google-authenticator/wiki/Key-Uri-Format/#counter&gt;.  It is an optional field and will default to 30 seconds.

=item * secret - this is the L&lt;key|https://en.wikipedia.org/wiki/Key_(cryptography)&gt; that the L&lt;TOTP|https://en.wikipedia.org/wiki/Time-based_one-time_password&gt;/L&lt;HOTP|https://en.wikipedia.org/wiki/HMAC-based_one-time_password&gt; 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&lt;hotp|https://en.wikipedia.org/wiki/HMAC-based_one-time_password&gt;' or 'L&lt;totp|https://en.wikipedia.org/wiki/Time-based_one-time_password&gt;'.  This field will default to 'totp'.

=back

=head2 C&lt;algorithm&gt;

Get or set the algorithm of this otpauth URI.

=head2 C&lt;account_name&gt;

Get or set the account_name of this otpauth URI.

=head2 C&lt;counter&gt;

Get or set the counter of this otpauth URI.

=head2 C&lt;digits&gt;

Get or set the digits of this otpauth URI.

=head2 C&lt;issuer&gt;

Get or set the issuer of this otpauth URI.

=head2 C&lt;label&gt;

Get or set the label of this otpauth URI.

=head2 C&lt;period&gt;

Get or set the period of this otpauth URI.

=head2 C&lt;secret&gt;

Get or set the secret of this otpauth URI.

=head2 C&lt;type&gt;

Get or set the type of this otpauth URI.

  my $type = $uri-&gt;type('hotp');

=head1 CONFIGURATION AND ENVIRONMENT

URI::otpauth requires no configuration files or environment variables.

=head1 DEPENDENCIES

L&lt;URI&gt;

=head1 DIAGNOSTICS

=over
 
=item C&lt;&lt; secret is a mandatory parameter for URI::otpauth &gt;&gt;
 
The secret parameter was not detected for the URI::otpauth-&gt;new() method.
 
=back

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS AND LIMITATIONS

To report a bug, or view the current list of bugs, please visit L&lt;https://github.com/libwww-perl/URI/issues&gt;

=head1 AUTHOR

David Dick C&lt;&lt; &lt;ddick@cpan.org&gt; &gt;&gt;

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2024, David Dick C&lt;&lt; &lt;ddick@cpan.org&gt; &gt;&gt;.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L&lt;perlartistic&gt;.
</pre></body></html>