=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.48 retrieving revision 1.65 diff -u -r1.48 -r1.65 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/09/12 03:44:36 1.48 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2011/09/19 04:23:37 1.65 @@ -1,5 +1,5 @@ package Palm::Keyring; -# $RedRiver: Keyring.pm,v 1.47 2007/09/12 00:30:10 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. # @@ -15,6 +15,8 @@ use strict; use warnings; +require 5.006_001; + use Carp; use base qw/ Palm::StdAppInfo /; @@ -57,6 +59,13 @@ blocksize => 16, default_iter => 250, }, + { # Only for testing + alias => 'TESTING', + name => 'Testing', + keylen => 0, + blocksize => 0, + default_iter => 0, + }, ); my %LABELS = ( @@ -83,7 +92,7 @@ ); -our $VERSION = '0.96_01'; +our $VERSION = '0.96_07'; sub new { @@ -108,6 +117,7 @@ else { $options->{password} = shift; $options->{version} = shift; + $options->{cipher} = shift; } } @@ -139,6 +149,10 @@ $self->{appinfo}->{iter} ||= $self->{options}->{iterations}; }; + if ( defined $options->{file} ) { + $self->Load($options->{file}); + } + if ( defined $options->{password} ) { $self->Password($options->{password}); } @@ -217,13 +231,13 @@ } } - my $rc = $self->SUPER::Write(@_); + my @rc = $self->SUPER::Write(@_); if ($self->{version} == 4) { shift @{ $self->{records} }; } - return $rc; + return @rc; } # ParseRecord @@ -233,7 +247,7 @@ my $self = shift; my $rec = $self->SUPER::ParseRecord(@_); - return $rec if ! exists $rec->{data}; + return $rec if !(defined $rec->{data} && length $rec->{data} ); if ($self->{version} == 4) { # skip the first record because it contains the password. @@ -241,7 +255,7 @@ $self->{encpassword} = $rec->{data}; return '__DELETE_ME__'; } - + if ($self->{records}->[0] eq '__DELETE_ME__') { shift @{ $self->{records} }; } @@ -270,8 +284,9 @@ $rec->{encrypted} = substr $extra, $blocksize; } else { + # XXX Can never get here to test, ParseAppInfoBlock is always run + # XXX first by Load(). croak "Unsupported Version $self->{version}"; - return; } return $rec; @@ -288,11 +303,13 @@ if ($rec->{encrypted}) { my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; $rec->{data} = join $NULL, $name, $rec->{encrypted}; - delete $rec->{plaintext}; - delete $rec->{encrypted}; } - } elsif ($self->{version} == 5) { + } + elsif ($self->{version} == 5) { + croak 'No encrypted data in record' if !defined $rec->{encrypted}; + croak 'No ivec!' if !$rec->{ivec}; + my $field; if ($rec->{plaintext}->{0}) { $field = $rec->{plaintext}->{0}; @@ -308,10 +325,16 @@ $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted}; - } else { + } + else { croak "Unsupported Version $self->{version}"; } + # XXX Should I? + #delete $rec->{plaintext}; + #delete $rec->{encrypted}; + croak 'No data in record to pack' if !$rec->{data}; + return $self->SUPER::PackRecord($rec, @_); } @@ -338,7 +361,7 @@ # Nothing extra for version 4 } elsif ($self->{version} == 5) { - _parse_appinfo_v5($appinfo) || return; + _parse_appinfo_v5($appinfo); } else { croak "Unsupported Version $self->{version}"; @@ -351,10 +374,7 @@ { my $appinfo = shift; - if (! exists $appinfo->{other}) { - # XXX Corrupt appinfo? - return; - } + croak 'Corrupt appinfo? no {other}' if ! $appinfo->{other}; my $unpackstr = ("C1" x 8) # 8 uint8s in an array for the salt @@ -421,27 +441,15 @@ sub Encrypt { my $self = shift; - my $rec = shift; + my $rec = shift || croak('Needed parameter [record] not passed!'); my $pass = shift || $self->{password}; my $data = shift || $rec->{plaintext}; my $ivec = shift; - if ( ! $pass && ! $self->{appinfo}->{key}) { - croak("password not set!\n"); - } + $self->_password_verify($pass); - if ( ! $rec) { - croak("Needed parameter 'record' not passed!\n"); - } + if ( !$data ) { croak('Needed parameter [plaintext] not passed!'); } - if ( ! $data) { - croak("Needed 'plaintext' not passed!\n"); - } - - if ( $pass && ! $self->Password($pass)) { - croak("Incorrect Password!\n"); - } - my $acct; if ($rec->{encrypted}) { $acct = $self->Decrypt($rec, $pass); @@ -457,13 +465,16 @@ lastchange => $data->{3}->{data}, notes => $data->{255}->{data}, }; - my $acctv4 = { - name => $acct->{0}->{data}, - account => $acct->{1}->{data}, - password => $acct->{2}->{data}, - lastchange => $acct->{3}->{data}, - notes => $acct->{255}->{data}, - }; + my $acctv4 = {}; + if ($acct) { + $acctv4 = { + name => $acct->{0}->{data}, + account => $acct->{1}->{data}, + password => $acct->{2}->{data}, + lastchange => $acct->{3}->{data}, + notes => $acct->{255}->{data}, + }; + } $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest}); } elsif ($self->{version} == 5) { @@ -473,29 +484,21 @@ $self->{appinfo}->{cipher}, $ivec, ); - if (defined $ivec) { - $rec->{ivec} = $ivec; - } + $rec->{ivec} = $ivec if $ivec; } else { croak "Unsupported Version $self->{version}"; } - $rec->{plaintext}->{0} = $data->{0}; + $rec->{plaintext} = $data; - if ($encrypted) { - if ($encrypted eq '1') { - return 1; - } - + if ($encrypted ne '1') { $rec->{attributes}{Dirty} = 1; $rec->{attributes}{dirty} = 1; $rec->{encrypted} = $encrypted; - - return 1; - } else { - return; } + + return 1; } sub _encrypt_v4 @@ -578,7 +581,14 @@ my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); 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; @@ -586,29 +596,59 @@ if ($new->{3}->{data}) { $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 { - my $n = join ':', sort %{ $new->{$k} }; - my $o = join ':', sort %{ $old->{$k} }; - if ($n ne $o) { + if ($old) { + foreach my $k (keys %{ $new }) { + if (! $old->{$k} ) { $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) { my ($day, $month, $year) = (localtime)[3,4,5]; @@ -631,9 +671,12 @@ my $plaintext; foreach my $k (keys %{ $new }) { + next if $new->{$k}->{label_id} == 0; $plaintext .= _pack_field($new->{$k}); } + $plaintext .= chr(0xff) x 2; + #print "CRYPT(e): $c->{name} [$cipher]\n"; my $encrypted; if ($c->{name} eq 'None') { # do nothing @@ -650,12 +693,8 @@ -blocksize => $c->{blocksize}, -header => 'none', -padding => 'oneandzeroes', - ); + ) || croak("Unable to set up encryption!"); - if (! $c) { - croak("Unable to set up encryption!"); - } - $encrypted = $cbc->encrypt($plaintext); } else { @@ -673,22 +712,11 @@ my $rec = shift; my $pass = shift || $self->{password}; - if ( ! $pass && ! $self->{appinfo}->{key}) { - croak("password not set!\n"); - } + if ( ! $rec) { croak('Needed parameter [record] not passed!'); } + if ( ! $rec->{encrypted} ) { croak('No encrypted content!'); } - if ( ! $rec) { - croak("Needed parameter 'record' not passed!\n"); - } + $self->_password_verify($pass); - if ( $pass && ! $self->Password($pass)) { - croak("Invalid Password!\n"); - } - - if ( ! $rec->{encrypted} ) { - croak("No encrypted content!"); - } - my $plaintext; if ($self->{version} == 4) { $self->{digest} ||= _calc_keys( $pass ); @@ -732,11 +760,8 @@ croak "Unsupported Version $self->{version}"; } - if ($plaintext) { - $rec->{plaintext} = $plaintext; - return $plaintext; - } - return; + $rec->{plaintext} = $plaintext; + return $plaintext; } sub _decrypt_v4 @@ -750,6 +775,7 @@ my $modified; if ($packed_date) { + #print _hexdump('DATE:', $packed_date); $modified = _parse_keyring_date($packed_date); } @@ -773,11 +799,13 @@ my $plaintext; + #print "CRYPT(d): $c->{name} [$cipher]\n"; if ($c->{name} eq 'None') { # do nothing $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; my $cbc = Crypt::CBC->new( -key => $key, @@ -788,26 +816,23 @@ -blocksize => $c->{blocksize}, -header => 'none', -padding => 'oneandzeroes', - ); + ) || croak("Unable to set up decryption!"); - if (! $c) { - croak("Unable to set up encryption!"); - } my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize}; $encrypted .= $NULL x $len; + $plaintext = $cbc->decrypt($encrypted); - } else { - croak "Unsupported Crypt $c->{name}"; } + else { + croak "Unsupported Crypt $c->{name} in decrypt"; + } my %fields; while ($plaintext) { my $field; ($field, $plaintext) = _parse_field($plaintext); - if (! $field) { - last; - } + last if ! $field; $fields{ $field->{label_id} } = $field; } @@ -838,16 +863,12 @@ if ($new_pass) { my @accts = (); foreach my $rec (@{ $self->{records} }) { - my $acct = $self->Decrypt($rec, $pass); - if ( ! $acct ) { - croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); - } + my $acct = $self->Decrypt($rec, $pass) + || croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); push @accts, $acct; } - if ( ! $self->_password_update($new_pass)) { - croak("Couldn't set new password!"); - } + $self->_password_update($new_pass); $pass = $new_pass; foreach my $i (0..$#accts) { @@ -857,30 +878,42 @@ } } + 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}) { # already verified this password return 1; } 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, # since we know the password is right - if ($valid) { - $self->{digest} = _calc_keys($pass); - if ($self->{digest} ) { - $self->{password} = $pass; - return 1; - } - } - } elsif ($self->{version} == 5) { - return _password_verify_v5($self->{appinfo}, $pass); - } else { - croak "Unsupported version $self->{version}"; + $self->{digest} = _calc_keys($pass); + $self->{password} = $pass; + + return 1; + } + elsif ($self->{version} == 5) { + _password_verify_v5($self->{appinfo}, $pass); + $self->{password} = $pass; + return 1; } - return; + croak "Unsupported Version $self->{version}"; } sub _password_verify_v4 @@ -891,11 +924,9 @@ my $pass = 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; my $salt = substr $data, 0, $kSalt_Size; @@ -903,10 +934,10 @@ my $msg = $salt . $pass; $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); - my $digest = md5($msg); + my $digest = md5($msg) || croak('MD5 Failed'); if ($data ne $salt . $digest ) { - return; + croak("Incorrect Password!"); } return 1; @@ -933,13 +964,11 @@ #print "Hash: '". $hash . "'\n"; #print "Hash: '". $appinfo->{masterhash} . "'\n"; - if ($appinfo->{masterhash} eq $hash) { - $appinfo->{key} = $key; - } else { - return; + if ($appinfo->{masterhash} && $appinfo->{masterhash} ne $hash) { + croak('Incorrect Password'); } - - return $key; + $appinfo->{key} = $key; + return 1; } @@ -955,10 +984,7 @@ if ($self->{version} == 4) { my $data = _password_update_v4($pass, @_); - if (! $data) { - carp("Failed to update password!"); - return; - } + if (! $data) { croak "Failed to update password!"; } # AFAIK the thing we use to test the password is # always in the first entry @@ -967,8 +993,8 @@ $self->{digest} = _calc_keys( $self->{password} ); return 1; - - } elsif ($self->{version} == 5) { + } + elsif ($self->{version} == 5) { my $cipher = shift || $self->{appinfo}->{cipher}; my $iter = shift || $self->{appinfo}->{iter}; my $salt = shift || 0; @@ -977,17 +1003,14 @@ $self->{appinfo}, $pass, $cipher, $iter, $salt ); - if (! $hash) { - carp("Failed to update password!"); - return; - } + if (! $hash) { croak "Failed to update password!"; } + $self->{password} = $pass; + return 1; - } else { - croak("Unsupported version ($self->{version})"); } - return; + croak "Unsupported Version $self->{version}"; } sub _password_update_v4 @@ -997,7 +1020,7 @@ my $pass = shift; - if (! defined $pass) { croak('No password specified!'); }; + croak('No password specified!') if ! defined $pass; my $salt; for ( 1 .. $kSalt_Size ) { @@ -1008,7 +1031,7 @@ $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); - my $digest = md5($msg); + my $digest = md5($msg) || croak('MD5 failed'); my $data = $salt . $digest; # . "\0"; @@ -1022,7 +1045,7 @@ my $cipher = 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 = 8; my $salt = shift || pack("C*",map {rand(256)} 1..$length); @@ -1049,9 +1072,7 @@ my ($pass) = @_; $pass ||= $self->{password}; - if ( $pass && ! $self->Password($pass)) { - croak("Invalid Password!\n"); - } + $self->_password_verify($pass); foreach my $rec (@{ $self->{records} }) { $self->Decrypt($rec); @@ -1080,6 +1101,9 @@ sub _calc_keys { + require Digest::MD5; + import Digest::MD5 qw(md5); + my $pass = shift; if (! defined $pass) { croak('No password defined!'); }; @@ -1112,7 +1136,7 @@ import Digest::SHA1 qw(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)); @@ -1176,7 +1200,7 @@ my ($len) = unpack "n", $field; if ($len + 4 > length $field) { - return undef, $field; + return (undef, $field); } my $unpackstr = "x2 C1 C1 A$len"; my $offset = 2 +1 +1 +$len; @@ -1285,6 +1309,8 @@ my $maxlines = shift; # Max # of lines to dump my $offset; # Offset of current chunk + my @lines; + for ($offset = 0; $offset < length($data); $offset += 16) { my $hex; # Hex values of the data @@ -1299,8 +1325,9 @@ ($ascii = $chunk) =~ y/\040-\176/./c; - printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii; + push @lines, sprintf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii; } + return wantarray ? @lines : \@lines; } sub _bindump @@ -1310,6 +1337,8 @@ my $maxlines = shift; # Max # of lines to dump my $offset; # Offset of current chunk + my @lines; + for ($offset = 0; $offset < length($data); $offset += 8) { my $bin; # binary values of the data @@ -1324,8 +1353,9 @@ ($ascii = $chunk) =~ y/\040-\176/./c; - printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii; + push @lines, sprintf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii; } + return wantarray ? @lines : \@lines; } # Thanks to Jochen Hoenicke @@ -1337,7 +1367,7 @@ # keylen is length of generated key in bytes # prf is the pseudo random function (e.g. hmac_sha1) # returns the key. -sub _pbkdf2($$$$$) +sub _pbkdf2 { my ($password, $salt, $iter, $keylen, $prf) = @_; my ($k, $t, $u, $ui, $i); @@ -1353,7 +1383,7 @@ return substr($t, 0, $keylen); } -sub _DES_odd_parity($) { +sub _DES_odd_parity { my $key = $_[0]; my ($r, $i); my @odd_parity = ( @@ -1391,17 +1421,12 @@ parses Keyring for Palm OS databases. See L. -It has the standard Palm::PDB methods with 2 additional public methods. -Decrypt and Encrypt. +It has the standard Palm::PDB methods with 4 additional public methods. +Unlock, Lock, Decrypt and Encrypt. It currently supports the v4 Keyring databases as well as -the pre-release v5 databases. I am not completely happy with the interface -for accessing v5 databases, so any suggestions on improvements on -the interface are appreciated. +the pre-release v5 databases. -This module doesn't store the plaintext content. It only keeps it until it -returns it to you or encrypts it. - =head1 SYNOPSIS use Palm::PDB; @@ -1412,16 +1437,18 @@ my $pdb = new Palm::PDB; $pdb->Load($file); + $pdb->Unlock($pass); foreach my $rec (@{ $pdb->{records} }) { - my $plaintext = $pdb->Decrypt($rec, $pass); - print $plaintext->{0}->{data}, ' - ', $plaintext->{1}->{data}, "\n"; + print $rec->{plaintext}->{0}->{data}, ' - ', + $rec->{plaintext}->{1}->{data}, "\n"; } + $pdb->Lock(); =head1 SUBROUTINES/METHODS =head2 new - $pdb = new Palm::Keyring([$password[, $version]]); + $pdb = new Palm::Keyring([$password[, $version[, $cipher]]]); Create a new PDB, initialized with the various Palm::Keyring fields and an empty record list. @@ -1429,7 +1456,7 @@ Use this method if you're creating a Keyring PDB from scratch otherwise you can just use Palm::PDB::new() before calling Load(). -If you pass in a password, it will initalize the first record with the encrypted +If you pass in a password, it will initalize the database with the encrypted password. new() now also takes options in other formats @@ -1453,7 +1480,7 @@ =item cipher -The cipher to use. Either the number or the name. +The cipher to use. Either the number or the name. Only used by v5 datbases. 0 => None 1 => DES_EDE3 @@ -1462,11 +1489,11 @@ =item iterations -The number of iterations to encrypt with. +The number of iterations to encrypt with. Only used by somy crypts in v5 databases. -=item options +=item file -A hashref of the options that are set +The name of a file to Load(). This will override many of the other options. =back @@ -1507,7 +1534,9 @@ =head2 labels -Pass in the id or the name of the label; +Pass in the id or the name of the label. The label id is used as a key +to the different parts of the records. +See Encrypt() for details on where the label is used. This is a function, not a method. @@ -1531,6 +1560,11 @@ =head2 Encrypt +=head3 B The order of the arguments to Encrypt has +changed. $password and $plaintext used to be swapped. They changed +because you can now set $rec->{plaintext} and not pass in $plaintext so +$password is more important. + $pdb->Encrypt($rec[, $password[, $plaintext[, $ivec]]]); Encrypts an account into a record, either with the password previously @@ -1565,7 +1599,11 @@ label => 'lastchange', label_id => 3, font => 0, - data => $lastchange, + data => { + year => $year, # usually the year - 1900 + mon => $mon, # range 0-11 + day => $day, # range 1-31 + }, }, 255 => { label => 'notes', @@ -1575,8 +1613,8 @@ }, }; -The account name is also stored in $rec->{plaintext}->{0}->{data} for both v4 -and v5 databases. +The account name is stored in $rec->{plaintext}->{0}->{data} for both v4 +and v5 databases even when the record has not been Decrypt()ed. $rec->{plaintext}->{0} => { label => 'name', @@ -1600,9 +1638,9 @@ my $plaintext = $pdb->Decrypt($rec[, $password]); Decrypts the record and returns a reference for the plaintext account as -described under L. +described under Encrypt(). Also sets $rec->{plaintext} with the same information as $plaintext as -described in L. +described in Encrypt(). foreach my $rec (@{ $pdb->{records} }) { my $plaintext = $pdb->Decrypt($rec); @@ -1668,7 +1706,7 @@ Unsets $rec->{plaintext} for all records and unsets the saved password. -This does NOT L any of the records before clearing them, so if +This does NOT Encrypt() any of the records before clearing them, so if you are not careful you will lose information. B This only does "delete $rec->{plaintext}" and the same for the @@ -1774,15 +1812,17 @@ I am not sure I am 'require module' the best way, but I don't want to depend on modules that you don't need to use. -I am not very happy with the data structures used by Encrypt() and -Decrypt() for v5 databases, but I am not sure of a better way. - The date validation for packing new dates is very poor. I have not gone through and standardized on how the module fails. Some things fail with croak, some return undef, some may even fail silently. -Nothing initializes a lasterr method or anything like that. I need -to fix all that before it is a 1.0 candidate. +Nothing initializes a lasterr method or anything like that. + +This module does not do anything special with the plaintext data. It SHOULD +treat it somehow special so that it can't be found in RAM or in a swap file +anywhere. I don't have a clue how to do this. + +I need to fix all this before it is a 1.0 candidate. Please report any bugs or feature requests to C, or through the web interface at