=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.47 retrieving revision 1.62 diff -u -r1.47 -r1.62 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/09/12 01:30:10 1.47 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2008/09/19 07:01:00 1.62 @@ -1,5 +1,5 @@ package Palm::Keyring; -# $RedRiver: Keyring.pm,v 1.46 2007/08/10 04:13:31 andrew Exp $ +# $RedRiver: Keyring.pm,v 1.61 2008/09/19 05:55:35 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 /; @@ -83,7 +85,7 @@ ); -our $VERSION = '0.96_01'; +our $VERSION = '0.96_07'; sub new { @@ -108,6 +110,7 @@ else { $options->{password} = shift; $options->{version} = shift; + $options->{cipher} = shift; } } @@ -139,6 +142,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 +224,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 +240,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 +248,7 @@ $self->{encpassword} = $rec->{data}; return '__DELETE_ME__'; } - + if ($self->{records}->[0] eq '__DELETE_ME__') { shift @{ $self->{records} }; } @@ -249,7 +256,7 @@ my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2; return $rec if ! $encrypted; - $rec->{decrypted}->{0} = { + $rec->{plaintext}->{0} = { label => 'name', label_id => 0, data => $name, @@ -265,13 +272,14 @@ my ($field, $extra) = _parse_field($rec->{data}); delete $rec->{data}; - $rec->{decrypted}->{0} = $field; + $rec->{plaintext}->{0} = $field; $rec->{ivec} = substr $extra, 0, $blocksize; $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; @@ -286,16 +294,17 @@ if ($self->{version} == 4) { if ($rec->{encrypted}) { - my $name = $rec->{decrypted}->{0}->{data} || $EMPTY; + my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; $rec->{data} = join $NULL, $name, $rec->{encrypted}; - delete $rec->{decrypted}; - delete $rec->{encrypted}; } } elsif ($self->{version} == 5) { + croak 'No encrypted data in record' if !defined $rec->{encrypted}; + croak 'No ivec!' if !$rec->{ivec}; + my $field; - if ($rec->{decrypted}->{0}) { - $field = $rec->{decrypted}->{0}; + if ($rec->{plaintext}->{0}) { + $field = $rec->{plaintext}->{0}; } else { $field = { 'label' => 'name', @@ -311,7 +320,12 @@ } 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 +352,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 +365,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 @@ -422,24 +433,26 @@ { my $self = shift; my $rec = shift; - my $data = shift; my $pass = shift || $self->{password}; + + if ( !$rec ) { + croak('Needed parameter [record] not passed!'); + } + + my $data = shift || $rec->{plaintext}; my $ivec = shift; + if ( ! $pass && ! $self->{appinfo}->{key}) { - croak("password not set!\n"); + croak('password not set!'); } - if ( ! $rec) { - croak("Needed parameter 'record' not passed!\n"); - } - if ( ! $data) { - croak("Needed parameter 'data' not passed!\n"); + croak('Needed parameter [plaintext] not passed!'); } if ( $pass && ! $self->Password($pass)) { - croak("Incorrect Password!\n"); + croak('Incorrect Password!'); } my $acct; @@ -467,35 +480,26 @@ $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest}); } elsif ($self->{version} == 5) { - ($encrypted, $ivec) = _encrypt_v5( + ($encrypted, $rec->{ivec}) = _encrypt_v5( $data, $acct, $self->{appinfo}->{key}, $self->{appinfo}->{cipher}, $ivec, ); - if (defined $ivec) { - $rec->{ivec} = $ivec; - } } else { - croak "Unsupported Version $self->{version}"; + croak "Unsupported version $self->{version}"; } - $rec->{decrypted}->{0} = $data->{0}; + $rec->{plaintext}->{0} = $data->{0}; - 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 +582,9 @@ my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); if (! defined $ivec) { - $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize}); + while (! $ivec) { + $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize}); + } } my $changed = 0; @@ -608,7 +614,7 @@ } } - return 1, 0 if $changed == 0; + return (1, $ivec) if $changed == 0; if ($need_newdate) { my ($day, $month, $year) = (localtime)[3,4,5]; @@ -629,15 +635,17 @@ } } - my $decrypted; + my $plaintext; foreach my $k (keys %{ $new }) { - $decrypted .= _pack_field($new->{$k}); + next if $new->{$k}->{label_id} == 0; + $plaintext .= _pack_field($new->{$k}); } + $plaintext .= chr(0xff) x 2; my $encrypted; if ($c->{name} eq 'None') { # do nothing - $encrypted = $decrypted; + $encrypted = $plaintext; } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') { require Crypt::CBC; @@ -656,7 +664,7 @@ croak("Unable to set up encryption!"); } - $encrypted = $cbc->encrypt($decrypted); + $encrypted = $cbc->encrypt($plaintext); } else { croak "Unsupported Crypt $c->{name}"; @@ -689,11 +697,12 @@ croak("No encrypted content!"); } + my $plaintext; if ($self->{version} == 4) { $self->{digest} ||= _calc_keys( $pass ); my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest}); - return { - 0 => $rec->{decrypted}->{0}, + $plaintext = { + 0 => $rec->{plaintext}->{0}, 1 => { label => 'account', label_id => 1, @@ -721,16 +730,20 @@ }; } elsif ($self->{version} == 5) { - my $decrypted = _decrypt_v5( + $plaintext = _decrypt_v5( $rec->{encrypted}, $self->{appinfo}->{key}, $self->{appinfo}->{cipher}, $rec->{ivec}, ); - $decrypted->{0} ||= $rec->{decrypted}->{0}; - return $decrypted; + $plaintext->{0} ||= $rec->{plaintext}->{0}; } else { croak "Unsupported Version $self->{version}"; } + + if ($plaintext) { + $rec->{plaintext} = $plaintext; + return $plaintext; + } return; } @@ -739,9 +752,9 @@ my $encrypted = shift; my $digest = shift; - my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT ); + my $plaintext = _crypt3des( $encrypted, $digest, $DECRYPT ); my ( $account, $password, $notes, $packed_date ) - = split /$NULL/xm, $decrypted, 4; + = split /$NULL/xm, $plaintext, 4; my $modified; if ($packed_date) { @@ -766,11 +779,11 @@ my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); - my $decrypted; + my $plaintext; if ($c->{name} eq 'None') { # do nothing - $decrypted = $encrypted; + $plaintext = $encrypted; } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') { require Crypt::CBC; @@ -790,16 +803,16 @@ } my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize}; $encrypted .= $NULL x $len; - $decrypted = $cbc->decrypt($encrypted); + $plaintext = $cbc->decrypt($encrypted); } else { croak "Unsupported Crypt $c->{name}"; } my %fields; - while ($decrypted) { + while ($plaintext) { my $field; - ($field, $decrypted) = _parse_field($decrypted); + ($field, $plaintext) = _parse_field($plaintext); if (! $field) { last; } @@ -835,7 +848,7 @@ foreach my $rec (@{ $self->{records} }) { my $acct = $self->Decrypt($rec, $pass); if ( ! $acct ) { - croak("Couldn't decrypt $rec->{decrypted}->{0}->{data}"); + croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); } push @accts, $acct; } @@ -847,7 +860,8 @@ foreach my $i (0..$#accts) { delete $self->{records}->[$i]->{encrypted}; - $self->Encrypt($self->{records}->[$i], $accts[$i], $pass); + $self->{records}->[$i]->{plaintext} = $accts[$i]; + $self->Encrypt($self->{records}->[$i], $pass); } } @@ -1037,6 +1051,39 @@ return $key; } +sub Unlock +{ + my $self = shift; + my ($pass) = @_; + $pass ||= $self->{password}; + + if ( $pass && ! $self->Password($pass)) { + croak("Invalid Password!\n"); + } + + foreach my $rec (@{ $self->{records} }) { + $self->Decrypt($rec); + } + + return 1; + +} + +sub Lock +{ + my $self = shift; + + $self->Password(); + + foreach my $rec (@{ $self->{records} }) { + my $name = $rec->{plaintext}->{0}; + delete $rec->{plaintext}; + $rec->{plaintext}->{0} = $name; + } + + return 1; +} + # Helpers sub _calc_keys @@ -1137,7 +1184,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; @@ -1246,6 +1293,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 @@ -1260,8 +1309,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 @@ -1271,6 +1321,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 @@ -1285,8 +1337,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 @@ -1298,7 +1351,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); @@ -1314,7 +1367,7 @@ return substr($t, 0, $keylen); } -sub _DES_odd_parity($) { +sub _DES_odd_parity { my $key = $_[0]; my ($r, $i); my @odd_parity = ( @@ -1352,17 +1405,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 decrypted content. It only keeps it until it -returns it to you or encrypts it. - =head1 SYNOPSIS use Palm::PDB; @@ -1373,16 +1421,18 @@ my $pdb = new Palm::PDB; $pdb->Load($file); + $pdb->Unlock($pass); foreach my $rec (@{ $pdb->{records} }) { - my $acct = $pdb->Decrypt($rec, $pass); - print $acct->{0}->{data}, ' - ', $acct->{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. @@ -1390,7 +1440,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 @@ -1414,7 +1464,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 @@ -1423,11 +1473,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 @@ -1468,7 +1518,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. @@ -1492,8 +1544,13 @@ =head2 Encrypt - $pdb->Encrypt($rec, $acct[, $password[, $ivec]]); +=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 used, or with a password that is passed. @@ -1502,9 +1559,9 @@ randomly. $rec is a record from $pdb->{records} or a new_Record(). -The $acct is a hashref in the format below. +$rec->{plaintext} is a hashref in the format below. - my $acct = { + $plaintext = { 0 => { label => 'name', label_id => 0, @@ -1526,7 +1583,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', @@ -1536,10 +1597,10 @@ }, }; -The account name is also stored in $rec->{decrypted}->{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->{decrypted}->{0} => { + $rec->{plaintext}->{0} => { label => 'name', label_id => 0, font => 0, @@ -1552,17 +1613,22 @@ If you pass in a lastchange field that is different than the one in the record, it will honor what you passed in. +You can either set $rec->{plaintext} or pass in $plaintext. $plaintext +is used over anything in $rec->{plaintext}. + =head2 Decrypt - my $acct = $pdb->Decrypt($rec[, $password]); + my $plaintext = $pdb->Decrypt($rec[, $password]); -Decrypts the record and returns a reference for the account as described -under Encrypt(). +Decrypts the record and returns a reference for the plaintext account as +described under Encrypt(). +Also sets $rec->{plaintext} with the same information as $plaintext as +described in Encrypt(). foreach my $rec (@{ $pdb->{records} }) { - my $acct = $pdb->Decrypt($rec); - # do something with $acct + my $plaintext = $pdb->Decrypt($rec); + # do something with $plaintext } @@ -1602,6 +1668,38 @@ or calculated when setting a new password. }; +=head2 Unlock + + $pdb->Unlock([$password]); + +Decrypts all the records. Sets $rec->{plaintext} for all records. + +This makes it easy to show all decrypted information. + + my $pdb = Palm::KeyRing->new(); + $pdb->Load($keyring_file); + $pdb->Unlock($password); + foreach my $plaintext (map { $_->{plaintext} } @{ $pdb->{records} }) { + # Do something like display the account. + } + $pdb->Lock(); + +=head2 Lock + + $pdb->Lock(); + +Unsets $rec->{plaintext} for all records and unsets the saved password. + +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 +password. If someone knows of a cross platform reliable way to make +sure that the information is actually cleared from memory I would +appreciate it. Also, if someone knows how to make sure that the stuff +in $rec->{plaintext} is not written to swap, that would be very handy as +well. + =head2 Other overridden subroutines/methods =over @@ -1698,18 +1796,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 v4 compatibility mode does not insert a fake record 0 where -normally the encrypted password is stored. - 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