===================================================================
RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v
retrieving revision 1.29
retrieving revision 1.33
diff -u -r1.29 -r1.33
--- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/19 00:22:42 1.29
+++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/21 01:26:07 1.33
@@ -1,5 +1,5 @@
package Palm::Keyring;
-# $RedRiver: Keyring.pm,v 1.28 2007/02/18 05:50:25 andrew Exp $
+# $RedRiver: Keyring.pm,v 1.32 2007/02/19 03:33:56 andrew Exp $
########################################################################
# Keyring.pm *** Perl class for Keyring for Palm OS databases.
#
@@ -16,17 +16,9 @@
use warnings;
use Carp;
-use Data::Dumper;
use base qw/ Palm::StdAppInfo /;
-use Digest::HMAC_SHA1 qw(hmac_sha1);
-use Digest::SHA1 qw(sha1);
-use Crypt::CBC;
-
-use Digest::MD5 qw(md5);
-use Crypt::DES;
-
my $ENCRYPT = 1;
my $DECRYPT = 0;
my $MD5_CBLOCK = 64;
@@ -154,13 +146,10 @@
} elsif ($self->{version} == 5) {
my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};
my ($field, $extra) = _parse_field($rec->{data});
- my ($ivec, $encrypted) = unpack "A$blocksize A*", $extra;
+ my $ivec = substr $extra, 0, $blocksize;
+ my $encrypted = substr $extra, $blocksize;
- if ($self->{options}->{v4compatible}) {
- $rec->{name} = $field->{data};
- } else {
- $rec->{name} = $field;
- }
+ $rec->{name} = $field->{data};
$rec->{ivec} = $ivec;
$rec->{encrypted} = $encrypted;
@@ -190,27 +179,14 @@
}
} elsif ($self->{version} == 5) {
- my $field;
- if ($rec->{name}) {
- if ($self->{options}->{v4compatible}) {
- $field = {
- label => 'name',
- font => 0,
- data => $rec->{'name'},
- };
- } else {
- $field = $rec->{name};
- }
- }
- my $packed = '';
- if ($field) {
- $packed = _pack_field($field);
- }
- my $len = length $packed;
- my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};
+ my $field = {
+ 'label_id' => 1,
+ 'data' => $rec->{name},
+ 'font' => 0,
+ };
+ my $packed .= _pack_field($field);
- $rec->{data} = pack "A$len A$blocksize A*",
- $packed, $rec->{ivec}, $rec->{encrypted};
+ $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};
} else {
die 'Unsupported Version';
@@ -408,6 +384,8 @@
sub _encrypt_v4
{
+ require Crypt::CBC;
+
my $new = shift;
my $old = shift;
my $digest = shift;
@@ -481,7 +459,8 @@
my $old = shift;
my $key = shift;
my $cipher = shift;
- my $ivec = shift || pack("C*",map {rand(256)} 1..8);
+ my $length = $CRYPTS[ $cipher ]{blocksize};
+ my $ivec = shift || pack("C*",map {rand(256)} 1..$length);
my $keylen = $CRYPTS[ $cipher ]{keylen};
my $cipher_name = $CRYPTS[ $cipher ]{name};
@@ -580,7 +559,7 @@
# Decrypt
-sub Decrypt
+sub Decrypt
{
my $self = shift;
my $rec = shift;
@@ -594,7 +573,7 @@
croak("Needed parameter 'record' not passed!\n");
}
- if ( ! $self->Password($pass)) {
+ if ( $pass && ! $self->Password($pass)) {
croak("Invalid Password!\n");
}
@@ -654,6 +633,7 @@
sub _decrypt_v5
{
+ require Crypt::CBC;
my $encrypted = shift;
my $key = shift;
my $cipher = shift;
@@ -713,7 +693,7 @@
if (! $pass) {
delete $self->{password};
- delete $self->{key};
+ delete $self->{appinfo}->{key};
return 1;
}
@@ -791,6 +771,9 @@
sub _password_verify_v4
{
+ require Digest::MD5;
+ import Digest::MD5 qw(md5);
+
my $pass = shift;
my $data = shift;
@@ -808,7 +791,7 @@
my $digest = md5($msg);
- if (! $data eq $salt . $digest ) {
+ if ($data ne $salt . $digest ) {
return;
}
@@ -891,6 +874,9 @@
sub _password_update_v4
{
+ require Digest::MD5;
+ import Digest::MD5 qw(md5);
+
my $pass = shift;
if (! defined $pass) { croak('No password specified!'); };
@@ -968,6 +954,11 @@
{
my ($pass, $salt, $iter, $keylen, $dop) = @_;
+ require Digest::HMAC_SHA1;
+ import Digest::HMAC_SHA1 qw(hmac_sha1);
+ require Digest::SHA1;
+ import Digest::SHA1 qw(sha1);
+
my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );
if ($dop) { $key = DES_odd_parity($key); }
@@ -978,6 +969,8 @@
sub _crypt3des
{
+ require Crypt::DES;
+
my ( $plaintext, $passphrase, $flag ) = @_;
$passphrase .= $SPACE x ( 16 * 3 );
@@ -1041,7 +1034,7 @@
return undef, $field;
}
my $unpackstr = "S1 C1 C1 A$len";
- if ($len % 2) {
+ if ($len % 2 && $len + 4 < length $field) {
# trim the 0/1 byte padding for next even address.
$unpackstr .= ' x'
}
@@ -1227,7 +1220,6 @@
1;
__END__
-
=head1 NAME
Palm::Keyring - Handler for Palm Keyring databases.
@@ -1241,8 +1233,9 @@
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.
+It currently supports the v4 Keyring databases.
+The pre-release v5 databases are mostly supported. There are definitely some
+bugs, For example, t/keyring5.t sometimes fails. I am not sure why yet.
This module doesn't store the decrypted content. It only keeps it until it
returns it to you or encrypts it.
@@ -1258,7 +1251,8 @@
$pdb->Load($file);
foreach (0..$#{ $pdb->{records} }) {
- next if $_ = 0; # skip the password record
+ # skip the password record for version 4 databases
+ next if $_ == 0 && $pdb->{version} == 4;
my $rec = $pdb->{records}->[$_];
my $acct = $pdb->Decrypt($rec, $pass);
print $rec->{name}, ' - ', $acct->{account}, "\n";
@@ -1268,7 +1262,7 @@
=head2 new
- $pdb = new Palm::Keyring([$password]);
+ $pdb = new Palm::Keyring([$password[, $version]]);
Create a new PDB, initialized with the various Palm::Keyring fields
and an empty record list.
@@ -1279,6 +1273,43 @@
If you pass in a password, it will initalize the first record with the encrypted
password.
+new() now also takes options in other formats
+
+ $pdb = new Palm::Keyring({ key1 => value1, key2 => value2 });
+ $pdb = new Palm::Keyring( -key1 => value1, -key2 => value2);
+
+=head3 Supported options are:
+
+=over
+
+=item password
+
+The password used to initialize the database
+
+=item version
+
+The version of database to create. Accepts either 4 or 5. Currently defaults to 4.
+
+=item v4compatible
+
+The format of the fields passed to Encrypt and returned from Decrypt have changed.
+This allows programs to use the newer databases with few changes but with less features.
+
+=item cipher
+
+The cipher to use. 0, 1, 2 or 3.
+
+ 0 => None
+ 1 => DES_EDE3
+ 2 => AES128
+ 3 => AES256
+
+=item iterations
+
+The number of iterations to encrypt with.
+
+=back
+
=head2 Encrypt
$pdb->Encrypt($rec, $acct[, $password]);
@@ -1287,9 +1318,9 @@
used, or with a password that is passed.
$rec is a record from $pdb->{records} or a new_Record().
-$acct is a hashref in the format below.
+The v4 $acct is a hashref in the format below.
- my $acct = {
+ my $v4acct = {
name => $rec->{name},
account => $account,
password => $password,
@@ -1301,6 +1332,39 @@
},
};
+The v5 $acct is an arrayref full of hashrefs that contain each encrypted field.
+
+ my $v5acct = [
+ {
+ 'label_id' => 2,
+ 'data' => 'abcd1234',
+ 'label' => 'password',
+ 'font' => 0
+ },
+ {
+ 'label_id' => 3,
+ 'data' => {
+ 'month' => 1,
+ 'day' => 11,
+ 'year' => 107
+ },
+ 'label' => 'lastchange',
+ 'font' => 0
+ },
+ {
+ 'label_id' => 255,
+ 'data' => 'This is a short note.',
+ 'label' => 'notes',
+ 'font' => 0
+ }
+ ];
+
+
+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';
+
If you have changed anything other than the lastchange, or don't pass in a
lastchange key, Encrypt() will generate a new lastchange date for you.
@@ -1313,16 +1377,17 @@
my $acct = $pdb->Decrypt($rec[, $password]);
-Decrypts the record and returns a hashref for the account as described
+Decrypts the record and returns a reference for the account as described
under Encrypt().
foreach (0..$#{ $pdb->{records}) {
- next if $_ == 0;
+ next if $_ == 0 && $pdb->{version} == 4;
my $rec = $pdb->{records}->[$_];
- my $acct = $pdb->Decrypt($rec[, $password]);
+ my $acct = $pdb->Decrypt($rec);
# do something with $acct
}
+
=head2 Password
$pdb->Password([$password[, $new_password]]);
@@ -1386,6 +1451,9 @@
The Keyring for Palm OS website:
L
+
+The HACKING guide for palm keyring databases:
+L
Johan Vromans also has a wxkeyring app that now uses this module, available
from his website at L