Validate-Yubikey-0.03000755001232001232 012744520346 13004 5ustar00bwbw000000000000Validate-Yubikey-0.03/META.yml000444001232001232 110212744520346 14404 0ustar00bwbw000000000000--- abstract: 'Validate Yubikey OTPs' author: - 'Ben Wilber ' build_requires: {} configure_requires: Module::Build: '0.42' dynamic_config: 1 generated_by: 'Module::Build version 0.4214, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Validate-Yubikey provides: Validate::Yubikey: file: lib/Validate/Yubikey.pm version: '0.03' requires: Crypt::Rijndael: '1.09' perl: v5.6.1 resources: license: http://dev.perl.org/licenses/ version: '0.03' Validate-Yubikey-0.03/MANIFEST000444001232001232 15512744520346 14253 0ustar00bwbw000000000000Build.PL lib/Validate/Yubikey.pm t/Yubikey.t MANIFEST This list of files META.yml META.json README CHANGES Validate-Yubikey-0.03/META.json000444001232001232 161012744520346 14560 0ustar00bwbw000000000000{ "abstract" : "Validate Yubikey OTPs", "author" : [ "Ben Wilber " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4214", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Validate-Yubikey", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.42" } }, "runtime" : { "requires" : { "Crypt::Rijndael" : "1.09", "perl" : "v5.6.1" } } }, "provides" : { "Validate::Yubikey" : { "file" : "lib/Validate/Yubikey.pm", "version" : "0.03" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.03" } Validate-Yubikey-0.03/CHANGES000444001232001232 25612744520346 14117 0ustar00bwbw000000000000v0.03, 22.07.2016 - Really remove dependency on Crypt::ECB (thanks Nick Morrott) v0.02, 13.03.2016 - Remove dependency on Crypt::ECB v0.01, 28.12.2011 - initial release Validate-Yubikey-0.03/Build.PL000444001232001232 27712744520346 14423 0ustar00bwbw000000000000use Module::Build; Module::Build->new( module_name => 'Validate::Yubikey', license => 'perl', requires => { perl => '5.6.1', 'Crypt::Rijndael' => '1.09', }, )->create_build_script(); Validate-Yubikey-0.03/README000444001232001232 53212744520346 14001 0ustar00bwbw000000000000Validate::Yubikey - Validate Yubikey OTPs The Yubikey is a hardware OTP token produced by Yubico (http://www.yubico.com). This module provides validation of Yubikey OTPs. It relies on you to specify callback functions that handle retrieving token information from somewhere and updating the persistent information associated with each token. Validate-Yubikey-0.03/t000755001232001232 012744520346 13247 5ustar00bwbw000000000000Validate-Yubikey-0.03/t/Yubikey.t000444001232001232 146712744520346 15222 0ustar00bwbw000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; BEGIN { use_ok('Validate::Yubikey'); } can_ok('Validate::Yubikey', ('new')); my $did_update = 0; my $did_log = 0; my $y = Validate::Yubikey->new( callback => sub { is(shift, 'nednerfbfclb', 'pid matches'); return { iid => '935f19d93120', key => '751d7ee66131350cfffb4fb6c05df1af', count => 0, use => 0, lastuse => 0, lastts => 0, }; }, update_callback => sub { $did_update++; }, log_callback => sub { note(shift); $did_log++; }, ); isa_ok($y, 'Validate::Yubikey'); can_ok($y, ('validate')); my $success = $y->validate('nednerfbfclbfjilhkuijcungegkchdbtkfgrfhkluec'); isnt($success, 0, 'validation successful'); isnt($did_update, 0, 'update callback called'); isnt($did_log, 0, 'logging callback called'); 1; Validate-Yubikey-0.03/lib000755001232001232 012744520346 13552 5ustar00bwbw000000000000Validate-Yubikey-0.03/lib/Validate000755001232001232 012744520346 15303 5ustar00bwbw000000000000Validate-Yubikey-0.03/lib/Validate/Yubikey.pm000444001232001232 2213012744520346 17435 0ustar00bwbw000000000000package Validate::Yubikey; our $VERSION = '0.03'; =head1 NAME Validate::Yubikey - Validate Yubikey OTPs =head1 SYNOPSIS use Validate::Yubikey; sub validate_callback { my $public_id = shift; return { iid => $iid, key => $key, count => $count, use => $use, lastuse => $lastuse, lastts => $lastts, }; } sub update_callback { my ($public_id, $data) = @_; } sub log_message { print shift, "\n"; } my $yubi = Validate::Yubikey->new( callback => \&validate_callback, update_callback => \&update_callback, log_callback => \&log_message, ); my $otp_valid = $yubi->validate("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"); =head1 DESCRIPTION The Yubikey is a hardware OTP token produced by Yubico (L). This module provides validation of Yubikey OTPs. It relies on you to specify callback functions that handle retrieving token information from somewhere and updating the persistent information associated with each token. =cut use Carp; use Crypt::Rijndael; sub hex2modhex { my $s = shift; $s =~ tr/0123456789abcdef/cbdefghijklnrtuv/; return $s; } sub modhex2hex { my $s = shift; $s =~ tr/cbdefghijklnrtuv/0123456789abcdef/; return $s; } sub yubicrc { my $data = shift; my $crc = 0xffff; foreach my $h (unpack('H2' x 16, $data)) { my $d = hex($h); $crc = $crc ^ ($d & 0xff); for (1..8) { my $n = $crc & 1; $crc = $crc >> 1; if ($n != 0) { $crc = $crc ^ 0x8408; } } } return $crc; } =head1 METHODS =head2 new Create a new Validate::Yubikey instance. =over 4 =item callback Required. =item update_callback Required. =item log_callback Optional. =back =cut sub new { my ($class, %data) = @_; my $self = {}; bless $self, $class; if (exists $data{callback} && ref($data{callback}) eq 'CODE') { $self->{callback} = $data{callback}; } else { croak __PACKAGE__, '->new called without callback'; } if (exists $data{update_callback} && ref($data{update_callback}) eq 'CODE') { $self->{update_callback} = $data{update_callback}; } else { croak __PACKAGE__, '->new called without update_callback'; } if (exists $data{log_callback} && ref($data{log_callback}) eq 'CODE') { $self->{log_callback} = $data{log_callback}; } else { $self->{log_callback} = sub {}; } if ($data{max_age}) { $self->{max_age} = $data{max_age}; } else { $self->{max_age} = 60; } return $self; } =head2 validate =over 4 =item Arguments: $otp, @callback_args =item Return Value: $success =back Validate an OTP. =cut sub validate { my ($self, $otp, @cbargs) = @_; if ($otp =~ /^([cbdefghijklnrtuv]{0,16})([cbdefghijklnrtuv]{32})$/) { my ($public_id, $cipher) = ($1, $2); my $token = $self->{callback}->($public_id, @cbargs); if (!$token) { $self->{log_callback}->(sprintf('callback returned no token for pid %s', $public_id)); return 0; } foreach my $k (qw/key count iid lastuse lastts use/) { if (!defined($token->{$k})) { carp "callback didn't return $k"; return 0; } } $cipher = &modhex2hex($cipher); my $crypt = Crypt::Rijndael->new(pack('H*', $token->{key})); my $plaintext = $crypt->decrypt(pack('H*', $cipher)); unless (length $plaintext) { carp 'decrypt failed'; return 0; } my $plainhex = unpack('H*', $plaintext); if (substr($plainhex, 0, length($token->{iid})) eq $token->{iid}) { my $crc = &yubicrc($plaintext); if ($crc == 0xf0b8) { my $count = hex(substr($plainhex, 14, 2).substr($plainhex, 12, 2)); my $use = hex(substr($plainhex, 22, 2)); my $low = substr($plainhex, 18, 2).substr($plainhex, 16, 2); my $high = substr($plainhex, 20, 2); my $ts = ((hex($high) << 16) + hex($low)) / 8; # XXX magic my $tinfo = sprintf('iid=%s, count=%d, use=%d, ts=%d', $token->{iid}, $count, $use, $ts); my $tsnow = $token->{lastts} + (time() - $token->{lastuse}); my $tsage = $tsnow - $ts; $self->{update_callback}->($public_id, { lastuse => time(), lastts => $ts }); if ($count < $token->{count}) { $self->{log_callback}->(sprintf('token %s failed: duplicate otp, count (%s)', $public_id, $tinfo)); } elsif ($count == $token->{count}) { if ($use <= $token->{use}) { $self->{log_callback}->(sprintf('token %s failed: duplicate otp in same session (%s)', $public_id, $tinfo)); } elsif ($tsage > $self->{max_age}) { $self->{log_callback}->(sprintf('token %s failed: expired otp is %d seconds old (%s)', $public_id, $tsage, $tinfo)); } else { $self->{log_callback}->(sprintf('token %s ok, same session (%s)', $public_id, $tinfo)); $self->{update_callback}->($public_id, { count => $count, use => $use }); return 1; } } elsif ($count > $token->{count}) { $self->{log_callback}->(sprintf('token %s ok (%s)', $public_id, $tinfo)); $self->{update_callback}->($public_id, { count => $count, use => $use }); return 1; } else { $self->{log_callback}->(sprintf('something bad with token %s (%s)', $public_id, $tinfo)); } } else { $self->{log_callback}->(sprintf('token %s failed: corrupt otp (crc)', $public_id)); } } else { $self->{log_callback}->(sprintf('token %s failed: corrupt otp (internal id)', $public_id)); } } else { $self->{log_callback}->(sprintf('token %s failed: invalid otp', $public_id)); } return 0; } =head1 CALLBACKS =head2 callback =over 4 =item Receives: $public_id, @callback_args =item Returns: \%token_data =back Called during validation when information about the token is required. Receives the public ID of the Yubikey. It's expected that your subroutine returns a hash reference containing the following keys: =over 4 =item iid - Internal ID =item key - Secret key =back Plus the four values stored by the L. =head2 update_callback =over 4 =item Receives: $public_id, \%token_data, @callback_args =item Returns: nothing =back Called to update the persistent storage of token parameters that enable replay protection. C<%token_data> will contain one or more of the following keys, which should be associated with the supplied C<$public_id>: =over 4 =item count =item use =item lastuse =item lastts =back These should all be integers. =head2 log_callback =over 4 =item Receives: $log_message =item Returns: nothing =back Called with messages produced during validation. If not supplied to L, logging will disabled. =head1 EXAMPLE Here's a simple program that uses L to store token information. package YKKSM::DB::Token; use base qw/DBIx::Class/; __PACKAGE__->load_components(qw/PK::Auto Core/); __PACKAGE__->table('token'); __PACKAGE__->add_columns(qw/uid pid iid key count use lastuse lastts/); __PACKAGE__->set_primary_key('uid'); package YKKSM::DB; use base qw/DBIx::Class::Schema/; __PACKAGE__->load_classes(qw/Token/); package YKTest; use Validate::Yubikey; my $schema = YKKSM::DB->connect("dbi:SQLite:dbname=yktest.db"); my $yk = Validate::Yubikey->new( callback => sub { my $pid = shift; my $token = $schema->resultset('Token')->find({ pid => $pid }); if ($token) { return { iid => $token->iid, key => $token->key, count => $token->count, use => $token->use, lastuse => $token->lastuse, lastts => $token->lastts, }; } else { return undef; } }, update_callback => sub { my ($pid, $data) = @_; my $token = $schema->resultset('Token')->find({ pid => $pid }); if ($token) { $token->update($data); } else { die "asked to update nonexistent token $pid"; } }, log_callback => sub { print shift, "\n"; }, ); if ($yk->validate($ARGV[0])) { print "success!\n"; } else { print "failure 8(\n"; } =head1 AUTHOR Ben Wilber But most of this module was derived from Yubico's PHP stuff. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. =cut 1;