# Palm::Keyring.pm
#
# 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.1 2006/01/26 20:54:19 andrew Exp $
# $RedRiver$
use strict;
package Palm::Keyring;
use Palm::Raw();
use Palm::StdAppInfo();
use vars qw( $VERSION @ISA );
use Digest::MD5 qw(md5);
use Crypt::TripleDES;
use constant ENCRYPT => 1;
use constant DECRYPT => 0;
use constant MD5_CBLOCK => 64;
my $kSaltSize = 4;
# One liner, to allow MakeMaker to work.
$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
@ISA = qw( Palm::StdAppInfo Palm::Raw );
=head1 NAME
Palm::Keyring - Handler for Palm Keyring databases.
=head1 SYNOPSIS
use Palm::Keyring;
$pdb->Decrypt('mypassword');
=head1 DESCRIPTION
The Keyring PDB handler is a helper class for the Palm::PDB package. It
parses Keyring databases. See
L.
It is just the standard Palm::Raw with 2 additional public methods. Decrypt and Encrypt.
=cut
=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.
=cut
#'
sub new
{
my $classname = shift;
my $pass = shift;
my $self = $classname->SUPER::new(@_);
# Create a generic PDB. No need to rebless it,
# though.
$self->{name} = "Keys-Gtkr"; # Default
$self->{creator} = "Gtkr";
$self->{type} = "Gkyr";
$self->{attributes}{resource} = 0;
# The PDB is not a resource database by
# default, but it's worth emphasizing,
# since MemoDB is explicitly not a PRC.
# Initialize the AppInfo block
$self->{appinfo} = {};
# 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;
}
sub import
{
&Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
[ "Gtkr", "Gkyr" ],
);
}
sub Encrypt
{
my $self = shift;
my $pass = shift;
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;
}
}
my $seen_enc_pass = 0;
foreach my $record (@{ $self->{records} }) {
unless ($seen_enc_pass) {
$seen_enc_pass = 1;
next;
}
next unless defined $record->{plaintext};
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 $plaintext = join("\0", $account, $password, $description, $extra);
my $encrypted = $self->_crypt($plaintext, ENCRYPT);
$record->{data} = join("\0", $name, $encrypted);
}
return 1;
}
sub Decrypt
{
my $self = shift;
my $pass = shift;
if ($pass) {
$self->_keyring_verify($pass) || return undef;
}
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;
}
next unless defined $record->{data};
my ($name, $encrypted) = split /\0/, $record->{data};
$record->{plaintext}->{name} = $name;
my $decrypted = $self->_crypt($encrypted, DECRYPT);
my ($account, $password, $description, $extra)
= split /\0/, $decrypted, 4;
$record->{plaintext}->{account} = defined $account ? $account : '';
$record->{plaintext}->{password} = defined $password ? $password : '';
$record->{plaintext}->{description} = defined $description ? $description : '';
#print "Extra: $extra\n";
#--------------------------------------------------
# print "Account: $account\n";
# print "Password: $password\n";
# print "Description: $description\n";
#--------------------------------------------------
}
return 1;
}
sub _crypt
{
my $self = shift;
my $original = shift;
my $flag = shift;
my $digest = $self->{digest} || $self->_calc_keys();
#print "DIGEST: $digest\n";
my $des = new Crypt::TripleDES;
if ($flag == ENCRYPT) {
return $des->encrypt3($original, $digest);
} else {
return $des->decrypt3($original, $digest);
}
}
sub _calc_keys
{
my $self = shift;
my $pass = $self->{'password'};
die "No password defined!" unless defined $pass;
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";
#--------------------------------------------------
$self->{digest} = $digest;
return $digest;
}
sub _keyring_verify
{
my $self = shift;
my $pass = shift;
die "No password specified!" unless defined $pass;
$self->{password} = $pass;
# 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;
$data =~ s/\0$//;
my $salt = substr($data, 0, $kSaltSize);
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
if ($self->_calc_keys()) {
return 1;
} else {
return undef;
}
} else {
return undef;
}
}
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;
die "No password specified!" unless defined $pass;
# 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;
}
my $salt;
for (1..$kSaltSize) {
$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->_calc_keys();
return 1;
}
1;
__END__
=head1 AUTHOR
Andrew Fresh Eandrew@mad-techies.org
=head1 SEE ALSO
Palm::PDB(3)
Palm::StdAppInfo(3)
=cut