version 1.57, 2008/09/19 03:04:34 |
version 1.65, 2011/09/19 04:23:37 |
|
|
package Palm::Keyring; |
package Palm::Keyring; |
# $RedRiver: Keyring.pm,v 1.56 2008/09/18 06:04:55 andrew Exp $ |
# $RedRiver: Keyring.pm,v 1.62 2008/09/19 06:01:00 andrew Exp $ |
######################################################################## |
######################################################################## |
# Keyring.pm *** Perl class for Keyring for Palm OS databases. |
# Keyring.pm *** Perl class for Keyring for Palm OS databases. |
# |
# |
|
|
blocksize => 16, |
blocksize => 16, |
default_iter => 250, |
default_iter => 250, |
}, |
}, |
|
{ # Only for testing |
|
alias => 'TESTING', |
|
name => 'Testing', |
|
keylen => 0, |
|
blocksize => 0, |
|
default_iter => 0, |
|
}, |
); |
); |
|
|
my %LABELS = ( |
my %LABELS = ( |
|
|
my $self = shift; |
my $self = shift; |
my $rec = shift; |
my $rec = shift; |
|
|
if (!defined $rec->{encrypted}) { |
|
$rec->{encrypted} = $EMPTY; |
|
} |
|
|
|
if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
if ($rec->{encrypted}) { |
if ($rec->{encrypted}) { |
my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; |
my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; |
$rec->{data} = join $NULL, $name, $rec->{encrypted}; |
$rec->{data} = join $NULL, $name, $rec->{encrypted}; |
} |
} |
|
|
} elsif ($self->{version} == 5) { |
} |
if (!$rec->{ivec}) { |
elsif ($self->{version} == 5) { |
$rec->{ivec} = $EMPTY; |
croak 'No encrypted data in record' if !defined $rec->{encrypted}; |
} |
croak 'No ivec!' if !$rec->{ivec}; |
|
|
my $field; |
my $field; |
if ($rec->{plaintext}->{0}) { |
if ($rec->{plaintext}->{0}) { |
|
|
|
|
$rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted}; |
$rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted}; |
|
|
} else { |
} |
|
else { |
croak "Unsupported Version $self->{version}"; |
croak "Unsupported Version $self->{version}"; |
} |
} |
# XXX Should I? |
# XXX Should I? |
delete $rec->{plaintext}; |
#delete $rec->{plaintext}; |
delete $rec->{encrypted}; |
#delete $rec->{encrypted}; |
|
|
|
croak 'No data in record to pack' if !$rec->{data}; |
|
|
return $self->SUPER::PackRecord($rec, @_); |
return $self->SUPER::PackRecord($rec, @_); |
} |
} |
|
|
|
|
# Nothing extra for version 4 |
# Nothing extra for version 4 |
|
|
} elsif ($self->{version} == 5) { |
} elsif ($self->{version} == 5) { |
_parse_appinfo_v5($appinfo) || return; |
_parse_appinfo_v5($appinfo); |
|
|
} else { |
} else { |
croak "Unsupported Version $self->{version}"; |
croak "Unsupported Version $self->{version}"; |
|
|
{ |
{ |
my $appinfo = shift; |
my $appinfo = shift; |
|
|
if (! exists $appinfo->{other}) { |
croak 'Corrupt appinfo? no {other}' if ! $appinfo->{other}; |
# XXX Corrupt appinfo? |
|
return; |
|
} |
|
|
|
my $unpackstr |
my $unpackstr |
= ("C1" x 8) # 8 uint8s in an array for the salt |
= ("C1" x 8) # 8 uint8s in an array for the salt |
|
|
sub Encrypt |
sub Encrypt |
{ |
{ |
my $self = shift; |
my $self = shift; |
my $rec = shift; |
my $rec = shift || croak('Needed parameter [record] not passed!'); |
my $pass = shift || $self->{password}; |
my $pass = shift || $self->{password}; |
my $data = shift || $rec->{plaintext}; |
my $data = shift || $rec->{plaintext}; |
my $ivec = shift; |
my $ivec = shift; |
|
|
if ( ! $pass && ! $self->{appinfo}->{key}) { |
$self->_password_verify($pass); |
croak("password not set!\n"); |
|
} |
|
|
|
if ( ! $rec) { |
if ( !$data ) { croak('Needed parameter [plaintext] not passed!'); } |
croak("Needed parameter 'record' not passed!\n"); |
|
} |
|
|
|
if ( ! $data) { |
|
croak("Needed 'plaintext' not passed!\n"); |
|
} |
|
|
|
if ( $pass && ! $self->Password($pass)) { |
|
croak("Incorrect Password!\n"); |
|
} |
|
|
|
my $acct; |
my $acct; |
if ($rec->{encrypted}) { |
if ($rec->{encrypted}) { |
$acct = $self->Decrypt($rec, $pass); |
$acct = $self->Decrypt($rec, $pass); |
|
|
lastchange => $data->{3}->{data}, |
lastchange => $data->{3}->{data}, |
notes => $data->{255}->{data}, |
notes => $data->{255}->{data}, |
}; |
}; |
my $acctv4 = { |
my $acctv4 = {}; |
name => $acct->{0}->{data}, |
if ($acct) { |
account => $acct->{1}->{data}, |
$acctv4 = { |
password => $acct->{2}->{data}, |
name => $acct->{0}->{data}, |
lastchange => $acct->{3}->{data}, |
account => $acct->{1}->{data}, |
notes => $acct->{255}->{data}, |
password => $acct->{2}->{data}, |
}; |
lastchange => $acct->{3}->{data}, |
|
notes => $acct->{255}->{data}, |
|
}; |
|
} |
$encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest}); |
$encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest}); |
|
|
} elsif ($self->{version} == 5) { |
} elsif ($self->{version} == 5) { |
|
|
$self->{appinfo}->{cipher}, |
$self->{appinfo}->{cipher}, |
$ivec, |
$ivec, |
); |
); |
if (defined $ivec) { |
$rec->{ivec} = $ivec if $ivec; |
$rec->{ivec} = $ivec; |
|
} |
|
|
|
} else { |
} else { |
croak "Unsupported Version $self->{version}"; |
croak "Unsupported Version $self->{version}"; |
} |
} |
|
|
$rec->{plaintext}->{0} = $data->{0}; |
$rec->{plaintext} = $data; |
|
|
if ($encrypted) { |
if ($encrypted ne '1') { |
if ($encrypted eq '1') { |
|
return 1; |
|
} |
|
|
|
$rec->{attributes}{Dirty} = 1; |
$rec->{attributes}{Dirty} = 1; |
$rec->{attributes}{dirty} = 1; |
$rec->{attributes}{dirty} = 1; |
$rec->{encrypted} = $encrypted; |
$rec->{encrypted} = $encrypted; |
|
|
return 1; |
|
} else { |
|
return; |
|
} |
} |
|
|
|
return 1; |
} |
} |
|
|
sub _encrypt_v4 |
sub _encrypt_v4 |
|
|
my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); |
my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); |
|
|
if (! defined $ivec) { |
if (! defined $ivec) { |
$ivec = pack("C*",map {rand(256)} 1..$c->{blocksize}); |
if (!$c->{blocksize}) { |
|
$ivec = $EMPTY; |
|
} |
|
else { |
|
while (! $ivec) { |
|
$ivec = pack("C*",map {rand(256)} 1..$c->{blocksize}); |
|
} |
|
} |
} |
} |
|
|
my $changed = 0; |
my $changed = 0; |
|
|
if ($new->{3}->{data}) { |
if ($new->{3}->{data}) { |
$need_newdate = 0; |
$need_newdate = 0; |
} |
} |
foreach my $k (keys %{ $new }) { |
|
if (! $old) { |
|
$changed = 1; |
|
} elsif ($k == 3) { |
|
if ($old && ( |
|
$new->{$k}{data}{day} == $old->{$k}{data}{day} && |
|
$new->{$k}{data}{month} == $old->{$k}{data}{month} && |
|
$new->{$k}{data}{year} == $old->{$k}{data}{year} |
|
)) { |
|
$changed = 1; |
|
$need_newdate = 1; |
|
} |
|
|
|
} else { |
if ($old) { |
my $n = join ':', sort %{ $new->{$k} }; |
foreach my $k (keys %{ $new }) { |
my $o = join ':', sort %{ $old->{$k} }; |
if (! $old->{$k} ) { |
if ($n ne $o) { |
|
$changed = 1; |
$changed = 1; |
|
last; |
|
} |
|
if (! $new->{$k}) { |
|
$changed = 1; |
|
last; |
} |
} |
|
elsif ($k == 3) { |
|
if (! $new->{$k}->{data} && $old->{$k}->{data} ) { |
|
$changed = 1; |
|
last; |
|
} |
|
|
|
my %n = %{ $new->{$k}->{data} }; |
|
my %o = %{ $old->{$k}->{data} }; |
|
|
|
foreach (qw( day month year )) { |
|
$n{$_} ||= 0; |
|
$o{$_} ||= 0; |
|
} |
|
|
|
if ( |
|
$n{day} == $o{day} && |
|
$n{month} == $o{month} && |
|
$n{year} == $o{year} |
|
) { |
|
$need_newdate = 1; |
|
} |
|
else { |
|
$changed = 1; |
|
last; |
|
} |
|
|
|
} |
|
else { |
|
my $n = join ':', sort %{ $new->{$k} }; |
|
my $o = join ':', sort %{ $old->{$k} }; |
|
if ($n ne $o) { |
|
$changed = 1; |
|
last; |
|
} |
|
} |
} |
} |
} |
} |
|
else { |
|
$changed = 1; |
|
} |
|
|
return 1, 0 if $changed == 0; |
return 1 if $changed == 0; |
|
|
if ($need_newdate) { |
if ($need_newdate) { |
my ($day, $month, $year) = (localtime)[3,4,5]; |
my ($day, $month, $year) = (localtime)[3,4,5]; |
|
|
} |
} |
$plaintext .= chr(0xff) x 2; |
$plaintext .= chr(0xff) x 2; |
|
|
|
#print "CRYPT(e): $c->{name} [$cipher]\n"; |
my $encrypted; |
my $encrypted; |
if ($c->{name} eq 'None') { |
if ($c->{name} eq 'None') { |
# do nothing |
# do nothing |
|
|
-blocksize => $c->{blocksize}, |
-blocksize => $c->{blocksize}, |
-header => 'none', |
-header => 'none', |
-padding => 'oneandzeroes', |
-padding => 'oneandzeroes', |
); |
) || croak("Unable to set up encryption!"); |
|
|
if (! $c) { |
|
croak("Unable to set up encryption!"); |
|
} |
|
|
|
$encrypted = $cbc->encrypt($plaintext); |
$encrypted = $cbc->encrypt($plaintext); |
|
|
} else { |
} else { |
|
|
my $rec = shift; |
my $rec = shift; |
my $pass = shift || $self->{password}; |
my $pass = shift || $self->{password}; |
|
|
if ( ! $pass && ! $self->{appinfo}->{key}) { |
if ( ! $rec) { croak('Needed parameter [record] not passed!'); } |
croak("password not set!\n"); |
if ( ! $rec->{encrypted} ) { croak('No encrypted content!'); } |
} |
|
|
|
if ( ! $rec) { |
$self->_password_verify($pass); |
croak("Needed parameter 'record' not passed!\n"); |
|
} |
|
|
|
if ( $pass && ! $self->Password($pass)) { |
|
croak("Invalid Password!\n"); |
|
} |
|
|
|
if ( ! $rec->{encrypted} ) { |
|
croak("No encrypted content!"); |
|
} |
|
|
|
my $plaintext; |
my $plaintext; |
if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
$self->{digest} ||= _calc_keys( $pass ); |
$self->{digest} ||= _calc_keys( $pass ); |
|
|
croak "Unsupported Version $self->{version}"; |
croak "Unsupported Version $self->{version}"; |
} |
} |
|
|
if ($plaintext) { |
$rec->{plaintext} = $plaintext; |
$rec->{plaintext} = $plaintext; |
return $plaintext; |
return $plaintext; |
|
} |
|
return; |
|
} |
} |
|
|
sub _decrypt_v4 |
sub _decrypt_v4 |
|
|
|
|
my $modified; |
my $modified; |
if ($packed_date) { |
if ($packed_date) { |
|
#print _hexdump('DATE:', $packed_date); |
$modified = _parse_keyring_date($packed_date); |
$modified = _parse_keyring_date($packed_date); |
} |
} |
|
|
|
|
|
|
my $plaintext; |
my $plaintext; |
|
|
|
#print "CRYPT(d): $c->{name} [$cipher]\n"; |
if ($c->{name} eq 'None') { |
if ($c->{name} eq 'None') { |
# do nothing |
# do nothing |
$plaintext = $encrypted; |
$plaintext = $encrypted; |
|
|
} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') { |
} |
|
elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') { |
require Crypt::CBC; |
require Crypt::CBC; |
my $cbc = Crypt::CBC->new( |
my $cbc = Crypt::CBC->new( |
-key => $key, |
-key => $key, |
|
|
-blocksize => $c->{blocksize}, |
-blocksize => $c->{blocksize}, |
-header => 'none', |
-header => 'none', |
-padding => 'oneandzeroes', |
-padding => 'oneandzeroes', |
); |
) || croak("Unable to set up decryption!"); |
|
|
if (! $c) { |
|
croak("Unable to set up encryption!"); |
|
} |
|
my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize}; |
my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize}; |
$encrypted .= $NULL x $len; |
$encrypted .= $NULL x $len; |
|
|
$plaintext = $cbc->decrypt($encrypted); |
$plaintext = $cbc->decrypt($encrypted); |
|
|
} else { |
|
croak "Unsupported Crypt $c->{name}"; |
|
} |
} |
|
else { |
|
croak "Unsupported Crypt $c->{name} in decrypt"; |
|
} |
|
|
my %fields; |
my %fields; |
while ($plaintext) { |
while ($plaintext) { |
my $field; |
my $field; |
($field, $plaintext) = _parse_field($plaintext); |
($field, $plaintext) = _parse_field($plaintext); |
if (! $field) { |
last if ! $field; |
last; |
|
} |
|
$fields{ $field->{label_id} } = $field; |
$fields{ $field->{label_id} } = $field; |
} |
} |
|
|
|
|
if ($new_pass) { |
if ($new_pass) { |
my @accts = (); |
my @accts = (); |
foreach my $rec (@{ $self->{records} }) { |
foreach my $rec (@{ $self->{records} }) { |
my $acct = $self->Decrypt($rec, $pass); |
my $acct = $self->Decrypt($rec, $pass) |
if ( ! $acct ) { |
|| croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); |
croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); |
|
} |
|
push @accts, $acct; |
push @accts, $acct; |
} |
} |
|
|
if ( ! $self->_password_update($new_pass)) { |
$self->_password_update($new_pass); |
croak("Couldn't set new password!"); |
|
} |
|
$pass = $new_pass; |
$pass = $new_pass; |
|
|
foreach my $i (0..$#accts) { |
foreach my $i (0..$#accts) { |
|
|
} |
} |
} |
} |
|
|
|
return $self->_password_verify($pass); |
|
} |
|
|
|
sub _password_verify { |
|
my $self = shift; |
|
my $pass = shift; |
|
if (!defined $pass) { |
|
$pass = $self->{password}; |
|
} |
|
|
|
if ( !$pass ) { |
|
croak("Password not set!\n"); |
|
} |
|
|
if (defined $self->{password} && $pass eq $self->{password}) { |
if (defined $self->{password} && $pass eq $self->{password}) { |
# already verified this password |
# already verified this password |
return 1; |
return 1; |
} |
} |
|
|
if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
my $valid = _password_verify_v4($pass, $self->{encpassword}); |
_password_verify_v4($pass, $self->{encpassword}); |
|
|
# May as well generate the keys we need now, |
# May as well generate the keys we need now, |
# since we know the password is right |
# since we know the password is right |
if ($valid) { |
$self->{digest} = _calc_keys($pass); |
$self->{digest} = _calc_keys($pass); |
$self->{password} = $pass; |
if ($self->{digest} ) { |
|
$self->{password} = $pass; |
return 1; |
return 1; |
} |
} |
elsif ($self->{version} == 5) { |
} |
_password_verify_v5($self->{appinfo}, $pass); |
} elsif ($self->{version} == 5) { |
$self->{password} = $pass; |
return _password_verify_v5($self->{appinfo}, $pass); |
return 1; |
} else { |
|
croak "Unsupported version $self->{version}"; |
|
} |
} |
|
|
return; |
croak "Unsupported Version $self->{version}"; |
} |
} |
|
|
sub _password_verify_v4 |
sub _password_verify_v4 |
|
|
my $pass = shift; |
my $pass = shift; |
my $data = shift; |
my $data = shift; |
|
|
if (! $pass) { croak('No password specified!'); }; |
if (! $pass) { croak('No password specified!'); } |
|
if (! $data) { croak('No encrypted password in file!'); } |
|
|
# XXX die "No encrypted password in file!" unless defined $data; |
|
if ( ! defined $data) { return; }; |
|
|
|
$data =~ s/$NULL$//xm; |
$data =~ s/$NULL$//xm; |
|
|
my $salt = substr $data, 0, $kSalt_Size; |
my $salt = substr $data, 0, $kSalt_Size; |
|
|
my $msg = $salt . $pass; |
my $msg = $salt . $pass; |
$msg .= "\0" x ( $MD5_CBLOCK - length $msg ); |
$msg .= "\0" x ( $MD5_CBLOCK - length $msg ); |
|
|
my $digest = md5($msg); |
my $digest = md5($msg) || croak('MD5 Failed'); |
|
|
if ($data ne $salt . $digest ) { |
if ($data ne $salt . $digest ) { |
return; |
croak("Incorrect Password!"); |
} |
} |
|
|
return 1; |
return 1; |
|
|
#print "Hash: '". $hash . "'\n"; |
#print "Hash: '". $hash . "'\n"; |
#print "Hash: '". $appinfo->{masterhash} . "'\n"; |
#print "Hash: '". $appinfo->{masterhash} . "'\n"; |
|
|
if ($appinfo->{masterhash} eq $hash) { |
if ($appinfo->{masterhash} && $appinfo->{masterhash} ne $hash) { |
$appinfo->{key} = $key; |
croak('Incorrect Password'); |
} else { |
|
return; |
|
} |
} |
|
$appinfo->{key} = $key; |
return $key; |
return 1; |
} |
} |
|
|
|
|
|
|
if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
my $data = _password_update_v4($pass, @_); |
my $data = _password_update_v4($pass, @_); |
|
|
if (! $data) { |
if (! $data) { croak "Failed to update password!"; } |
carp("Failed to update password!"); |
|
return; |
|
} |
|
|
|
# AFAIK the thing we use to test the password is |
# AFAIK the thing we use to test the password is |
# always in the first entry |
# always in the first entry |
|
|
$self->{digest} = _calc_keys( $self->{password} ); |
$self->{digest} = _calc_keys( $self->{password} ); |
|
|
return 1; |
return 1; |
|
} |
} elsif ($self->{version} == 5) { |
elsif ($self->{version} == 5) { |
my $cipher = shift || $self->{appinfo}->{cipher}; |
my $cipher = shift || $self->{appinfo}->{cipher}; |
my $iter = shift || $self->{appinfo}->{iter}; |
my $iter = shift || $self->{appinfo}->{iter}; |
my $salt = shift || 0; |
my $salt = shift || 0; |
|
|
$self->{appinfo}, $pass, $cipher, $iter, $salt |
$self->{appinfo}, $pass, $cipher, $iter, $salt |
); |
); |
|
|
if (! $hash) { |
if (! $hash) { croak "Failed to update password!"; } |
carp("Failed to update password!"); |
|
return; |
|
} |
|
|
|
|
$self->{password} = $pass; |
|
|
return 1; |
return 1; |
} else { |
|
croak("Unsupported version ($self->{version})"); |
|
} |
} |
|
|
return; |
croak "Unsupported Version $self->{version}"; |
} |
} |
|
|
sub _password_update_v4 |
sub _password_update_v4 |
|
|
|
|
my $pass = shift; |
my $pass = shift; |
|
|
if (! defined $pass) { croak('No password specified!'); }; |
croak('No password specified!') if ! defined $pass; |
|
|
my $salt; |
my $salt; |
for ( 1 .. $kSalt_Size ) { |
for ( 1 .. $kSalt_Size ) { |
|
|
|
|
$msg .= "\0" x ( $MD5_CBLOCK - length $msg ); |
$msg .= "\0" x ( $MD5_CBLOCK - length $msg ); |
|
|
my $digest = md5($msg); |
my $digest = md5($msg) || croak('MD5 failed'); |
|
|
my $data = $salt . $digest; # . "\0"; |
my $data = $salt . $digest; # . "\0"; |
|
|
|
|
my $cipher = shift; |
my $cipher = shift; |
my $iter = shift; |
my $iter = shift; |
|
|
# I thought this needed to be 'blocksize', but apparently not. |
# I thought $length needed to be 'blocksize', but apparently not. |
#my $length = $CRYPTS[ $cipher ]{blocksize}; |
#my $length = $CRYPTS[ $cipher ]{blocksize}; |
my $length = 8; |
my $length = 8; |
my $salt = shift || pack("C*",map {rand(256)} 1..$length); |
my $salt = shift || pack("C*",map {rand(256)} 1..$length); |
|
|
my ($pass) = @_; |
my ($pass) = @_; |
$pass ||= $self->{password}; |
$pass ||= $self->{password}; |
|
|
if ( $pass && ! $self->Password($pass)) { |
$self->_password_verify($pass); |
croak("Invalid Password!\n"); |
|
} |
|
|
|
foreach my $rec (@{ $self->{records} }) { |
foreach my $rec (@{ $self->{records} }) { |
$self->Decrypt($rec); |
$self->Decrypt($rec); |
|
|
|
|
sub _calc_keys |
sub _calc_keys |
{ |
{ |
|
require Digest::MD5; |
|
import Digest::MD5 qw(md5); |
|
|
my $pass = shift; |
my $pass = shift; |
if (! defined $pass) { croak('No password defined!'); }; |
if (! defined $pass) { croak('No password defined!'); }; |
|
|
|
|
import Digest::SHA1 qw(sha1); |
import Digest::SHA1 qw(sha1); |
|
|
my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 ); |
my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 ); |
if ($dop) { $key = _DES_odd_parity($key); } |
$key = _DES_odd_parity($key) if $dop; |
|
|
my $hash = unpack("H*", substr(sha1($key.$salt),0, 8)); |
my $hash = unpack("H*", substr(sha1($key.$salt),0, 8)); |
|
|