package Palm::Keyring;
# $RedRiver: Keyring.pm,v 1.18 2007/01/30 05:18:06 andrew Exp $
#
# Perl class for dealing with Keyring for Palm OS databases.
#
# This started as Memo.pm, I just made it work for Keyring.
use strict;
use warnings;
use Carp;
use base qw/ Palm::StdAppInfo /;
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;
# One liner, to allow MakeMaker to work.
our $VERSION = 0.92;
sub new {
my $classname = shift;
my $pass = shift;
# Create a generic PDB. No need to rebless it, though.
my $self = $classname->SUPER::new(@_);
$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;
# Initialize the AppInfo block
$self->{'appinfo'} = {};
# Add the standard AppInfo block stuff
Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} );
# Set the version
$self->{'version'} = 4;
if ( defined $pass ) {
$self->Password($pass);
}
return $self;
}
sub import {
Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
return 1;
}
sub ParseRecord {
my $self = shift;
my $rec = $self->SUPER::ParseRecord(@_);
# skip the 0 record that holds the password
return $rec if ! exists $self->{'records'};
return $rec if ! exists $rec->{'data'};
my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
return $rec if ! $encrypted;
delete $rec->{'data'};
$rec->{'name'} = $name;
$rec->{'encrypted'} = $encrypted;
return $rec;
}
sub PackRecord {
my $self = shift;
my $rec = shift;
my $rec0_id = $self->{'records'}->[0]->{'id'};
if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) {
$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 $rec = shift;
my $data = shift;
my $pass = shift || $self->{'password'};
if ( ! $pass) {
croak("'password' not set!\n");
}
if ( ! $rec) {
croak("Needed parameter 'record' not passed!\n");
}
if ( ! $data) {
croak("Needed parameter 'data' not passed!\n");
}
if ( ! $self->Password($pass)) {
croak("Incorrect Password!\n");
}
$self->{'digest'} ||= _calc_keys( $pass );
$data->{'account'} ||= $EMPTY;
$data->{'password'} ||= $EMPTY;
$data->{'notes'} ||= $EMPTY;
my %Modified;
my ($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 $rec = shift;
my $pass = shift || $self->{'password'};
if ( ! $pass) {
croak("'password' not set!\n");
}
if ( ! $rec) {
croak("Needed parameter 'record' not passed!\n");
}
if ( ! $self->Password($pass)) {
croak("Invalid Password!\n");
}
if ( ! $rec->{'encrypted'} ) {
croak("No encrypted content!");
}
$self->{'digest'} ||= _calc_keys( $pass );
my $decrypted =
_crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );
my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm,
$decrypted, 4;
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
%Modified = (
year => $year,
month => $month || 0,
day => $day || 1,
);
}
return {
name => $rec->{'name'},
account => $account,
password => $password,
notes => $notes,
date => \%Modified,
};
}
sub Password {
my $self = shift;
my $pass = shift || $self->{'password'};
my $new_pass = shift;
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;
$self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);
}
}
return $self->_password_verify($pass);
}
sub _calc_keys {
my $pass = shift;
if (! defined $pass) { croak('No password defined!'); };
my $digest = md5($pass);
my ( $key1, $key2 ) = unpack 'a8a8', $digest;
#--------------------------------------------------
# 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";
#--------------------------------------------------
return $digest;
}
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; };
$data =~ s/$NULL$//xm;
my $salt = substr $data, 0, $kSalt_Size;
my $msg = $salt . $pass;
$msg .= "\0" x ( $MD5_CBLOCK - length $msg );
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 _password_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;
if (! defined $pass) { croak('No password specified!'); };
my $salt;
for ( 1 .. $kSalt_Size ) {
$salt .= chr int rand 255;
}
my $msg = $salt . $pass;
$msg .= "\0" x ( $MD5_CBLOCK - length $msg );
my $digest = md5($msg);
my $data = $salt . $digest; # . "\0";
# 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 ) = @_;
$passphrase .= $SPACE x ( 16 * 3 );
my $cyphertext = $EMPTY;
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 ));
}
for ( 0 .. ( ($size) / 8 ) ) {
my $pt = substr $plaintext, $_ * 8, 8;
#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);
#print "LENGTH: $len\n";
#print "Binary: '" . unpack("b*", $pt) . "'\n";
$pt .= ($NULL x $len);
#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.
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 $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]);
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() before calling Load().
=head2 Encrypt
$pdb->Encrypt($rec, $acct, [$password]);
Encrypts an account into a record, either with the password previously
used, or with a password that is passed.
$rec is a record from $pdb->{'records'} or a newly generated record.
$acct is a hashref in the format below.
my $acct = {
account => $account,
password => $password,
notes => $notes,
};
=head2 Decrypt
my $acct = $pdb->Decrypt($rec[, $password]);
Decrypts the record and returns a hashref for the account as described
under Encrypt();
foreach (0..$#{ $pdb->{'records'}) {
next if $_ == 0;
my $rec = $pdb->{'records'}->[$_];
my $acct = $pdb->Decrypt($rec[, $password]);
# do something with $acct
}
=head2 Password
$pdb->Password([$password[, $new_password]]);
Either sets the password to be used to crypt, or if you pass $new_password,
changes the password on the database.
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.
If nothing is passed, and there has been a password used before,
it just verifies that the password was correct.
=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.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)
The Keyring for Palm OS website:
L