File Coverage

blib/lib/Validate/Yubikey.pm
Criterion Covered Total %
statement 60 85 70.5
branch 15 32 46.8
condition 3 9 33.3
subroutine 6 8 75.0
pod 2 5 40.0
total 86 139 61.8


line stmt bran cond sub pod time code
1             package Validate::Yubikey;
2              
3             our $VERSION = '0.03';
4              
5             =head1 NAME
6              
7             Validate::Yubikey - Validate Yubikey OTPs
8              
9             =head1 SYNOPSIS
10              
11             use Validate::Yubikey;
12              
13             sub validate_callback {
14             my $public_id = shift;
15              
16             return {
17             iid => $iid,
18             key => $key,
19             count => $count,
20             use => $use,
21             lastuse => $lastuse,
22             lastts => $lastts,
23             };
24             }
25              
26             sub update_callback {
27             my ($public_id, $data) = @_;
28             }
29              
30             sub log_message {
31             print shift, "\n";
32             }
33              
34             my $yubi = Validate::Yubikey->new(
35             callback => \&validate_callback,
36             update_callback => \&update_callback,
37             log_callback => \&log_message,
38             );
39              
40             my $otp_valid = $yubi->validate("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx");
41              
42             =head1 DESCRIPTION
43              
44             The Yubikey is a hardware OTP token produced by Yubico (L).
45              
46             This module provides validation of Yubikey OTPs. It relies on you to specify
47             callback functions that handle retrieving token information from somewhere and
48             updating the persistent information associated with each token.
49              
50             =cut
51              
52 1     1   12666 use Carp;
  1         1  
  1         56  
53 1     1   385 use Crypt::Rijndael;
  1         299  
  1         676  
