2018-02-19 22:34:23 +01:00
|
|
|
package Lemonldap::NG::Common::TOTP;
|
|
|
|
|
2018-02-20 18:36:34 +01:00
|
|
|
# This module is inspired by Auth::GoogleAuth written by Gryphon Shafer
|
|
|
|
# <gryphon@cpan.org>
|
|
|
|
|
2018-02-19 22:34:23 +01:00
|
|
|
use strict;
|
|
|
|
use Mouse;
|
2019-01-31 23:16:11 +01:00
|
|
|
use Convert::Base32 qw(decode_base32 encode_base32);
|
|
|
|
use Crypt::URandom;
|
2018-02-19 22:47:10 +01:00
|
|
|
use Digest::HMAC_SHA1 'hmac_sha1_hex';
|
2018-02-19 22:34:23 +01:00
|
|
|
|
2020-12-04 23:05:11 +01:00
|
|
|
our $VERSION = '2.0.10';
|
2018-02-19 22:34:23 +01:00
|
|
|
|
2018-08-18 21:21:20 +02:00
|
|
|
# Verify that TOTP $code matches with $secret
|
2018-02-19 22:34:23 +01:00
|
|
|
sub verifyCode {
|
2018-02-21 22:07:12 +01:00
|
|
|
my ( $self, $interval, $range, $digits, $secret, $code ) = @_;
|
2018-02-19 22:34:23 +01:00
|
|
|
my $s = eval { decode_base32($secret) };
|
|
|
|
if ($@) {
|
|
|
|
$self->logger->error('Bad characters in TOTP secret');
|
|
|
|
return -1;
|
|
|
|
}
|
2020-12-04 23:05:11 +01:00
|
|
|
for ( -$range .. $range ) {
|
2018-02-21 22:07:12 +01:00
|
|
|
if ( $code eq $self->_code( $s, $_, $interval, $digits ) ) {
|
2020-12-04 23:05:11 +01:00
|
|
|
$self->userLogger->info("Codes match at range $_");
|
2018-02-19 22:34:23 +01:00
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2018-02-20 18:36:34 +01:00
|
|
|
# Internal subroutine that calculates TOTP code using $secret and $interval
|
2018-02-19 22:34:23 +01:00
|
|
|
sub _code {
|
2018-02-21 22:07:12 +01:00
|
|
|
my ( $self, $secret, $r, $interval, $digits ) = @_;
|
2018-02-19 22:34:23 +01:00
|
|
|
my $hmac = hmac_sha1_hex(
|
|
|
|
pack( 'H*',
|
2018-03-18 22:38:12 +01:00
|
|
|
sprintf( '%016x', int( ( time - $r * $interval ) / $interval ) ) ),
|
2018-02-19 22:34:23 +01:00
|
|
|
$secret,
|
|
|
|
);
|
|
|
|
|
|
|
|
return sprintf(
|
2018-02-21 22:07:12 +01:00
|
|
|
'%0' . $digits . 'd',
|
2018-02-19 22:34:23 +01:00
|
|
|
(
|
|
|
|
hex( substr( $hmac, hex( substr( $hmac, -1 ) ) * 2, 8 ) ) &
|
|
|
|
0x7fffffff
|
2018-08-18 21:21:20 +02:00
|
|
|
) % 10**$digits
|
2018-02-19 22:34:23 +01:00
|
|
|
);
|
|
|
|
}
|
|
|
|
|
2018-02-20 18:36:34 +01:00
|
|
|
# Simply generate new base32 secret
|
|
|
|
sub newSecret {
|
|
|
|
my ($self) = @_;
|
2019-01-31 23:16:11 +01:00
|
|
|
return encode_base32( Crypt::URandom::urandom(20) );
|
2018-02-20 18:36:34 +01:00
|
|
|
}
|
|
|
|
|
2018-02-19 22:34:23 +01:00
|
|
|
1;
|