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

	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 E<lt>andrew@mad-techies.org<gt>

=head1 SEE ALSO

Palm::PDB(3)

Palm::StdAppInfo(3)

=cut