# 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.
#
# $RedRiver: Keyring.pm,v 1.12 2007/01/28 00:18:46 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.13 $ =~ /\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::PDB;
	use Palm::Keyring;
	my $pdb = new Palm::PDB;
	$pdb->Load($file);
	foreach my $record (@{ $pdb->{'records'} }) {
		print "$record->{'plaintext'}->{'name'}\n";
	}
	$pdb->Decrypt($password);
	# do something with the decrypted parts

=head1 DESCRIPTION

The Keyring PDB handler is a helper class for the Palm::PDB package. It
parses Keyring for Palm OS databases.  See
L<http://gnukeyring.sourceforge.net/>.

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.

=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 otherwise you 
can just use Palm::PDB::new().

=cut

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;

	# Give the PDB the first record that will hold the encrypted password
	$self->{records} = [ $self->new_Record ];

	if (defined $pass) {
		$self->Encrypt($pass);
	}

	return $self;
}

sub import
{
	&Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
		[ "Gtkr", "Gkyr" ],
		);
}

=pod

=head2 Load

	$pdb->Load($filename[, $password]);

Overrides the standard Palm::Raw Load() to add 
$record->{'plaintext'}->{'name'} and 
$record->{'encrypted'} fields.  
$record->{'plaintext'}->{'name'} holds the name of the record,  
$record->{'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.

=cut

sub Load
{
	my $self     = shift;
	my $filename = shift;
	my $password = shift;

	$self->{'appinfo'} = {};
	$self->{'records'} = [];
	$self->SUPER::Load($filename);

	foreach my $record (@{ $self->{records} }) {
		next unless exists $record->{data};
		my ($name, $encrypted) = split /\000/, $record->{data}, 2;
		next unless $encrypted;
		$record->{plaintext}->{name} = $name;
        $record->{encrypted} = $encrypted;
	}

	return $self->Decrypt($password) if defined $password;

	1;
}

=pod

=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.

=cut

sub Write
{
	my $self = shift;
	my $filename = shift;
	my $password = shift;

	$self->Encrypt($password) || return undef;
	return $self->SUPER::Write($filename);
}

=pod

=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.

=cut

sub Encrypt
{
	my $self = shift;
	my $pass = shift;

	if ($pass) {
		unless (exists $self->{'records'}->[0]->{'data'} && 
		    $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;
		}
	}

	$self->{digest} ||= _calc_keys($self->{password});

	foreach my $record (@{ $self->{records} }) {
		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 = _crypt3des($plaintext, $self->{digest}, ENCRYPT);

		$record->{data} = join("\000", $name, $encrypted);
	}

	1;
}

=head2 Decrypt

	$pdb->Decrypt([$password]);

Decrypts the PDB and fills out the rest of the fields available in 
$record->{'plaintext'}.

The plaintext should now be this, before encryption or after decryption:

	$record->{'plaintext'} = {
		name        => $name,
		account     => $account, 
		password    => $account_password,
		description => $description,
	};

=cut

sub Decrypt
{
	my $self = shift;
	my $pass = shift;

	if ($pass) {
		$self->_keyring_verify($pass) || return undef;
	}

	$self->{digest} ||= _calc_keys($self->{password});

	my $recordcount = 0;
	foreach my $record (@{ $self->{records} }) {
		$recordcount++;
		# always skip the first record that has the password in it.
		next if $recordcount <= 1;
		unless (defined $record->{data}) {
			warn "Invalid record " . ($recordcount - 1) . "\n";
			next;
		}

		my ($name, $encrypted) = split /\000/, $record->{data}, 2;
		next unless $encrypted;

		$record->{plaintext}->{name} = $name;

		my $decrypted = _crypt3des($encrypted, $self->{digest}, 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";
		#exit;
		#--------------------------------------------------
		# print "Account:     $account\n";
		# print "Password:    $password\n";
		# print "Description: $description\n";
		#-------------------------------------------------- 

	}

	1;
}

sub _calc_keys
{
	my $pass = shift;
	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";
	#-------------------------------------------------- 

	return $digest;
}

sub _keyring_verify
{
	my $self = shift;
	my $pass = shift;

	die "No password specified!" unless $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
		$self->{digest} = _calc_keys($pass);
		if ($self->{digest}) {
			$self->{password} = $pass;
			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 $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->{digest}   = _calc_keys($self->{password});

	return 1;
}

sub _crypt3des { 
	my ( $plaintext, $passphrase, $flag ) = @_; 
	my $NULL = chr(0);

	$passphrase .= ' ' x (16*3); 
	my $cyphertext = "";

	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";
		next unless length($pt);
		if (length($pt) < 8) {
			die "record not 8 byte padded" if  $flag == DECRYPT;
			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+$//;
	#print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";

	return $cyphertext;
}

1;
__END__

=head1 AUTHOR

Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>

=head1 SEE ALSO

Palm::PDB(3)

Palm::StdAppInfo(3)

The Keyring for Palm OS website: 
L<http://gnukeyring.sourceforge.net/>

=cut