# 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.2 2006/01/31 23:03:39 andrew Exp $
# $RedRiver: Keyring.pm,v 1.1 2006/01/26 20:54:19 andrew Exp $
use strict;
package Palm::Keyring;
use Palm::Raw();
use Palm::StdAppInfo();
use vars qw( $VERSION @ISA );
use Digest::MD5 qw(md5);
use Crypt::DES;
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.2 $ =~ /\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("\000", $account, $password, $description, $extra);
my $encrypted = $self->_crypt3des($plaintext, ENCRYPT);
$record->{data} = join("\000", $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 /\000/, $record->{data}, 2;
$record->{plaintext}->{name} = $name;
my $decrypted = $self->_crypt3des($encrypted, DECRYPT);
my ($account, $password, $description, $extra)
= split /\000/, $decrypted, 4;
$record->{plaintext}->{account} = defined $account ? $account : '';
$record->{plaintext}->{password} = defined $password ? $password : '';
$record->{plaintext}->{description} = defined $description ? $description : '';
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";
#--------------------------------------------------
# print "Account: $account\n";
# print "Password: $password\n";
# print "Description: $description\n";
#--------------------------------------------------
}
return 1;
}
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;
}
# 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 ) = @_;
my $passphrase = $self->{digest} || $self->_calc_keys();
$passphrase .= ' ' x (16*3);
my $cyphertext = "";
my $size = length ( $plaintext );
print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
# 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;
my %C;
for ( 0..2 ) {
$C{$_} = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
}
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;
}
return substr ( $cyphertext, 0, $size );
}
1;
__END__
=head1 AUTHOR
Andrew Fresh Eandrew@mad-techies.org
=head1 SEE ALSO
Palm::PDB(3)
Palm::StdAppInfo(3)
=cut