palm/Palm-Keyring/lib/Palm/Keyring.pm - diff

Return to Keyring.pm CVS log

Up to [local] / palm / Palm-Keyring / lib / Palm

Diff for /palm/Palm-Keyring/lib/Palm/Keyring.pm between version 1.32 and 1.45

version 1.32, 2007/02/19 03:33:56

version 1.45, 2007/02/26 00:02:13

Line 1

package Palm::Keyring;

# $RedRiver: Keyring.pm,v 1.31 2007/02/19 02:55:35 andrew Exp $

# $RedRiver: Keyring.pm,v 1.44 2007/02/23 22:11:33 andrew Exp $

########################################################################

# Keyring.pm *** Perl class for Keyring for Palm OS databases.

Line 28

my $NULL = chr 0;

my @CRYPTS = (

{ # None

{

alias => 'None',

name => 'None',

keylen => 8,

blocksize => 1,

default_iter => 500,

{ # DES-EDE3

{

alias => 'DES-EDE3',

name => 'DES_EDE3',

keylen => 24,

blocksize => 8,

DES_odd_parity => 1,

default_iter => 1000,

{ # AES128

{

alias => 'AES128',

name => 'Rijndael',

keylen => 16,

blocksize => 16,

default_iter => 100,

{ # AES256

{

alias => 'AES256',

name => 'Rijndael',

keylen => 32,

blocksize => 16,

Line 103

Line 107

# Set defaults

if ($self->{version} == 5) {

$self->{options}->{cipher} ||= 0; # 'None'

$self->{options}->{iterations} ||=

my $c = crypts($self->{options}->{cipher})

$CRYPTS[ $self->{options}->{cipher} ]{default_iter};

or croak('Unknown cipher ' . $self->{options}->{cipher});

$self->{options}->{iterations} ||= $c->{default_iter};

$self->{appinfo}->{cipher} ||= $self->{options}->{cipher};

$self->{appinfo}->{iter} ||= $self->{options}->{iterations};

};

if ( defined $options->{password} ) {

Line 123

Line 127

return 1;

}

# Accessors

sub crypts

{

my $crypt = shift;

if (! defined $crypt || ! length $crypt) {

return;

} elsif ($crypt =~ /\D/) {

foreach my $c (@CRYPTS) {

if ($c->{alias} eq $crypt) {

return $c;

}

# didn't find it.

return;

} else {

return $CRYPTS[$crypt];

}

# ParseRecord

sub ParseRecord

Line 144

Line 168

delete $rec->{data};

} elsif ($self->{version} == 5) {

my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};

my $c = crypts( $self->{appinfo}->{cipher} )

or croak('Unknown cipher ' . $self->{appinfo}->{cipher});

my $blocksize = $c->{blocksize};

my ($field, $extra) = _parse_field($rec->{data});

my $ivec = substr $extra, 0, $blocksize;

delete $rec->{data};

my $encrypted = substr $extra, $blocksize;

$rec->{name} = $field->{data};

$rec->{ivec} = $ivec;

$rec->{ivec} = substr $extra, 0, $blocksize;

$rec->{encrypted} = $encrypted;

$rec->{encrypted} = substr $extra, $blocksize;

} else {

die 'Unsupported Version';

Line 179

Line 204

}

} elsif ($self->{version} == 5) {

my $field = {

my $field;

'label_id' => 1,

if ($rec->{name}) {

'data' => $rec->{name},

$field = {

'font' => 0,

'label_id' => 1,

};

'data' => $rec->{name},

my $packed .= _pack_field($field);

'font' => 0,

};

} else {

$field = {

'label_id' => $EMPTY,

'data' => $EMPTY,

'font' => 0,

};

}

my $packed = _pack_field($field);

$rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};

Line 239

Line 273

my $unpackstr

= ("C1" x 8) # 8 uint8s in an array for the salt

. ("S1" x 2) # the iter (uint16) and the cipher (uint16)

. ("n1" x 2) # the iter (uint16) and the cipher (uint16)

. ("C1" x 8); # and finally 8 more uint8s for the hash

my (@salt, $iter, $cipher, @hash);

Line 280

Line 314

my $packstr

= ("C1" x 8) # 8 uint8s in an array for the salt

. ("S1" x 2) # the iter (uint16) and the cipher (uint16)

. ("n1" x 2) # the iter (uint16) and the cipher (uint16)

. ("C1" x 8); # and finally 8 more uint8s for the hash

my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm;

Line 306

Line 340

my $rec = shift;

my $data = shift;

my $pass = shift || $self->{password};

my $ivec = shift;

if ( ! $pass && ! $self->{appinfo}->{key}) {

croak("password not set!\n");

Line 335

Line 370

$rec->{name} ||= $data->{name};

} elsif ($self->{version} == 5) {

my @recs = ($data, $acct);

my @accts = ($data, $acct);

my $name;

if ($self->{options}->{v4compatible}) {

$rec->{name} ||= $data->{name};

foreach my $rec (@recs) {

foreach my $a (@accts) {

my @fields;

foreach my $k (sort keys %{ $rec }) {

foreach my $k (sort keys %{ $a }) {

my $field = {

label => $k,

font => 0,

data => $rec->{$k},

data => $a->{$k},

};

push @fields, $field;

}

$rec = \@fields;

$a = \@fields;

}

my $ivec;

($encrypted, $ivec) = _encrypt_v5(

@recs,

@accts,

$self->{appinfo}->{key},

$self->{appinfo}->{cipher},

$ivec,

);

if ($ivec) {

if (defined $ivec) {

$rec->{ivec} = $ivec;

}

Line 384

Line 418

sub _encrypt_v4

{

require Crypt::CBC;

my $new = shift;

my $old = shift;

my $digest = shift;

Line 459

Line 491

my $old = shift;

my $key = shift;

my $cipher = shift;

my $length = $CRYPTS[ $cipher ]{blocksize};

my $ivec = shift;

my $ivec = shift || pack("C*",map {rand(256)} 1..$length);

my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);

my $keylen = $CRYPTS[ $cipher ]{keylen};

if (! defined $ivec) {

my $cipher_name = $CRYPTS[ $cipher ]{name};

$ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});

}

my $changed = 0;

my $need_newdate = 1;

my $date_index;

for (my $i = 0; $i < @{ $new }; $i++) {

if (

(exists $new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) ||

($new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) ||

(exists $new->[$i]->{label} && $new->[$i]->{label} eq 'lastchange')

($new->[$i]->{label} && $new->[$i]->{label} eq 'lastchange')

) {

$date_index = $i;

if ( $old && $#{ $new } == $#{ $old } && (

$new->[$i]->{data}->{day} != $old->[$i]->{data}->{day} ||

$new->[$i]{data}{day} != $old->[$i]{data}{day} ||

$new->[$i]->{data}->{month} != $old->[$i]->{data}->{month} ||

$new->[$i]{data}{month} != $old->[$i]{data}{month} ||

$new->[$i]->{data}->{year} != $old->[$i]->{data}->{year}

$new->[$i]{data}{year} != $old->[$i]{data}{year}

)) {

$changed = 1;

$need_newdate = 0;

last;

}

} elsif ($old && $#{ $new } == $#{ $old }) {

Line 527

Line 559

foreach my $field (@{ $new }) {

$decrypted .= _pack_field($field);

}

my $encrypted;

if ($cipher_name eq 'None') {

if ($c->{name} eq 'None') {

# do nothing

$encrypted = $decrypted;

} elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {

} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {

my $c = Crypt::CBC->new(

require Crypt::CBC;

-literal_key => 1,

my $cbc = Crypt::CBC->new(

-key => $key,

-literal_key => 1,

-iv => $ivec,

-cipher => $cipher_name,

-cipher => $c->{name},

-keysize => $keylen,

-keysize => $c->{keylen},

-blocksize => $c->{blocksize},

-header => 'none',

-padding => 'oneandzeroes',

);

Line 548

Line 581

croak("Unable to set up encryption!");

}

$encrypted = $c->encrypt($decrypted);

$encrypted = $cbc->encrypt($decrypted);

} else {

die "Unsupported Version";

Line 633

Line 666

sub _decrypt_v5

{

require Crypt::CBC;

my $encrypted = shift;

my $key = shift;

my $cipher = shift;

my $ivec = shift;

my $keylen = $CRYPTS[ $cipher ]{keylen};

my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);

my $cipher_name = $CRYPTS[ $cipher ]{name};

my $decrypted;

if ($cipher_name eq 'None') {

if ($c->{name} eq 'None') {

# do nothing

$decrypted = $encrypted;

} elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {

} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {

my $c = Crypt::CBC->new(

require Crypt::CBC;

-literal_key => 1,

my $cbc = Crypt::CBC->new(

-key => $key,

-literal_key => 1,

-iv => $ivec,

-cipher => $cipher_name,

-cipher => $c->{name},

-keysize => $keylen,

-keysize => $c->{keylen},

-blocksize => $c->{blocksize},

-header => 'none',

-padding => 'oneandzeroes',

);

Line 662

Line 696

if (! $c) {

croak("Unable to set up encryption!");

}

$encrypted .= $NULL x $keylen; # pad out a keylen

my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};

$decrypted = $c->decrypt($encrypted);

$encrypted .= $NULL x $len;

$decrypted = $cbc->decrypt($encrypted);

} else {

die "Unsupported Version";

Line 761

Line 796

}

} elsif ($self->{version} == 5) {

return _password_verify_v5($pass, $self->{appinfo});

return _password_verify_v5($self->{appinfo}, $pass);

} else {

# XXX unsupported version

}

Line 791

Line 826

my $digest = md5($msg);

if (! $data eq $salt . $digest ) {

if ($data ne $salt . $digest ) {

return;

}

Line 800

Line 835

sub _password_verify_v5

{

my $pass = shift;

my $appinfo = shift;

my $pass = shift;

my $salt = pack("H*", $appinfo->{salt});

my $c = crypts($appinfo->{cipher})

or croak('Unknown cipher ' . $appinfo->{cipher});

my ($key, $hash) = _calc_key_v5(

$pass, $salt, $appinfo->{iter},

$CRYPTS[ $appinfo->{cipher} ]{keylen},

$c->{keylen},

$CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity},

$c->{DES_odd_parity},

);

#print "Iter: '" . $appinfo->{iter} . "'\n";

#print "Key: '". unpack("H*", $key) . "'\n";

#print "Salt: '". unpack("H*", $salt) . "'\n";

#print "Hash: '". $hash . "'\n";

#print "Hash: '". $appinfo->{masterhash} . "'\n";

Line 909

Line 948

my $length = 8;

my $salt = shift || pack("C*",map {rand(256)} 1..$length);

my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);

my ($key, $hash) = _calc_key_v5(

$pass, $salt, $iter,

$CRYPTS[ $cipher ]->{keylen},

$c->{keylen},

$CRYPTS[ $cipher ]->{DES_odd_parity},

$c->{DES_odd_parity},

);

$appinfo->{salt} = unpack "H*", $salt;

$appinfo->{iter} = $iter;

$appinfo->{cipher} = $cipher;

$appinfo->{key} = $key;

$appinfo->{masterhash} = $hash;

$appinfo->{key} = $key;

return $key;

}

# Helpers

sub _calc_keys

{

Line 960

Line 1000

import Digest::SHA1 qw(sha1);

my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );

if ($dop) { $key = DES_odd_parity($key); }

if ($dop) { $key = _DES_odd_parity($key); }

my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));

Line 1029

Line 1069

$labels[3] = 'lastchange';

$labels[255] = 'notes';

my ($len) = unpack "S1", $field;

my ($len) = unpack "n1", $field;

if ($len + 4 > length $field) {

return undef, $field;

}

my $unpackstr = "S1 C1 C1 A$len";

my $unpackstr = "x2 C1 C1 A$len";

if ($len % 2 && $len + 4 < length $field) {

my $offset = 2 +1 +1 +$len;

if ($len % 2) { # && $len + 4 < length $field) {

# trim the 0/1 byte padding for next even address.

$offset++;

$unpackstr .= ' x'

}

$unpackstr .= ' A*';

my (undef, $label, $font, $data, $leftover)

my ($label, $font, $data) = unpack $unpackstr, $field;

= unpack $unpackstr, $field;

my $leftover = substr $field, $offset;

if ($label == 3) {

if ($label && $label == 3) {

$data = _parse_keyring_date($data);

}

return {

Line 1067

Line 1108

notes => 255,

);

my $label = $field->{label_id} || $labels{ $field->{label} };

my $packed;

my $font = $field->{font} || 0;

if (defined $field) {

my $data = $field->{data} || '';

my $label = $field->{label_id} || 0;

if (defined $field->{label} && ! $label) {

$label = $labels{ $field->{label} };

}

my $font = $field->{font} || 0;

my $data = defined $field->{data} ? $field->{data} : $EMPTY;

if ($label == 3) {

if ($label && $label == 3) {

$data = _pack_keyring_date($data);

}

my $len = length $data;

my $packstr = "S1 C1 C1 A*";

my $packstr = "n1 C1 C1 A*";

my $packed = pack $packstr, ($len, $label, $font, $data);

$packed = pack $packstr, ($len, $label, $font, $data);

if ($len % 2) {

# add byte padding for next even address.

$packed .= $NULL;

}

} else {

my $packstr = "n1 C1 C1 x1";

$packed = pack $packstr, 0, 0, 0;

}

return $packed;

Line 1192

Line 1242

return substr($t, 0, $keylen);

}

sub DES_odd_parity($) {

sub _DES_odd_parity($) {

my $key = $_[0];

my ($r, $i);

my @odd_parity = (

Line 1233

Line 1283

It has the standard Palm::PDB methods with 2 additional public methods.

Decrypt and Encrypt.

It currently supports the v4 Keyring databases.

It currently supports the v4 Keyring databases as well as

The pre-release v5 databases are mostly supported. There are definitely some

the pre-release v5 databases. I am not completely happy with the interface

bugs, For example, t/keyring5.t sometimes fails. I am not sure why yet.

for accessing v5 databases, so any suggestions on improvements on

the interface are appreciated.

This module doesn't store the decrypted content. It only keeps it until it

returns it to you or encrypts it.

Line 1255

Line 1306

next if $_ == 0 && $pdb->{version} == 4;

my $rec = $pdb->{records}->[$_];

my $acct = $pdb->Decrypt($rec, $pass);

print $rec->{name}, ' - ', $acct->{account}, "\n";

print $rec->{name}, ' - ';

if ($pdb->{version} == 4 || $pdb->{options}->{v4compatible}) {

print ' - ', $acct->{account};

} else {

foreach my $a (@{ $acct }) {

if ($a->{label} eq 'account') {

print ' - ', $a->{data};

last;

}

print "\n";

}

=head1 SUBROUTINES/METHODS

Line 1278

Line 1340

$pdb = new Palm::Keyring({ key1 => value1, key2 => value2 });

$pdb = new Palm::Keyring( -key1 => value1, -key2 => value2);

=head3 Supported options are:

=over

=item Supported options

=over

=item password

Line 1297

Line 1361

=item cipher

The cipher to use. 0, 1, 2 or 3.

The cipher to use. Either the number or the name.

0 => None

1 => DES_EDE3

Line 1308

Line 1372

The number of iterations to encrypt with.

=item options

A hashref of the options that are set

=back

For v5 databases there are some additional appinfo fields set.

These are set either on new() or Load().

$pdb->{appinfo} = {

# normal appinfo stuff described in L<Palm::StdAppInfo>

cipher => The index number of the cipher being used

iter => Number of iterations for the cipher

};

=head2 crypts

Pass in the alias of the crypt to use, or the index.

These only make sense for v5 databases.

This is a function, not a method.

$cipher can be 0, 1, 2, 3, None, DES_EDE3, AES128 or AES256.

my $c = Palm::Keyring::crypt($cipher);

$c is now:

$c = {

alias => (None|DES_EDE3|AES128|AES256),

name => (None|DES_EDE3|Rijndael),

keylen => <key length of the cipher>,

blocksize => <block size of the cipher>,

default_iter => <default iterations for the cipher>,

};

=head2 Encrypt

$pdb->Encrypt($rec, $acct[, $password]);

$pdb->Encrypt($rec, $acct[, $password[, $ivec]]);

Encrypts an account into a record, either with the password previously

used, or with a password that is passed.

$ivec is the initialization vector to use to encrypt the record. This is

not used by v4 databases. Normally this is not passed and is generated

randomly.

$rec is a record from $pdb->{records} or a new_Record().

The v4 $acct is a hashref in the format below.

Line 1361

Line 1466

The account name is stored in $rec->{name} for both v4 and v5 databases.

It is not returned in the decrypted information for v5.

$rec->{name} = 'account name';

Line 1380

Line 1485

Decrypts the record and returns a reference for the account as described

under Encrypt().

foreach (0..$#{ $pdb->{records}) {

foreach (0..$#{ $pdb->{records} }) {

next if $_ == 0 && $pdb->{version} == 4;

my $rec = $pdb->{records}->[$_];

my $acct = $pdb->Decrypt($rec);

Line 1401

Line 1506

If nothing is passed, it forgets the password that it was remembering.

After a successful password verification the following fields are set

For v4

$pdb->{digest} = the calculated digest used from the key;

$pdb->{password} = the password that was passed in;

For v5

$pdb->{appinfo} = {

# As described under new() with these additional fields

cipher => The index number of the cipher being used

iter => Number of iterations for the cipher

key => The key that is calculated from the password

and salt and is used to decrypt the records.

masterhash => the hash of the key that is stored in the

database. Either set when Loading the database

or when setting a new password.

salt => the salt that is either read out of the database

or calculated when setting a new password.

};

=head2 Other overridden subroutines/methods

=over

=item ParseAppInfoBlock

Converts the extra returned by Palm::StdAppInfo::ParseAppInfoBlock() into

the following additions to $pdb->{appinfo}

$pdb->{appinfo} = {

cipher => The index number of the cipher being used (Not v4)

iter => Number of iterations for the cipher (Not v4)

};

=item PackAppInfoBlock

Reverses ParseAppInfoBlock before

sending it on to Palm::StdAppInfo::PackAppInfoBlock()

=item ParseRecord

Adds some fields to a record from Palm::StdAppInfo::ParseRecord()

$rec = {

name => Account name

ivec => The IV for the encrypted record. (Not v4)

encrypted => the encrypted information

};

=item PackRecord

Reverses ParseRecord and then sends it through Palm::StdAppInfo::PackRecord()

=back

=head1 DEPENDENCIES

Palm::StdAppInfo

B<For v4 databases>

Digest::MD5

Crypt::DES

Readonly

B<For v5 databases>

Digest::HMAC_SHA1

Digest::SHA1

Depending on how the database is encrypted

Crypt::CBC - For any encryption but None

Crypt::DES_EDE3 - DES_EDE3 encryption

Crytp::Rijndael - AES encryption schemes

=head1 THANKS

I would like to thank the helpful Perlmonk shigetsu who gave me some great advice

Line 1425

Line 1601

as giving me some very helpful hints about doing a few things that I was

unsure of. He is really great.

And finally,

thanks to Jochen Hoenicke E<lt>hoenicke@gmail.comE<gt>

(one of the authors of Palm Keyring)

for getting me started on the v5 support as well as providing help

and some subroutines.

=head1 BUGS AND LIMITATIONS

I am sure there are problems with this module. For example, I have

not done very extensive testing of the v5 databases.

I am not sure I am 'require module' the best way, but I don't want to

depend on modules that you don't need to use.

I am not very happy with the data structures used by Encrypt() and

Decrypt() for v5 databases, but I am not sure of a better way.

The v4 compatibility mode does not insert a fake record 0 where

normally the encrypted password is stored.

The date validation for packing new dates is very poor.

I have not gone through and standardized on how the module fails. Some

things fail with croak, some return undef, some may even fail silently.

Nothing initializes a lasterr method or anything like that. I need

to fix all that before it is a 1.0 candidate.

Please report any bugs or feature requests to

C<bug-palm-keyring at rt.cpan.org>, or through the web interface at

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>