=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.6 retrieving revision 1.15 diff -u -r1.6 -r1.15 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2006/11/10 16:18:59 1.6 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/01/29 02:49:41 1.15 @@ -1,388 +1,491 @@ -# Palm::Keyring.pm +package Palm::Keyring; + +# $RedRiver: Keyring.pm,v 1.14 2007/01/28 22:24:17 andrew Exp $ # -# Perl class for dealing with Keyring for Palm OS databases. +# Perl class for dealing with Keyring for Palm OS databases. # -# Copyright (C) 2004, Andrew Fresh -# You may distribute this file under the terms of the Artistic -# License, as specified in the README file distributed with the p5-Palm distribution. -# # This started as Memo.pm, I just made it work for Keyring. -# -# $Id: Keyring.pm,v 1.6 2006/11/10 16:18:59 andrew Exp $ -# $RedRiver: Keyring.pm,v 1.5 2006/11/10 04:52:27 andrew Exp $ use strict; -package Palm::Keyring; -use Palm::Raw(); -use Palm::StdAppInfo(); -use vars qw( $VERSION @ISA ); +use warnings; +use Carp; +use base qw/ Palm::StdAppInfo /; + use Digest::MD5 qw(md5); use Crypt::DES; +use Readonly; -use constant ENCRYPT => 1; -use constant DECRYPT => 0; -use constant MD5_CBLOCK => 64; -my $kSaltSize = 4; +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; - # One liner, to allow MakeMaker to work. -$VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our ($VERSION) = q$Revision: 1.15 $ =~ m{ Revision: \s+ (\S+) }xm; -@ISA = qw( Palm::StdAppInfo Palm::Raw ); +#@ISA = qw( Palm::StdAppInfo Palm::Raw ); -=head1 NAME +sub new { + my $classname = shift; + my $pass = shift; -Palm::Keyring - Handler for Palm Keyring databases. + # Create a generic PDB. No need to rebless it, though. + my $self = $classname->SUPER::new(@_); -=head1 SYNOPSIS + $self->{'name'} = 'Keys-Gtkr'; # Default + $self->{'creator'} = 'Gtkr'; + $self->{'type'} = 'Gkyr'; - use Palm::Keyring; - $pdb->Decrypt('mypassword'); + # The PDB is not a resource database by + # default, but it's worth emphasizing, + # since MemoDB is explicitly not a PRC. + $self->{'attributes'}{'resource'} = 0; -=head1 DESCRIPTION + # Initialize the AppInfo block + $self->{'appinfo'} = {}; -The Keyring PDB handler is a helper class for the Palm::PDB package. It -parses Keyring databases. See -L. + # Add the standard AppInfo block stuff + Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} ); -It is just the standard Palm::Raw with 2 additional public methods. Decrypt and Encrypt. + # Set the version + $self->{'version'} = 4; -=cut -=head2 new + # Give the PDB the first record that will hold the encrypted password + $self->{'records'} = [ $self->new_Record ]; - $pdb = new Palm::Keyring ('password'); + if ( defined $pass ) { + $self->Encrypt($pass); + } -Create a new PDB, initialized with the various Palm::Keyring fields -and an empty record list. + return $self; +} -Use this method if you're creating a Keyring PDB from scratch. +sub import { + Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], ); + return 1; +} -=cut -#' -sub new -{ - my $classname = shift; - my $pass = shift; +sub Load { + my $self = shift; + my $filename = shift; + my $password = shift; - # Create a generic PDB. No need to rebless it, though. - my $self = $classname->SUPER::new(@_); + $self->{'appinfo'} = {}; + $self->{'records'} = []; + $self->SUPER::Load($filename); - $self->{name} = "Keys-Gtkr"; # Default - $self->{creator} = "Gtkr"; - $self->{type} = "Gkyr"; - # The PDB is not a resource database by - # default, but it's worth emphasizing, - # since MemoDB is explicitly not a PRC. - $self->{attributes}{resource} = 0; + 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; + } - # Initialize the AppInfo block - $self->{appinfo} = {}; + return $self->Decrypt($password) if defined $password; - # Add the standard AppInfo block stuff - &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo}); - - # Set the version - $self->{version} = 4; - - # Give the PDB the first record that will hold the encrypted password - $self->{records} = [ { - 'category' => 0, - 'attributes' => { - 'private' => 1, - 'Secret' => 1, - 'Dirty' => 1, - 'dirty' => 1 - }, - }, ]; - - if ($pass) { - $self->Encrypt($pass); - } - - return $self; + return 1; } -sub import -{ - &Palm::PDB::RegisterPDBHandlers(__PACKAGE__, - [ "Gtkr", "Gkyr" ], - ); -} +sub Write { + my $self = shift; + my $filename = shift; + my $password = shift; -sub Load -{ - my $self = shift; - $self->SUPER::Load(@_); - - # Skip the first 2 records because they are special - # and don't have any plaintext - my $skip = 0; - foreach my $record (@{ $self->{records} }) { - if ($skip < 2) { - $skip++; - next; - } - my ($name, $encrypted) = split /\000/, $record->{data}, 2; - $record->{plaintext}->{name} = $name; - $record->{encrypted} = $encrypted; - } - 1; + $self->Encrypt($password) || return; + return $self->SUPER::Write($filename); } -sub Write -{ - my $self = shift; - $self->Encrypt() || return undef; - return $self->SUPER::Load(@_); -} +sub Encrypt { + my $self = shift; + my $pass = shift; -sub Encrypt -{ - my $self = shift; - my $pass = shift; + if ($pass) { + if ( + !( exists $self->{'records'}->[0]->{'data'} + && $self->_keyring_verify($pass) ) + ) + { - if ($pass) { - unless ($self->_keyring_verify($pass) ) { - # This would encrypt with a new password. - # First decrypting everything with the old password of course. - $self->_keyring_update($pass) || return undef; - $self->_keyring_verify($pass) || return undef; - } - } + # 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; + } + } - my $seen_enc_pass = 0; - foreach my $record (@{ $self->{records} }) { - unless ($seen_enc_pass) { - $seen_enc_pass = 1; - next; - } + $self->{'digest'} ||= _calc_keys( $self->{'password'} ); - next unless defined $record->{plaintext}; + foreach my $rec ( @{ $self->{'records'} } ) { + if (!defined $rec->{'plaintext'}) { next; }; - my $name = defined $record->{plaintext}->{name} ? $record->{plaintext}->{name} : ''; - my $account = defined $record->{plaintext}->{account} ? $record->{plaintext}->{account} : ''; - my $password = defined $record->{plaintext}->{password} ? $record->{plaintext}->{password} : ''; - my $description = defined $record->{plaintext}->{description} ? $record->{plaintext}->{description} : ''; - my $extra = ''; + 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; - my $plaintext = join("\000", $account, $password, $description, $extra); + my $plaintext = join "$NULL", $account, $password, $description, $extra; - my $encrypted = $self->_crypt3des($plaintext, ENCRYPT); + my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT ); - $record->{data} = join("\000", $name, $encrypted); - } + $rec->{'data'} = join "$NULL", $name, $encrypted; + } - return 1; + return 1; } -sub Decrypt -{ - my $self = shift; - my $pass = shift; +sub Decrypt { + my $self = shift; + my $pass = shift; - if ($pass) { - $self->_keyring_verify($pass) || return undef; - } + if ($pass) { + $self->_keyring_verify($pass) || return; + } - my $seen_enc_pass = 0; - foreach my $record (@{ $self->{records} }) { - unless ($seen_enc_pass) { - # need to skip the first record because it is the encrypted password - $seen_enc_pass = 1; - next; - } + $self->{'digest'} ||= _calc_keys( $self->{'password'} ); - next unless defined $record->{data}; + my $reccount = 0; + foreach my $rec ( @{ $self->{'records'} } ) { + $reccount++; - my ($name, $encrypted) = split /\000/, $record->{data}, 2; - $record->{plaintext}->{name} = $name; + # 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; + } - my $decrypted = $self->_crypt3des($encrypted, DECRYPT); - my ($account, $password, $description, $extra) - = split /\000/, $decrypted, 4; + my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; + if (! $encrypted) { next; }; - $record->{plaintext}->{account} = defined $account ? $account : ''; - $record->{plaintext}->{password} = defined $password ? $password : ''; - $record->{plaintext}->{description} = defined $description ? $description : ''; + $rec->{'plaintext'}->{'name'} = $name; + my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT ); + my ( $account, $password, $description, $extra ) = 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; + #print "Name: '$name'\n"; #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n"; - #print "Hex: '" . unpack("H*", $encrypted) . "'\n"; - #print "Binary: '" . unpack("b*", $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 " Hex: '" . unpack("H*", $decrypted) . "'\n"; + #print " Binary:'" . unpack("b*", $decrypted) . "'\n"; #print "\n"; - #print "Extra: $extra\n"; - #-------------------------------------------------- - # print "Account: $account\n"; - # print "Password: $password\n"; - # print "Description: $description\n"; - #-------------------------------------------------- + #print "Extra: $extra\n"; + #exit; + #-------------------------------------------------- + # print "Account: $account\n"; + # print "Password: $password\n"; + # print "Description: $description\n"; + #-------------------------------------------------- - } + } - return 1; + return 1; } -sub _calc_keys -{ - my $self = shift; +sub _calc_keys { + my $pass = shift; + if (! defined $pass) { croak('No password defined!'); }; - my $pass = $self->{'password'}; - die "No password defined!" unless defined $pass; + my $digest = md5($pass); - my $digest = md5($pass); + my ( $key1, $key2 ) = unpack 'a8a8', $digest; - my ($key1, $key2) = unpack('a8a8', $digest); - #-------------------------------------------------- - # print "key1: $key1: ", length $key1, "\n"; - # print "key2: $key2: ", length $key2, "\n"; - #-------------------------------------------------- + #-------------------------------------------------- + # print "key1: $key1: ", length $key1, "\n"; + # print "key2: $key2: ", length $key2, "\n"; + #-------------------------------------------------- - $digest = unpack('H*', $key1 . $key2 . $key1); - #-------------------------------------------------- - # print "Digest: ", $digest, "\n"; - # print length $digest, "\n"; - #-------------------------------------------------- + $digest = unpack 'H*', $key1 . $key2 . $key1; - $self->{digest} = $digest; - return $digest; + #-------------------------------------------------- + # print "Digest: ", $digest, "\n"; + # print length $digest, "\n"; + #-------------------------------------------------- + + return $digest; } -sub _keyring_verify -{ - my $self = shift; - my $pass = shift; +sub _keyring_verify { + my $self = shift; + my $pass = shift; - die "No password specified!" unless $pass; - $self->{password} = $pass; + if (! $pass) { croak('No password specified!'); }; - # 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; - return undef unless defined $data; + # AFAIK the thing we use to test the password is + # always in the first entry + my $data = $self->{'records'}->[0]->{'data'}; - $data =~ s/\0$//; + #die "No encrypted password in file!" unless defined $data; + if (! defined $data) { return; }; - my $salt = substr($data, 0, $kSaltSize); + $data =~ s/$NULL$//xm; - my $msg = $salt . $pass; + my $salt = substr $data, 0, $kSalt_Size; - $msg .= "\0" x (MD5_CBLOCK - length($msg)); + my $msg = $salt . $pass; - my $digest = md5($msg); + $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); - if ($data eq $salt . $digest) { - # May as well generate the keys we need now, since we know the password is right - if ($self->_calc_keys()) { - return 1; - } else { - return undef; - } - } else { - return undef; - } + my $digest = md5($msg); + + if ( $data eq $salt . $digest ) { + +# May as well generate the keys we need now, since we know the password is right + $self->{'digest'} = _calc_keys($pass); + if ( $self->{'digest'} ) { + $self->{'password'} = $pass; + return 1; + } + } + return; } -sub _keyring_update -{ - # It is very important to Encrypt after calling this - # (Although it is generally only called by Encrypt) - # because otherwise the data will be out of sync with the - # password, and that would suck! - my $self = shift; - my $pass = shift; +sub _keyring_update { - die "No password specified!" unless $pass; + # It is very important to Encrypt after calling this + # (Although it is generally only called by Encrypt) + # because otherwise the data will be out of sync with the + # password, and that would suck! + my $self = shift; + my $pass = shift; - # 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 undef; - } + if (! $pass) { croak('No password specified!'); }; - my $salt; - for (1..$kSaltSize) { - $salt .= chr(int(rand(255))); - } + # if the database already has a password in it + if ( $self->{'records'}->[0]->{'data'} ) { - my $msg = $salt . $pass; + # Make sure everything is decrypted before we update the keyring + $self->Decrypt() || return; + } - $msg .= "\0" x (MD5_CBLOCK - length($msg)); + my $salt; + for ( 1 .. $kSalt_Size ) { + $salt .= chr int rand 255; + } - my $digest = md5($msg); + my $msg = $salt . $pass; - my $data = $salt . $digest;# . "\0"; + $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); - # AFAIK the thing we use to test the password is - # always in the first entry - $self->{records}->[0]->{data} = $data; + my $digest = md5($msg); - $self->{password} = $pass; - $self->_calc_keys(); + my $data = $salt . $digest; # . "\0"; - return 1; + # AFAIK the thing we use to test the password is + # always in the first entry + $self->{'records'}->[0]->{'data'} = $data; + + $self->{'password'} = $pass; + $self->{'digest'} = _calc_keys( $self->{'password'} ); + + return 1; } +sub _crypt3des { + my ( $plaintext, $passphrase, $flag ) = @_; -# XXX Have to make this encrypt as well as decrypting, but w00 h00! -# do null padding on the end of a cleartext if we are going to encrypt it -sub _crypt3des { - my ( $self, $plaintext, $flag ) = @_; + $passphrase .= $SPACE x ( 16 * 3 ); + my $cyphertext = $EMPTY; - my $passphrase = $self->{digest} || $self->_calc_keys(); - $passphrase .= ' ' x (16*3); - my $cyphertext = ""; + my $size = length $plaintext; + #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n"; - my $size = length ( $plaintext ); - #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n"; + my @C; + for ( 0 .. 2 ) { + $C[$_] = + new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 )); + } - # This check should see if it is plaintext first, if it is, - # pad it with \000 - # if not, then die - die "record not 8 byte padded" if (length($plaintext) % 8) && ! $flag; + for ( 0 .. ( ($size) / 8 ) ) { + my $pt = substr $plaintext, $_ * 8, 8; - my @C; - for ( 0..2 ) { - $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 ))); - } + #print "PT: '$pt' - Length: " . length($pt) . "\n"; + if (! length $pt) { next; }; + if ( (length $pt) < 8 ) { + if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; + my $len = 8 - (length $pt); - for ( 0 .. (($size)/8) - 1) { - my $pt = substr( $plaintext, $_*8, 8 ); - #print "PT: '$pt' - Length: " . length($pt) . "\n"; - if (length($pt) < 8) { - my $len = 8 - length($pt); - print "LENGTH: $len\n"; - print "Binary: '" . unpack("b*", $pt) . "'\n"; - $pt .= (chr(0) x $len);# . $pt; - print "Binary: '" . unpack("b*", $pt) . "'\n"; - #print "PT: '$pt' - Length: " . length($pt) . "\n"; - } - $pt = $C[0]->decrypt( $pt ); - $pt = $C[1]->encrypt( $pt ); - $pt = $C[2]->decrypt( $pt ); - #print "PT: '$pt' - Length: " . length($pt) . "\n"; - $cyphertext .= $pt; - } + #print "LENGTH: $len\n"; + #print "Binary: '" . unpack("b*", $pt) . "'\n"; + $pt .= ($NULL x $len); - return substr ( $cyphertext, 0, $size ); + #print "PT: '$pt' - Length: " . length($pt) . "\n"; + #print "Binary: '" . unpack("b*", $pt) . "'\n"; + } + if ( $flag == $ENCRYPT ) { + $pt = $C[0]->encrypt($pt); + $pt = $C[1]->decrypt($pt); + $pt = $C[2]->encrypt($pt); + } + else { + $pt = $C[0]->decrypt($pt); + $pt = $C[1]->encrypt($pt); + $pt = $C[2]->decrypt($pt); + } + + #print "PT: '$pt' - Length: " . length($pt) . "\n"; + $cyphertext .= $pt; + } + + $cyphertext =~ s/$NULL+$//xm; + + #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n"; + + return $cyphertext; } 1; __END__ +=head1 NAME + +Palm::Keyring - Handler for Palm Keyring databases. + +=head1 DESCRIPTION + +The Keyring PDB handler is a helper class for the Palm::PDB package. It +parses Keyring for Palm OS databases. See +L. + +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. + +=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 + +=head1 SUBROUTINES/METHODS + +=head2 new + + $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(). + +=head2 Load + + $pdb->Load($filename[, $password]); + +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. + +It also takes an additional optional parameter, which is the password to use to +decrypt the database. + +See Decrypt() for the additional fields that are available after decryption. + +=head2 Write + + $pdb->Write($filename[, $password]); + +Just like the Palm::Raw::Write() but encrypts everything before saving. + +Also takes an optional password to encrypt with a new password, not needed +unless you are changing the password. + +=head2 Encrypt + + $pdb->Encrypt([$password]); + +Encrypts the PDB, either with the password used to decrypt or create it, or +optionally with a password that is passed. + +See Decrypt() for an what plaintext fields are available to be encrypted. + +=head2 Decrypt + + $pdb->Decrypt([$password]); + +Decrypts the PDB and fills out the rest of the fields available in +$rec->{'plaintext'}. + +The plaintext should now be this, before encryption or after decryption: + + $rec->{'plaintext'} = { + name => $name, + account => $account, + password => $account_password, + description => $description, + }; + +=head1 DEPENDENCIES + +Palm::StdAppInfo + +Digest::MD5 + +Crypt::DES + +Readonly + +=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 +notified of progress on your bug as I make changes. + =head1 AUTHOR -Andrew Fresh Eandrew@mad-techies.org +Andrew Fresh Eandrew@mad-techies.orgE +=head1 LICENSE AND COPYRIGHT + +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. + =head1 SEE ALSO Palm::PDB(3) Palm::StdAppInfo(3) -=cut +The Keyring for Palm OS website: +L