54              
55             sub hex2modhex {
56 0     0 0 0 my $s = shift;
57 0         0 $s =~ tr/0123456789abcdef/cbdefghijklnrtuv/;
58 0         0 return $s;
59             }
60              
61             sub modhex2hex {
62 1     1 0 1 my $s = shift;
63 1         3 $s =~ tr/cbdefghijklnrtuv/0123456789abcdef/;
64 1         1 return $s;
65             }
66              
67             sub yubicrc {
68 1     1 0 1 my $data = shift;
69 1         1 my $crc = 0xffff;
70              
71 1         4 foreach my $h (unpack('H2' x 16, $data)) {
72 16         10 my $d = hex($h);
73 16         12 $crc = $crc ^ ($d & 0xff);
74 16         13 for (1..8) {
75 128         70 my $n = $crc & 1;
76 128         68 $crc = $crc >> 1;
77 128 100       138 if ($n != 0) {
78 64         50 $crc = $crc ^ 0x8408;
79             }
80             }
81             }
82            
83 1         3 return $crc;
84             }
85              
86             =head1 METHODS
87              
88             =head2 new
89              
90             Create a new Validate::Yubikey instance.
91              
92             =over 4
93              
94             =item callback
95              
96             Required.
97              
98             =item update_callback
99              
100             Required.
101              
102             =item log_callback
103              
104             Optional.
105              
106             =back
107              
108             =cut
109              
110             sub new {
111 1     1 1 321 my ($class, %data) = @_;
112 1         2 my $self = {};
113 1         2 bless $self, $class;
114              
115 1 50 33     7 if (exists $data{callback} && ref($data{callback}) eq 'CODE') {
116 1         4 $self->{callback} = $data{callback};
117             } else {
118 0         0 croak __PACKAGE__, '->new called without callback';
119             }
120              
121 1 50 33     6 if (exists $data{update_callback} && ref($data{update_callback}) eq 'CODE') {
122 1         2 $self->{update_callback} = $data{update_callback};
123             } else {
124 0         0 croak __PACKAGE__, '->new called without update_callback';
125             }
126              
127 1 50 33     5 if (exists $data{log_callback} && ref($data{log_callback}) eq 'CODE') {
128 1         2 $self->{log_callback} = $data{log_callback};
129             } else {
130 0     0   0 $self->{log_callback} = sub {};
131             }
132              
133 1 50       1 if ($data{max_age}) {
134 0         0 $self->{max_age} = $data{max_age};
135             } else {
136 1         2 $self->{max_age} = 60;
137             }
138              
139 1         2 return $self;
140             }
141              
142             =head2 validate
143              
144             =over 4
145              
146             =item Arguments: $otp, @callback_args
147              
148             =item Return Value: $success
149              
150             =back
151              
152             Validate an OTP.
153              
154             =cut
155              
156             sub validate {
157 1     1 1 427 my ($self, $otp, @cbargs) = @_;
158              
159 1 50       6 if ($otp =~ /^([cbdefghijklnrtuv]{0,16})([cbdefghijklnrtuv]{32})$/) {
160 1         3 my ($public_id, $cipher) = ($1, $2);
161              
162 1         3 my $token = $self->{callback}->($public_id, @cbargs);
163              
164 1 50       295 if (!$token) {
165 0         0 $self->{log_callback}->(sprintf('callback returned no token for pid %s', $public_id));
166 0         0 return 0;
167             }
168              
169 1         2 foreach my $k (qw/key count iid lastuse lastts use/) {
170 6 50       10 if (!defined($token->{$k})) {
171 0         0 carp "callback didn't return $k";
172 0         0 return 0;
173             }
174             }
175              
176 1         2 $cipher = &modhex2hex($cipher);
177              
178 1         20 my $crypt = Crypt::Rijndael->new(pack('H*', $token->{key}));
179 1         6 my $plaintext = $crypt->decrypt(pack('H*', $cipher));
180 1 50       2 unless (length $plaintext) {
181 0         0 carp 'decrypt failed';
182 0         0 return 0;
183             }
184 1         4 my $plainhex = unpack('H*', $plaintext);
185              
186 1 50       3 if (substr($plainhex, 0, length($token->{iid})) eq $token->{iid}) {
187 1         2 my $crc = &yubicrc($plaintext);
188              
189 1 50       2 if ($crc == 0xf0b8) {
190 1         3 my $count = hex(substr($plainhex, 14, 2).substr($plainhex, 12, 2));
191 1         1 my $use = hex(substr($plainhex, 22, 2));
192 1         1 my $low = substr($plainhex, 18, 2).substr($plainhex, 16, 2);
193 1         2 my $high = substr($plainhex, 20, 2);
194 1         1 my $ts = ((hex($high) << 16) + hex($low)) / 8; # XXX magic
195              
196 1         5 my $tinfo = sprintf('iid=%s, count=%d, use=%d, ts=%d', $token->{iid}, $count, $use, $ts);
197 1         4 my $tsnow = $token->{lastts} + (time() - $token->{lastuse});
198 1         2 my $tsage = $tsnow - $ts;
199 1         3 $self->{update_callback}->($public_id, { lastuse => time(), lastts => $ts });
200              
201 1 50       7 if ($count < $token->{count}) {
    50          
    50          
202 0         0 $self->{log_callback}->(sprintf('token %s failed: duplicate otp, count (%s)', $public_id, $tinfo));
203             } elsif ($count == $token->{count}) {
204 0 0       0 if ($use <= $token->{use}) {
    0          
205 0         0 $self->{log_callback}->(sprintf('token %s failed: duplicate otp in same session (%s)', $public_id, $tinfo));
206             } elsif ($tsage > $self->{max_age}) {
207 0         0 $self->{log_callback}->(sprintf('token %s failed: expired otp is %d seconds old (%s)', $public_id, $tsage, $tinfo));
208             } else {
209 0         0 $self->{log_callback}->(sprintf('token %s ok, same session (%s)', $public_id, $tinfo));
210 0         0 $self->{update_callback}->($public_id, { count => $count, use => $use });
211 0         0 return 1;
212             }
213             } elsif ($count > $token->{count}) {
214 1         3 $self->{log_callback}->(sprintf('token %s ok (%s)', $public_id, $tinfo));
215 1         60 $self->{update_callback}->($public_id, { count => $count, use => $use });
216 1         7 return 1;
217             } else {
218 0           $self->{log_callback}->(sprintf('something bad with token %s (%s)', $public_id, $tinfo));
219             }
220             } else {
221 0           $self->{log_callback}->(sprintf('token %s failed: corrupt otp (crc)', $public_id));
222             }
223             } else {
224 0           $self->{log_callback}->(sprintf('token %s failed: corrupt otp (internal id)', $public_id));
225             }
226             } else {
227 0           $self->{log_callback}->(sprintf('token %s failed: invalid otp', $public_id));
228             }
229              
230 0           return 0;
231             }
232              
233             =head1 CALLBACKS
234              
235             =head2 callback
236              
237             =over 4
238              
239             =item Receives: $public_id, @callback_args
240              
241             =item Returns: \%token_data
242              
243             =back
244              
245             Called during validation when information about the token is required.
246             Receives the public ID of the Yubikey. It's expected that your subroutine
247             returns a hash reference containing the following keys:
248              
249             =over 4
250              
251             =item iid - Internal ID
252              
253             =item key - Secret key
254              
255             =back
256              
257             Plus the four values stored by the L.
258              
259             =head2 update_callback
260              
261             =over 4
262              
263             =item Receives: $public_id, \%token_data, @callback_args
264              
265             =item Returns: nothing
266              
267             =back
268              
269             Called to update the persistent storage of token parameters that enable replay
270             protection. C<%token_data> will contain one or more of the following keys,
271             which should be associated with the supplied C<$public_id>:
272              
273             =over 4
274              
275             =item count
276              
277             =item use
278              
279             =item lastuse
280              
281             =item lastts
282              
283             =back
284              
285             These should all be integers.
286              
287             =head2 log_callback
288              
289             =over 4
290              
291             =item Receives: $log_message
292              
293             =item Returns: nothing
294              
295             =back
296              
297             Called with messages produced during validation. If not supplied to L,
298             logging will disabled.
299              
300             =head1 EXAMPLE
301              
302             Here's a simple program that uses L to store token information.
303              
304             package YKKSM::DB::Token;
305             use base qw/DBIx::Class/;
306            
307             __PACKAGE__->load_components(qw/PK::Auto Core/);
308             __PACKAGE__->table('token');
309             __PACKAGE__->add_columns(qw/uid pid iid key count use lastuse lastts/);
310             __PACKAGE__->set_primary_key('uid');
311            
312             package YKKSM::DB;
313             use base qw/DBIx::Class::Schema/;
314            
315             __PACKAGE__->load_classes(qw/Token/);
316            
317             package YKTest;
318             use Validate::Yubikey;
319            
320             my $schema = YKKSM::DB->connect("dbi:SQLite:dbname=yktest.db");
321            
322             my $yk = Validate::Yubikey->new(
323             callback => sub {
324             my $pid = shift;
325             my $token = $schema->resultset('Token')->find({ pid => $pid });
326            
327             if ($token) {
328             return {
329             iid => $token->iid,
330             key => $token->key,
331             count => $token->count,
332             use => $token->use,
333             lastuse => $token->lastuse,
334             lastts => $token->lastts,
335             };
336             } else {
337             return undef;
338             }
339             },
340             update_callback => sub {
341             my ($pid, $data) = @_;
342             my $token = $schema->resultset('Token')->find({ pid => $pid });
343             if ($token) {
344             $token->update($data);
345             } else {
346             die "asked to update nonexistent token $pid";
347             }
348             },
349             log_callback => sub {
350             print shift, "\n";
351             },
352             );
353            
354             if ($yk->validate($ARGV[0])) {
355             print "success!\n";
356             } else {
357             print "failure 8(\n";
358             }
359              
360             =head1 AUTHOR
361              
362             Ben Wilber
363              
364             But most of this module was derived from Yubico's PHP stuff.
365              
366             =head1 LICENSE
367              
368             This library is free software and may be distributed under the same terms
369             as perl itself.
370              
371             =cut
372              
373             1;