File Coverage

blib/lib/Auth/GoogleAuth.pm

Criterion	Covered	Total	%
statement	73	74	98.6
branch	19	22	86.3
condition	17	26	65.3
subroutine	17	17	100.0
pod	6	6	100.0
total	132	145	91.0

package Auth::GoogleAuth;
# ABSTRACT: Google Authenticator TBOT Abstraction

use 5.010;
use strict;
use warnings;

use base 'Class::Accessor';

use Carp 'croak';
use Convert::Base32 qw( encode_base32 decode_base32 );
use Crypt::PRNG 'rand';
use Digest::HMAC_SHA1 'hmac_sha1_hex';
use URI::Escape 'uri_escape';

our $VERSION = '1.10'; # VERSION

my @accessors = qw( secret secret32 issuer key_id );
__PACKAGE__->mk_accessors(@accessors);

sub generate_secret32 {
    my ($self) = @_;
    my @chars = ( 'a' .. 'z', 2 .. 7 );
    return $self->secret32( join( '', @chars[ map { rand( scalar(@chars) ) } 1 .. 16 ] ) );
}

sub clear {
    my ($self) = @_;
    $self->$_(undef) for (@accessors);
    return;
}

sub otpauth {
    my ( $self, $secret32, $key_id, $issuer ) = @_;

    $self->_secret_check($secret32);

    $self->key_id($key_id) if ( defined $key_id );
    $self->issuer($issuer) if ( defined $issuer );

    $self->key_id('Undefined') unless ( $self->key_id );
    $self->issuer('Undefined') unless ( $self->issuer );

    return
        'otpauth://totp/' .
        uri_escape( $self->issuer ) . ':' . uri_escape( $self->key_id ) .
        '?secret=' . $self->secret32 . '&issuer=' . uri_escape( $self->issuer );
}

sub qr_code {
    my ( $self, $secret32, $key_id, $issuer, $return_otpauth ) = @_;
    my $otpauth = $self->otpauth( $secret32, $key_id, $issuer );
    return ($return_otpauth)
        ? $self->otpauth
        : 'https://quickchart.io/chart?chs=200x200&cht=qr&chl=' . uri_escape( $self->otpauth );
}

sub code {
    my ( $self, $secret32, $timestamp, $interval ) = @_;
    $self->_secret_check($secret32);

    $timestamp ||= time;
    $interval  ||= 30;

    my $hmac = hmac_sha1_hex(
        pack( 'H*', sprintf( '%016x', int( $timestamp / $interval ) ) ),
        _decode_base32( $self->secret32 ),
    );

    return sprintf(
        '%06d',
        ( hex( substr( $hmac, hex( substr( $hmac, -1 ) ) * 2, 8 ) ) & 0x7fffffff ) % 1000000
    );
}

sub verify {
    my ( $self, $code, $range, $secret32, $timestamp, $interval ) = @_;
    $self->_secret_check($secret32);

    $code      ||= '';
    $range     ||= 0;
    $timestamp ||= time;
    $interval  ||= 30;

    croak('Range value not zero or a positive number') unless ( $range =~ /^\d+$/ and $range >= 0 );

    for ( 0 .. $range ) {
        return 1 if (
            not $_ and $code eq $self->code( $secret32, $timestamp, $interval )
            or
            $code eq $self->code( $secret32, $timestamp + $interval * $_, $interval )
            or
            $code eq $self->code( $secret32, $timestamp - $interval * $_, $interval )
        );
    }

    return 0;
}

sub _secret_check {
    my ( $self, $secret32 ) = @_;

    if ($secret32) {
        $self->secret32($secret32);
        $self->secret( _decode_base32($secret32) );
    }

    if ( not $self->secret32 ) {
        if ( not $self->secret ) {
            $self->secret( _decode_base32( $self->generate_secret32 ) );
        }
        else {
            $self->secret32( encode_base32( $self->secret ) );
        }
    }

    return;
}

sub _decode_base32 {
    my ($data) = @_;
    my $rv;
    eval{ $rv = decode_base32($data) };
    croak("Error decoding what should be base32 data: $data")
        if ( $@ =~ /Data contains non-base32 characters/ );
    return $rv;
}

1;

__END__