=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.14 retrieving revision 1.24 diff -u -r1.14 -r1.24 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/01/28 22:24:17 1.14 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/03 00:52:43 1.24 @@ -1,6 +1,6 @@ package Palm::Keyring; -# $RedRiver: Keyring.pm,v 1.13 2007/01/28 18:13:28 andrew Exp $ +# $RedRiver: Keyring.pm,v 1.23 2007/02/02 01:51:46 andrew Exp $ # # Perl class for dealing with Keyring for Palm OS databases. # @@ -14,21 +14,17 @@ use Digest::MD5 qw(md5); use Crypt::DES; -use Readonly; -Readonly my $ENCRYPT => 1; -Readonly my $DECRYPT => 0; -Readonly my $MD5_CBLOCK => 64; -Readonly my $kSalt_Size => 4; -Readonly my $EMPTY => q{}; -Readonly my $SPACE => q{ }; -Readonly my $NULL => chr 0; +my $ENCRYPT = 1; +my $DECRYPT = 0; +my $MD5_CBLOCK = 64; +my $kSalt_Size = 4; +my $EMPTY = q{}; +my $SPACE = q{ }; +my $NULL = chr 0; -# One liner, to allow MakeMaker to work. -our ($VERSION) = q$Revision: 1.14 $ =~ m{ Revision: \s+ (\S+) }xm; +our $VERSION = 0.93; -#@ISA = qw( Palm::StdAppInfo Palm::Raw ); - sub new { my $classname = shift; my $pass = shift; @@ -54,11 +50,8 @@ # Set the version $self->{'version'} = 4; - # Give the PDB the first record that will hold the encrypted password - $self->{'records'} = [ $self->new_Record ]; - if ( defined $pass ) { - $self->Encrypt($pass); + $self->Password($pass); } return $self; @@ -69,143 +62,234 @@ return 1; } -sub Load { +sub ParseRecord { my $self = shift; - my $filename = shift; - my $password = shift; - $self->{'appinfo'} = {}; - $self->{'records'} = []; - $self->SUPER::Load($filename); + my $rec = $self->SUPER::ParseRecord(@_); - foreach my $rec ( @{ $self->{'records'} } ) { - if ( ! exists $rec->{'data'}) { next; }; - my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; - if ( ! $encrypted ) { next }; - $rec->{'plaintext'}->{'name'} = $name; - $rec->{'encrypted'} = $encrypted; - } + # skip the 0 record that holds the password + return $rec if ! exists $self->{'records'}; + return $rec if ! exists $rec->{'data'}; - return $self->Decrypt($password) if defined $password; + my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; - return 1; + return $rec if ! $encrypted; + delete $rec->{'data'}; + $rec->{'name'} = $name; + $rec->{'encrypted'} = $encrypted; + + return $rec; } -sub Write { - my $self = shift; - my $filename = shift; - my $password = shift; +sub PackRecord { + my $self = shift; + my $rec = shift; - $self->Encrypt($password) || return; - return $self->SUPER::Write($filename); + if ($rec->{'encrypted'}) { + if (! defined $rec->{'name'}) { + $rec->{'name'} = $EMPTY; + } + $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'}; + delete $rec->{'name'}; + delete $rec->{'encrypted'}; + } + + return $self->SUPER::PackRecord($rec, @_); } sub Encrypt { my $self = shift; - my $pass = shift; + my $rec = shift; + my $data = shift; + my $pass = shift || $self->{'password'}; - if ($pass) { - if ( - !( exists $self->{'records'}->[0]->{'data'} - && $self->_keyring_verify($pass) ) - ) - { + if ( ! $pass) { + croak("'password' not set!\n"); + } - # This would encrypt with a new password. - # First decrypting everything with the old password of course. - $self->_keyring_update($pass) || return; - $self->_keyring_verify($pass) || return; - } + if ( ! $rec) { + croak("Needed parameter 'record' not passed!\n"); } - $self->{'digest'} ||= _calc_keys( $self->{'password'} ); + if ( ! $data) { + croak("Needed parameter 'data' not passed!\n"); + } - foreach my $rec ( @{ $self->{'records'} } ) { - if (!defined $rec->{'plaintext'}) { next; }; + if ( ! $self->Password($pass)) { + croak("Incorrect Password!\n"); + } - my $name = - defined $rec->{'plaintext'}->{'name'} - ? $rec->{'plaintext'}->{'name'} - : $EMPTY; - my $account = - defined $rec->{'plaintext'}->{'account'} - ? $rec->{'plaintext'}->{'account'} - : $EMPTY; - my $password = - defined $rec->{'plaintext'}->{'password'} - ? $rec->{'plaintext'}->{'password'} - : $EMPTY; - my $description = - defined $rec->{'plaintext'}->{'description'} - ? $rec->{'plaintext'}->{'description'} - : $EMPTY; - my $extra = $EMPTY; + $self->{'digest'} ||= _calc_keys( $pass ); - my $plaintext = join "$NULL", $account, $password, $description, $extra; + $data->{'account'} ||= $EMPTY; + $data->{'password'} ||= $EMPTY; + $data->{'notes'} ||= $EMPTY; - my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT ); + my $changed = 0; + my $need_newdate = 0; + my $acct = {}; + if ($rec->{'encrypted'}) { + $acct = $self->Decrypt($rec, $pass); + foreach my $key (keys %{ $data }) { + next if $key eq 'lastchange'; + if ($data->{$key} ne $acct->{$key}) { + $changed = 1; + last; + } + } + if ( exists $data->{'lastchange'} && exists $acct->{'lastchange'} && ( + $data->{'lastchange'}->{day} != $acct->{'lastchange'}->{day} || + $data->{'lastchange'}->{month} != $acct->{'lastchange'}->{month} || + $data->{'lastchange'}->{year} != $acct->{'lastchange'}->{year} + )) { + $changed = 1; + $need_newdate = 0; + } else { + $need_newdate = 1; + } - $rec->{'data'} = join "$NULL", $name, $encrypted; + } else { + $changed = 1; } + # no need to re-encrypt if it has not changed. + return 1 if ! $changed; + + my ($day, $month, $year); + + if ($data->{'lastchange'} && ! $need_newdate ) { + $day = $data->{'lastchange'}->{'day'} || 1; + $month = $data->{'lastchange'}->{'month'} || 0; + $year = $data->{'lastchange'}->{'year'} || 0; + + # XXX Need to actually validate the above information somehow + if ($year >= 1900) { + $year -= 1900; + } + } else { + $need_newdate = 1; + } + + if ($need_newdate) { + ($day, $month, $year) = (localtime)[3,4,5]; + } + $year -= 4; + $month++; + + + my $p = $day | ($month << 5) | ($year << 9); + my $packeddate = pack 'n', $p; + + my $plaintext = join $NULL, + $data->{'account'}, $data->{'password'}, $data->{'notes'}, $packeddate; + + my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT ); + + return if ! $encrypted; + + $rec->{'attributes'}{'Dirty'} = 1; + $rec->{'attributes'}{'dirty'} = 1; + $rec->{'name'} ||= $data->{'name'}; + $rec->{'encrypted'} = $encrypted; + return 1; } sub Decrypt { my $self = shift; - my $pass = shift; + my $rec = shift; + my $pass = shift || $self->{'password'}; - if ($pass) { - $self->_keyring_verify($pass) || return; + if ( ! $pass) { + croak("'password' not set!\n"); } - $self->{'digest'} ||= _calc_keys( $self->{'password'} ); + if ( ! $rec) { + croak("Needed parameter 'record' not passed!\n"); + } - my $reccount = 0; - foreach my $rec ( @{ $self->{'records'} } ) { - $reccount++; + if ( ! $self->Password($pass)) { + croak("Invalid Password!\n"); + } - # always skip the first record that has the password in it. - next if $reccount <= 1; - if ( ! defined $rec->{'data'} ) { - warn 'Invalid record ' . ( $reccount - 1 ) . "\n"; - next; - } + if ( ! $rec->{'encrypted'} ) { + croak("No encrypted content!"); + } - my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; - if (! $encrypted) { next; }; + $self->{'digest'} ||= _calc_keys( $pass ); - $rec->{'plaintext'}->{'name'} = $name; - - my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT ); - my ( $account, $password, $description, $extra ) = split /$NULL/xm, + my $decrypted = + _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT ); + my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm, $decrypted, 4; - $rec->{'plaintext'}->{'account'} = defined $account ? $account : $EMPTY; - $rec->{'plaintext'}->{'password'} = - defined $password ? $password : $EMPTY; - $rec->{'plaintext'}->{'description'} = - defined $description ? $description : $EMPTY; + my %Modified; + if ($packeddate) { + my $u = unpack 'n', $packeddate; + my $year = (($u & 0xFE00) >> 9) + 4; # since 1900 + my $month = (($u & 0x01E0) >> 5) - 1; # 0-11 + my $day = (($u & 0x001F) >> 0); # 1-31 - #print "Name: '$name'\n"; - #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n"; - #print " Hex: '" . unpack("H*", $encrypted) . "'\n"; - #print " Binary:'" . unpack("b*", $encrypted) . "'\n"; - #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n"; - #print " Hex: '" . unpack("H*", $decrypted) . "'\n"; - #print " Binary:'" . unpack("b*", $decrypted) . "'\n"; - #print "\n"; - #print "Extra: $extra\n"; - #exit; - #-------------------------------------------------- - # print "Account: $account\n"; - # print "Password: $password\n"; - # print "Description: $description\n"; - #-------------------------------------------------- + %Modified = ( + year => $year, + month => $month || 0, + day => $day || 1, + ); + } + return { + name => $rec->{'name'}, + account => $account, + password => $password, + notes => $notes, + lastchange => \%Modified, + }; +} + +sub Password { + my $self = shift; + my $pass = shift; + my $new_pass = shift; + + if (! $pass) { + delete $self->{password}; + return 1; } - return 1; + if (! exists $self->{'records'}) { + # Give the PDB the first record that will hold the encrypted password + $self->{'records'} = [ $self->new_Record ]; + + return $self->_password_update($pass); + } + + if ($new_pass) { + my @accts = (); + foreach my $i (0..$#{ $self->{'records'} }) { + if ($i == 0) { + push @accts, undef; + next; + } + my $acct = $self->Decrypt($self->{'records'}->[$i], $pass); + if ( ! $acct ) { + croak("Couldn't decrypt $self->{'records'}->[$i]->{'name'}"); + } + push @accts, $acct; + } + + if ( ! $self->_password_update($new_pass)) { + croak("Couldn't set new password!"); + } + $pass = $new_pass; + + foreach my $i (0..$#accts) { + next if $i == 0; + delete $self->{'records'}->[$i]->{'encrypted'}; + $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass); + } + } + + return $self->_password_verify($pass); } sub _calc_keys { @@ -231,18 +315,23 @@ return $digest; } -sub _keyring_verify { +sub _password_verify { my $self = shift; my $pass = shift; if (! $pass) { croak('No password specified!'); }; + if (defined $self->{'password'} && $pass eq $self->{'password'}) { + # already verified this password + return 1; + } + # AFAIK the thing we use to test the password is # always in the first entry my $data = $self->{'records'}->[0]->{'data'}; #die "No encrypted password in file!" unless defined $data; - if (! defined $data) { return; }; + if ( ! defined $data) { return; }; $data =~ s/$NULL$//xm; @@ -266,7 +355,7 @@ return; } -sub _keyring_update { +sub _password_update { # It is very important to Encrypt after calling this # (Although it is generally only called by Encrypt) @@ -275,15 +364,8 @@ my $self = shift; my $pass = shift; - if (! $pass) { croak('No password specified!'); }; + if (! defined $pass) { croak('No password specified!'); }; - # if the database already has a password in it - if ( $self->{'records'}->[0]->{'data'} ) { - - # Make sure everything is decrypted before we update the keyring - $self->Decrypt() || return; - } - my $salt; for ( 1 .. $kSalt_Size ) { $salt .= chr int rand 255; @@ -329,7 +411,7 @@ #print "PT: '$pt' - Length: " . length($pt) . "\n"; if (! length $pt) { next; }; if ( (length $pt) < 8 ) { - if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; + if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; my $len = 8 - (length $pt); #print "LENGTH: $len\n"; @@ -377,80 +459,100 @@ It has the standard Palm::PDB methods with 2 additional public methods. Decrypt and Encrypt. -It currently supports the v4 Keyring databases. The v5 databases from the pre-release keyring-2.0 are not supported. +It currently supports the v4 Keyring databases. The v5 databases from +the pre-release keyring-2.0 are not supported. +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; - use Palm::Keyring; - my $pdb = new Palm::PDB; - $pdb->Load($file); - foreach my $rec (@{ $pdb->{'records'} }) { - print "$rec->{'plaintext'}->{'name'}\n"; - } - $pdb->Decrypt($password); - # do something with the decrypted parts + use Palm::PDB; + use Palm::Keyring; + + my $pass = 'password'; + my $file = 'Keys-Gtkr.pdb'; + my $pdb = new Palm::PDB; + $pdb->Load($file); + + foreach (0..$#{ $pdb->{'records'} }) { + next if $_ = 0; # skip the password record + my $rec = $pdb->{'records'}->[$_]; + my $acct = $pdb->Decrypt($rec, $pass); + print $rec->{'name'}, ' - ', $acct->{'account'}, "\n"; + } =head1 SUBROUTINES/METHODS =head2 new - $pdb = new Palm::Keyring([$password]); + $pdb = new Palm::Keyring([$password]); Create a new PDB, initialized with the various Palm::Keyring fields and an empty record list. Use this method if you're creating a Keyring PDB from scratch otherwise you -can just use Palm::PDB::new(). +can just use Palm::PDB::new() before calling Load(). -=head2 Load +If you pass in a password, it will initalize the first record with the encrypted +password. - $pdb->Load($filename[, $password]); +=head2 Encrypt -Overrides the standard Palm::Raw Load() to add -$rec->{'plaintext'}->{'name'} and -$rec->{'encrypted'} fields. -$rec->{'plaintext'}->{'name'} holds the name of the record, -$rec->{'encrypted'} is the encrypted information in the PDB. + $pdb->Encrypt($rec, $acct[, $password]); -It also takes an additional optional parameter, which is the password to use to -decrypt the database. +Encrypts an account into a record, either with the password previously +used, or with a password that is passed. -See Decrypt() for the additional fields that are available after decryption. +$rec is a record from $pdb->{'records'} or a new_Record(). +$acct is a hashref in the format below. -=head2 Write + my $acct = { + name => $rec->{'name'}, + account => $account, + password => $password, + notes => $notes, + lastchange => { + year => 107, # years since 1900 + month => 0, # 0-11, 0 = January, 11 = December + day => 30, # 1-31, same as localtime + }, + }; - $pdb->Write($filename[, $password]); +If you have changed anything other than the lastchange, or don't pass in a +lastchange key, Encrypt() will generate a new lastchange date for you. -Just like the Palm::Raw::Write() but encrypts everything before saving. +If you pass in a lastchange field that is different than the one in the +record, it will honor what you passed in. -Also takes an optional password to encrypt with a new password, not needed -unless you are changing the password. +Encrypt() only uses the $acct->{'name'} if there is not already a $rec->{'name'}. -=head2 Encrypt +=head2 Decrypt - $pdb->Encrypt([$password]); + my $acct = $pdb->Decrypt($rec[, $password]); -Encrypts the PDB, either with the password used to decrypt or create it, or -optionally with a password that is passed. +Decrypts the record and returns a hashref for the account as described +under Encrypt(). -See Decrypt() for an what plaintext fields are available to be encrypted. + foreach (0..$#{ $pdb->{'records'}) { + next if $_ == 0; + my $rec = $pdb->{'records'}->[$_]; + my $acct = $pdb->Decrypt($rec[, $password]); + # do something with $acct + } -=head2 Decrypt +=head2 Password - $pdb->Decrypt([$password]); + $pdb->Password([$password[, $new_password]]); -Decrypts the PDB and fills out the rest of the fields available in -$rec->{'plaintext'}. +Either sets the password to be used to crypt, or if you pass $new_password, +changes the password on the database. -The plaintext should now be this, before encryption or after decryption: +If you have created a new $pdb, and you didn't set a password when you +called new(), you only need to pass one password and it will set that as +the password. - $rec->{'plaintext'} = { - name => $name, - account => $account, - password => $account_password, - description => $description, - }; +If nothing is passed, it forgets the password that it was remembering. =head1 DEPENDENCIES @@ -462,9 +564,22 @@ Readonly +=head1 THANKS + +I would like to thank the helpful Perlmonk shigetsu who gave me some great advice +and helped me get my first module posted. L + +I would also like to thank +Johan Vromans +Ejvromans@squirrel.nlE -- +L. +He had his own Palm::KeyRing module that he posted a couple of days before +mine was ready and he was kind enough to let me have the namespace as well +as giving me some very helpful hints about doing a few things that I was +unsure of. He is really great. + =head1 BUGS AND LIMITATIONS -Once this module is uploaded, you can Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be @@ -476,13 +591,10 @@ =head1 LICENSE AND COPYRIGHT -You may distribute this file under the terms of perl itself -as specified in the LICENSE file. - Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. =head1 SEE ALSO @@ -492,3 +604,6 @@ The Keyring for Palm OS website: L + +Johan Vromans also has a wxkeyring app that now uses this module, available +from his website at L