# 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.10 2006/12/06 18:45:42 andrew Exp $
# $RedRiver: Keyring.pm,v 1.9 2006/11/10 17:49:51 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.10 $ =~ /\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<http://gnukeyring.sourceforge.net/>.

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;

	# 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 ($pass) {
		$self->Encrypt($pass);
	}

	return $self;
}

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

sub Load
{
	my $self = shift;
	$self->{'appinfo'} = {};
	$self->{'records'} = [];
	$self->SUPER::Load(@_);

	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;
	}
	1;
}

sub Write
{
	my $self = shift;
	$self->Encrypt() || return undef;
	return $self->SUPER::Write(@_);
}

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;
		}
	}

	$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);
	}

	return 1;
}

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

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

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

	foreach my $record (@{ $self->{records} }) {
		next unless defined $record->{data};

		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";
		#-------------------------------------------------- 

	}

	return 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;
	$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
		$self->{digest} = _calc_keys($self->{password});
		if ($self->{digest}) {
			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;
}


# XXX It looks like they are using des_ecb2_encrypt so I dunno if that is different
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 )));
	}


# XXX From Crypt::TripleDES
# http://search.cpan.org/src/VIPUL/Crypt-TripleDES-0.24/lib/Crypt/TripleDES.pm
#
#    for ( 0 .. (($size)/8) -1 ) { 
#     my $pt = substr( $plaintext, $_*8, 8 );
#        $pt = Crypt::PPDES::des_ecb_encrypt( $flag ? $keyvecs{0} : $keyvecs{2}, $flag, $pt );
#        $pt = Crypt::PPDES::des_ecb_encrypt( $keyvecs{1}, (not $flag), $pt );
#        $pt = Crypt::PPDES::des_ecb_encrypt( $flag ? $keyvecs{2} : $keyvecs{0}, $flag, $pt );
#        $cyphertext .= $pt; 
#    } 

	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.org<gt>

=head1 SEE ALSO

Palm::PDB(3)

Palm::StdAppInfo(3)

=cut