| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Authen::Passphrase::Scrypt; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 18898 | use 5.014000; | 
|  | 1 |  |  |  |  | 4 |  | 
| 4 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 17 |  | 
| 5 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 7 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 6 | 1 |  |  | 1 |  | 5 | use Carp; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 66 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 1 |  |  | 1 |  | 366 | use parent qw/Exporter Authen::Passphrase Class::Accessor::Fast/; | 
|  | 1 |  |  |  |  | 231 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | our @EXPORT = qw/crypto_scrypt/; | 
| 11 |  |  |  |  |  |  | our @EXPORT_OK = @EXPORT; | 
| 12 |  |  |  |  |  |  | our $VERSION = '0.001'; | 
| 13 |  |  |  |  |  |  |  | 
| 14 | 1 |  |  | 1 |  | 7051 | use Data::Entropy::Algorithms qw/rand_bits/; | 
|  | 1 |  |  |  |  | 10378 |  | 
|  | 1 |  |  |  |  | 59 |  | 
| 15 | 1 |  |  | 1 |  | 435 | use Digest::SHA qw/sha256 hmac_sha256/; | 
|  | 1 |  |  |  |  | 2692 |  | 
|  | 1 |  |  |  |  | 71 |  | 
| 16 | 1 |  |  | 1 |  | 8 | use MIME::Base64; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 507 |  | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | require XSLoader; | 
| 19 |  |  |  |  |  |  | XSLoader::load('Authen::Passphrase::Scrypt', $VERSION); | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | __PACKAGE__->mk_accessors(qw/data logN r p salt hmac passphrase/); | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | sub compute_hash { | 
| 24 | 6 |  |  | 6 | 0 | 51 | my ($self, $passphrase) = @_; | 
| 25 | 6 |  |  |  |  | 28 | crypto_scrypt ($passphrase, $self->salt, (1 << $self->logN), $self->r, $self->p, 64); | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | sub truncated_sha256 { | 
| 29 | 3 |  |  | 3 | 0 | 34 | my $sha = sha256 shift; | 
| 30 | 3 |  |  |  |  | 13 | substr $sha, 0, 16 | 
| 31 |  |  |  |  |  |  | } | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | sub truncate_hash { | 
| 34 | 6 |  |  | 6 | 0 | 2419989 | substr shift, 32 | 
| 35 |  |  |  |  |  |  | } | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | sub new { | 
| 38 | 2 |  |  | 2 | 1 | 718931 | my ($class, @args) = @_; | 
| 39 | 2 |  |  |  |  | 25 | my $self = $class->SUPER::new(@args); | 
| 40 |  |  |  |  |  |  |  | 
| 41 | 2 | 100 |  |  |  | 31 | $self->logN(14) unless defined $self->logN; | 
| 42 | 2 | 100 |  |  |  | 29 | $self->r(16) unless defined $self->r; | 
| 43 | 2 | 50 |  |  |  | 22 | $self->p(1) unless defined $self->p; | 
| 44 | 2 | 50 |  |  |  | 25 | croak "passphrase not set" unless defined $self->passphrase; | 
| 45 | 2 | 100 |  |  |  | 15 | $self->salt(rand_bits 256) unless $self->salt; | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 2 |  |  |  |  | 5164 | my $data = "scrypt\x00" . pack 'CNNa32', | 
| 48 |  |  |  |  |  |  | $self->logN, $self->r, $self->p, $self->salt; | 
| 49 | 2 |  |  |  |  | 36 | $data .= truncated_sha256 $data; | 
| 50 | 2 |  |  |  |  | 9 | $self->data($data); | 
| 51 | 2 |  |  |  |  | 15 | $self->hmac(hmac_sha256 $self->data, truncate_hash $self->compute_hash($self->passphrase)); | 
| 52 | 2 |  |  |  |  | 37 | $self | 
| 53 |  |  |  |  |  |  | } | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | sub from_rfc2307 { | 
| 56 | 1 |  |  | 1 | 1 | 676 | my ($class, $rfc2307) = @_; | 
| 57 | 1 | 50 |  |  |  | 9 | croak "Invalid Scrypt RFC2307" unless $rfc2307 =~ m,^{SCRYPT}([A-Za-z0-9+/]{128})$,; | 
| 58 | 1 |  |  |  |  | 13 | my $data = decode_base64 $1; | 
| 59 | 1 |  |  |  |  | 14 | my ($scrypt, $logN, $r, $p, $salt, $cksum, $hmac) = | 
| 60 |  |  |  |  |  |  | unpack 'Z7CNNa32a16a32', $data; | 
| 61 | 1 | 50 |  |  |  | 4 | croak 'Invalid Scrypt hash: should start with "scrypt"' unless $scrypt eq 'scrypt'; | 
| 62 | 1 | 50 |  |  |  | 8 | croak 'Invalid Scrypt hash: bad checksum', unless $cksum eq truncated_sha256 (substr $data, 0, 48); | 
| 63 | 1 |  |  |  |  | 12 | $class->SUPER::new({data => (substr $data, 0, 64), logN => $logN, r => $r, p => $p, salt => $salt, hmac => $hmac}); | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub match { | 
| 67 | 4 |  |  | 4 | 1 | 1360 | my ($self, $passphrase) = @_; | 
| 68 | 4 |  |  |  |  | 23 | my $correct_hmac = hmac_sha256 $self->data, truncate_hash $self->compute_hash($passphrase); | 
| 69 | 4 |  |  |  |  | 34 | $self->hmac eq $correct_hmac | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | sub as_rfc2307 { | 
| 73 | 1 |  |  | 1 | 1 | 10 | my ($self) = @_; | 
| 74 | 1 |  |  |  |  | 5 | '{SCRYPT}' . encode_base64 ($self->data . $self->hmac, '') | 
| 75 |  |  |  |  |  |  | } | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | sub from_crypt { | 
| 78 | 0 |  |  | 0 | 1 |  | croak __PACKAGE__ ." does not support crypt strings, use from_rfc2307 instead"; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | sub as_crypt { | 
| 82 | 0 |  |  | 0 | 1 |  | croak __PACKAGE__ ." does not support crypt strings, use as_rfc2307 instead"; | 
| 83 |  |  |  |  |  |  | } | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | 1; | 
| 86 |  |  |  |  |  |  | __END__ |