===================================================================
RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v
retrieving revision 1.30
retrieving revision 1.52
diff -u -r1.30 -r1.52
--- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/19 01:37:10 1.30
+++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/12/04 03:33:34 1.52
@@ -1,5 +1,5 @@
package Palm::Keyring;
-# $RedRiver: Keyring.pm,v 1.29 2007/02/19 00:22:42 andrew Exp $
+# $RedRiver: Keyring.pm,v 1.51 2007/09/13 15:46:09 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;
@@ -36,26 +28,30 @@
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,
@@ -63,31 +59,56 @@
},
);
+my %LABELS = (
+ 0 => {
+ id => 0,
+ name => 'name',
+ },
+ 1 => {
+ id => 1,
+ name => 'account',
+ },
+ 2 => {
+ id => 2,
+ name => 'password',
+ },
+ 3 => {
+ id => 3,
+ name => 'lastchange',
+ },
+ 255 => {
+ id => 255,
+ name => 'notes',
+ },
+);
-our $VERSION = 0.95;
+our $VERSION = '0.96_06';
+
sub new
{
my $classname = shift;
my $options = {};
- # hashref arguments
- if (ref $_[0] eq 'HASH') {
- $options = shift;
- }
+ if (@_) {
+ # hashref arguments
+ if (ref $_[0] eq 'HASH') {
+ $options = shift;
+ }
- # CGI style arguments
- elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {
- my %tmp = @_;
- while ( my($key,$value) = each %tmp) {
- $key =~ s/^-//;
- $options->{lc $key} = $value;
- }
- }
+ # CGI style arguments
+ elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {
+ my %tmp = @_;
+ while ( my($key,$value) = each %tmp) {
+ $key =~ s/^-//;
+ $options->{lc $key} = $value;
+ }
+ }
- else {
- $options->{password} = shift;
- $options->{version} = shift;
+ else {
+ $options->{password} = shift;
+ $options->{version} = shift;
+ }
}
# Create a generic PDB. No need to rebless it, though.
@@ -111,11 +132,11 @@
# Set defaults
if ($self->{version} == 5) {
$self->{options}->{cipher} ||= 0; # 'None'
- $self->{options}->{iterations} ||=
- $CRYPTS[ $self->{options}->{cipher} ]{default_iter};
-
- $self->{appinfo}->{cipher} ||= $self->{options}->{cipher};
- $self->{appinfo}->{iter} ||= $self->{options}->{iterations};
+ my $c = crypts($self->{options}->{cipher})
+ 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} ) {
@@ -131,6 +152,80 @@
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];
+ }
+}
+
+sub labels
+{
+ my $label = shift;
+
+ if ((! defined $label) || (! length $label)) {
+ return;
+ } elsif (exists $LABELS{$label}) {
+ return $LABELS{$label};
+ } else {
+ foreach my $l (keys %LABELS) {
+ if ($LABELS{$l}{name} eq $label) {
+ return $LABELS{$l};
+ }
+ }
+
+ # didn't find it, make one.
+ if ($label =~ /^\d+$/) {
+ return {
+ id => $label,
+ name => undef,
+ };
+ } else {
+ return;
+ }
+ }
+}
+
+# Write
+
+sub Write
+{
+ my $self = shift;
+
+ if ($self->{version} == 4) {
+ # Give the PDB the first record that will hold the encrypted password
+ my $rec = $self->new_Record;
+ $rec->{data} = $self->{encpassword};
+
+ if (ref $self->{records} eq 'ARRAY') {
+ unshift @{ $self->{records} }, $rec;
+ } else {
+ $self->{records} = [ $rec ];
+ }
+ }
+
+ my $rc = $self->SUPER::Write(@_);
+
+ if ($self->{version} == 4) {
+ shift @{ $self->{records} };
+ }
+
+ return $rc;
+}
+
# ParseRecord
sub ParseRecord
@@ -142,31 +237,40 @@
if ($self->{version} == 4) {
# skip the first record because it contains the password.
- return $rec if ! exists $self->{records};
+ if (! exists $self->{records}) {
+ $self->{encpassword} = $rec->{data};
+ return '__DELETE_ME__';
+ }
+ if ($self->{records}->[0] eq '__DELETE_ME__') {
+ shift @{ $self->{records} };
+ }
+
my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2;
return $rec if ! $encrypted;
- $rec->{name} = $name;
+ $rec->{plaintext}->{0} = {
+ label => 'name',
+ label_id => 0,
+ data => $name,
+ font => 0,
+ };
$rec->{encrypted} = $encrypted;
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;
- my $encrypted = substr $extra, $blocksize;
+ delete $rec->{data};
- if ($self->{options}->{v4compatible}) {
- $rec->{name} = $field->{data};
- } else {
- $rec->{name} = $field;
- }
- $rec->{ivec} = $ivec;
- $rec->{encrypted} = $encrypted;
+ $rec->{plaintext}->{0} = $field;
+ $rec->{ivec} = substr $extra, 0, $blocksize;
+ $rec->{encrypted} = substr $extra, $blocksize;
} else {
- die 'Unsupported Version';
+ croak "Unsupported Version $self->{version}";
return;
}
@@ -182,38 +286,30 @@
if ($self->{version} == 4) {
if ($rec->{encrypted}) {
- if (! defined $rec->{name}) {
- $rec->{name} = $EMPTY;
- }
- $rec->{data} = join $NULL, $rec->{name}, $rec->{encrypted};
- delete $rec->{name};
+ my $name = $rec->{plaintext}->{0}->{data} || $EMPTY;
+ $rec->{data} = join $NULL, $name, $rec->{encrypted};
+ delete $rec->{plaintext};
delete $rec->{encrypted};
}
} 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};
- }
+ if ($rec->{plaintext}->{0}) {
+ $field = $rec->{plaintext}->{0};
+ } else {
+ $field = {
+ 'label' => 'name',
+ 'label_id' => 0,
+ 'data' => $EMPTY,
+ 'font' => 0,
+ };
}
- my $packed = '';
- if ($field) {
- $packed = _pack_field($field);
- }
- my $len = length $packed;
- my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};
+ my $packed = _pack_field($field);
- $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};
+ $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};
} else {
- die 'Unsupported Version';
+ croak "Unsupported Version $self->{version}";
}
return $self->SUPER::PackRecord($rec, @_);
@@ -245,8 +341,7 @@
_parse_appinfo_v5($appinfo) || return;
} else {
- die "Unsupported Version";
- return;
+ croak "Unsupported Version $self->{version}";
}
return $appinfo;
@@ -263,7 +358,7 @@
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);
@@ -292,8 +387,7 @@
} elsif ($self->{version} == 5) {
_pack_appinfo_v5($self->{appinfo});
} else {
- die "Unsupported Version";
- return;
+ croak "Unsupported Version $self->{version}";
}
return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
}
@@ -304,7 +398,7 @@
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;
@@ -328,8 +422,9 @@
{
my $self = shift;
my $rec = shift;
- my $data = shift;
my $pass = shift || $self->{password};
+ my $data = shift || $rec->{plaintext};
+ my $ivec = shift;
if ( ! $pass && ! $self->{appinfo}->{key}) {
croak("password not set!\n");
@@ -340,7 +435,7 @@
}
if ( ! $data) {
- croak("Needed parameter 'data' not passed!\n");
+ croak("Needed 'plaintext' not passed!\n");
}
if ( $pass && ! $self->Password($pass)) {
@@ -355,42 +450,39 @@
my $encrypted;
if ($self->{version} == 4) {
$self->{digest} ||= _calc_keys( $pass );
- $encrypted = _encrypt_v4($data, $acct, $self->{digest});
- $rec->{name} ||= $data->{name};
+ my $datav4 = {
+ name => $data->{0}->{data},
+ account => $data->{1}->{data},
+ password => $data->{2}->{data},
+ lastchange => $data->{3}->{data},
+ notes => $data->{255}->{data},
+ };
+ my $acctv4 = {
+ name => $acct->{0}->{data},
+ account => $acct->{1}->{data},
+ password => $acct->{2}->{data},
+ lastchange => $acct->{3}->{data},
+ notes => $acct->{255}->{data},
+ };
+ $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});
} elsif ($self->{version} == 5) {
- my @recs = ($data, $acct);
- my $name;
- if ($self->{options}->{v4compatible}) {
- $rec->{name} ||= $data->{name};
- foreach my $rec (@recs) {
- my @fields;
- foreach my $k (sort keys %{ $rec }) {
- my $field = {
- label => $k,
- font => 0,
- data => $rec->{$k},
- };
- push @fields, $field;
- }
- $rec = \@fields;
- }
- }
-
- my $ivec;
($encrypted, $ivec) = _encrypt_v5(
- @recs,
+ $data, $acct,
$self->{appinfo}->{key},
$self->{appinfo}->{cipher},
+ $ivec,
);
- if ($ivec) {
+ if (defined $ivec) {
$rec->{ivec} = $ivec;
}
} else {
- die "Unsupported Version";
+ croak "Unsupported Version $self->{version}";
}
+ $rec->{plaintext}->{0} = $data->{0};
+
if ($encrypted) {
if ($encrypted eq '1') {
return 1;
@@ -419,6 +511,7 @@
my $changed = 0;
my $need_newdate = 0;
if ($old && %{ $old }) {
+ no warnings 'uninitialized';
foreach my $key (keys %{ $new }) {
next if $key eq 'lastchange';
if ($new->{$key} ne $old->{$key}) {
@@ -481,87 +574,82 @@
my $old = shift;
my $key = shift;
my $cipher = shift;
- my $length = $CRYPTS[ $cipher ]{blocksize};
- my $ivec = shift || pack("C*",map {rand(256)} 1..$length);
+ my $ivec = shift;
+ my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
- my $keylen = $CRYPTS[ $cipher ]{keylen};
- my $cipher_name = $CRYPTS[ $cipher ]{name};
+ if (! defined $ivec) {
+ $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) ||
- (exists $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}->{month} != $old->[$i]->{data}->{month} ||
- $new->[$i]->{data}->{year} != $old->[$i]->{data}->{year}
+ if ($new->{3}->{data}) {
+ $need_newdate = 0;
+ }
+ foreach my $k (keys %{ $new }) {
+ if (! $old) {
+ $changed = 1;
+ } elsif ($k == 3) {
+ if ($old && (
+ $new->{$k}{data}{day} == $old->{$k}{data}{day} &&
+ $new->{$k}{data}{month} == $old->{$k}{data}{month} &&
+ $new->{$k}{data}{year} == $old->{$k}{data}{year}
)) {
$changed = 1;
- $need_newdate = 0;
- last;
+ $need_newdate = 1;
}
- } elsif ($old && $#{ $new } == $#{ $old }) {
- my $n = join ':', %{ $new->[$i] };
- my $o = join ':', %{ $old->[$i] };
+ } else {
+ my $n = join ':', sort %{ $new->{$k} };
+ my $o = join ':', sort %{ $old->{$k} };
if ($n ne $o) {
$changed = 1;
}
- } elsif ($#{ $new } != $#{ $old }) {
- $changed = 1;
}
}
- if ($old && (! @{ $old }) && $date_index) {
- $need_newdate = 0;
- }
return 1, 0 if $changed == 0;
- if ($need_newdate || ! defined $date_index) {
+ if ($need_newdate) {
my ($day, $month, $year) = (localtime)[3,4,5];
- my $date = {
- year => $year,
- month => $month,
- day => $day,
+ $new->{3} = {
+ label => 'lastchange',
+ label_id => 3,
+ font => 0,
+ data => {
+ year => $year,
+ month => $month,
+ day => $day,
+ },
};
- if (defined $date_index) {
- $new->[$date_index]->{data} = $date;
- } else {
- push @{ $new }, {
- label => 'lastchange',
- font => 0,
- data => $date,
- };
- }
} else {
# XXX Need to actually validate the above information somehow
- if ($new->[$date_index]->{data}->{year} >= 1900) {
- $new->[$date_index]->{data}->{year} -= 1900;
+ if ($new->{3}->{data}->{year} >= 1900) {
+ $new->{3}->{data}->{year} -= 1900;
}
}
- my $decrypted;
- foreach my $field (@{ $new }) {
- $decrypted .= _pack_field($field);
+ my $plaintext;
+ foreach my $k (keys %{ $new }) {
+ next if $new->{$k}->{label_id} == 0;
+ $plaintext .= _pack_field($new->{$k});
}
+ #$plaintext .= chr(0xff) x 2;
my $encrypted;
- if ($cipher_name eq 'None') {
+ if ($c->{name} eq 'None') {
# do nothing
- $encrypted = $decrypted;
+ $encrypted = $plaintext;
- } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {
- my $c = Crypt::CBC->new(
- -literal_key => 1,
+ } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
+ require Crypt::CBC;
+ my $cbc = Crypt::CBC->new(
-key => $key,
+ -literal_key => 1,
-iv => $ivec,
- -cipher => $cipher_name,
- -keysize => $keylen,
+ -cipher => $c->{name},
+ -keysize => $c->{keylen},
+ -blocksize => $c->{blocksize},
-header => 'none',
-padding => 'oneandzeroes',
);
@@ -570,10 +658,10 @@
croak("Unable to set up encryption!");
}
- $encrypted = $c->encrypt($decrypted);
+ $encrypted = $cbc->encrypt($plaintext);
} else {
- die "Unsupported Version";
+ croak "Unsupported Crypt $c->{name}";
}
return $encrypted, $ivec;
@@ -581,7 +669,7 @@
# Decrypt
-sub Decrypt
+sub Decrypt
{
my $self = shift;
my $rec = shift;
@@ -603,31 +691,53 @@
croak("No encrypted content!");
}
+ my $plaintext;
if ($self->{version} == 4) {
$self->{digest} ||= _calc_keys( $pass );
my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
- $acct->{name} ||= $rec->{name};
- return $acct;
+ $plaintext = {
+ 0 => $rec->{plaintext}->{0},
+ 1 => {
+ label => 'account',
+ label_id => 1,
+ font => 0,
+ data => $acct->{account},
+ },
+ 2 => {
+ label => 'password',
+ label_id => 2,
+ font => 0,
+ data => $acct->{password},
+ },
+ 3 => {
+ label => 'lastchange',
+ label_id => 3,
+ font => 0,
+ data => $acct->{lastchange},
+ },
+ 255 => {
+ label => 'notes',
+ label_id => 255,
+ font => 0,
+ data => $acct->{notes},
+ },
+ };
} elsif ($self->{version} == 5) {
- my $fields = _decrypt_v5(
+ $plaintext = _decrypt_v5(
$rec->{encrypted}, $self->{appinfo}->{key},
$self->{appinfo}->{cipher}, $rec->{ivec},
);
- if ($self->{options}->{v4compatible}) {
- my %acct;
- foreach my $f (@{ $fields }) {
- $acct{ $f->{label} } = $f->{data};
- }
- $acct{name} ||= $rec->{name};
- return \%acct;
- } else {
- return $fields;
- }
+ $plaintext->{0} ||= $rec->{plaintext}->{0};
} else {
- die "Unsupported Version";
+ croak "Unsupported Version $self->{version}";
}
+
+ if ($plaintext) {
+ $rec->{plaintext} = $plaintext;
+ return $plaintext;
+ }
return;
}
@@ -636,9 +746,9 @@
my $encrypted = shift;
my $digest = shift;
- my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );
+ my $plaintext = _crypt3des( $encrypted, $digest, $DECRYPT );
my ( $account, $password, $notes, $packed_date )
- = split /$NULL/xm, $decrypted, 4;
+ = split /$NULL/xm, $plaintext, 4;
my $modified;
if ($packed_date) {
@@ -655,27 +765,29 @@
sub _decrypt_v5
{
+
my $encrypted = shift;
my $key = shift;
my $cipher = shift;
my $ivec = shift;
- my $keylen = $CRYPTS[ $cipher ]{keylen};
- my $cipher_name = $CRYPTS[ $cipher ]{name};
+ my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
- my $decrypted;
+ my $plaintext;
- if ($cipher_name eq 'None') {
+ if ($c->{name} eq 'None') {
# do nothing
- $decrypted = $encrypted;
+ $plaintext = $encrypted;
- } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {
- my $c = Crypt::CBC->new(
- -literal_key => 1,
+ } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
+ require Crypt::CBC;
+ my $cbc = Crypt::CBC->new(
-key => $key,
+ -literal_key => 1,
-iv => $ivec,
- -cipher => $cipher_name,
- -keysize => $keylen,
+ -cipher => $c->{name},
+ -keysize => $c->{keylen},
+ -blocksize => $c->{blocksize},
-header => 'none',
-padding => 'oneandzeroes',
);
@@ -683,25 +795,25 @@
if (! $c) {
croak("Unable to set up encryption!");
}
- $encrypted .= $NULL x $keylen; # pad out a keylen
- $decrypted = $c->decrypt($encrypted);
+ my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};
+ $encrypted .= $NULL x $len;
+ $plaintext = $cbc->decrypt($encrypted);
} else {
- die "Unsupported Version";
- return;
+ croak "Unsupported Crypt $c->{name}";
}
- my @fields;
- while ($decrypted) {
+ my %fields;
+ while ($plaintext) {
my $field;
- ($field, $decrypted) = _parse_field($decrypted);
+ ($field, $plaintext) = _parse_field($plaintext);
if (! $field) {
last;
}
- push @fields, $field;
+ $fields{ $field->{label_id} } = $field;
}
- return \@fields;
+ return \%fields;
}
# Password
@@ -719,30 +831,18 @@
}
if (
- ($self->{version} == 4 && ! exists $self->{records}) ||
+ ($self->{version} == 4 && ! exists $self->{encpassword}) ||
($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash})
) {
- if ($self->{version} == 4) {
- # Give the PDB the first record that will hold the encrypted password
- $self->{records} = [ $self->new_Record ];
- }
-
return $self->_password_update($pass);
}
if ($new_pass) {
- my $v4compat = $self->{options}->{v4compatible};
- $self->{options}->{v4compatible} = 0;
-
my @accts = ();
- foreach my $i (0..$#{ $self->{records} }) {
- if ($self->{version} == 4 && $i == 0) {
- push @accts, undef;
- next;
- }
- my $acct = $self->Decrypt($self->{records}->[$i], $pass);
+ foreach my $rec (@{ $self->{records} }) {
+ my $acct = $self->Decrypt($rec, $pass);
if ( ! $acct ) {
- croak("Couldn't decrypt $self->{records}->[$i]->{name}");
+ croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");
}
push @accts, $acct;
}
@@ -753,14 +853,10 @@
$pass = $new_pass;
foreach my $i (0..$#accts) {
- if ($self->{version} == 4 && $i == 0) {
- next;
- }
delete $self->{records}->[$i]->{encrypted};
- $self->Encrypt($self->{records}->[$i], $accts[$i], $pass);
+ $self->{records}->[$i]->{plaintext} = $accts[$i];
+ $self->Encrypt($self->{records}->[$i], $pass);
}
-
- $self->{options}->{v4compatible} = $v4compat;
}
if (defined $self->{password} && $pass eq $self->{password}) {
@@ -769,11 +865,10 @@
}
if ($self->{version} == 4) {
- # AFAIK the thing we use to test the password is
- # always in the first entry
- my $valid = _password_verify_v4($pass, $self->{records}->[0]->{data});
+ my $valid = _password_verify_v4($pass, $self->{encpassword});
- # May as well generate the keys we need now, since we know the password is right
+ # May as well generate the keys we need now,
+ # since we know the password is right
if ($valid) {
$self->{digest} = _calc_keys($pass);
if ($self->{digest} ) {
@@ -782,9 +877,9 @@
}
}
} elsif ($self->{version} == 5) {
- return _password_verify_v5($pass, $self->{appinfo});
+ return _password_verify_v5($self->{appinfo}, $pass);
} else {
- # XXX unsupported version
+ croak "Unsupported version $self->{version}";
}
return;
@@ -792,6 +887,9 @@
sub _password_verify_v4
{
+ require Digest::MD5;
+ import Digest::MD5 qw(md5);
+
my $pass = shift;
my $data = shift;
@@ -809,7 +907,7 @@
my $digest = md5($msg);
- if (! $data eq $salt . $digest ) {
+ if ($data ne $salt . $digest ) {
return;
}
@@ -818,18 +916,22 @@
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},
- $CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity},
+ $c->{keylen},
+ $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";
@@ -862,7 +964,7 @@
# AFAIK the thing we use to test the password is
# always in the first entry
- $self->{records}->[0]->{data} = $data;
+ $self->{encpassword} = $data;
$self->{password} = $pass;
$self->{digest} = _calc_keys( $self->{password} );
@@ -892,6 +994,9 @@
sub _password_update_v4
{
+ require Digest::MD5;
+ import Digest::MD5 qw(md5);
+
my $pass = shift;
if (! defined $pass) { croak('No password specified!'); };
@@ -924,23 +1029,57 @@
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},
- $CRYPTS[ $cipher ]->{DES_odd_parity},
+ $c->{keylen},
+ $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;
}
+sub Unlock
+{
+ my $self = shift;
+ my ($pass) = @_;
+ $pass ||= $self->{password};
+ if ( $pass && ! $self->Password($pass)) {
+ croak("Invalid Password!\n");
+ }
+
+ foreach my $rec (@{ $self->{records} }) {
+ $self->Decrypt($rec);
+ }
+
+ return 1;
+
+}
+
+sub Lock
+{
+ my $self = shift;
+
+ $self->Password();
+
+ foreach my $rec (@{ $self->{records} }) {
+ my $name = $rec->{plaintext}->{0};
+ delete $rec->{plaintext};
+ $rec->{plaintext}->{0} = $name;
+ }
+
+ return 1;
+}
+
+# Helpers
+
sub _calc_keys
{
my $pass = shift;
@@ -969,8 +1108,13 @@
{
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); }
+ if ($dop) { $key = _DES_odd_parity($key); }
my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
@@ -979,6 +1123,8 @@
sub _crypt3des
{
+ require Crypt::DES;
+
my ( $plaintext, $passphrase, $flag ) = @_;
$passphrase .= $SPACE x ( 16 * 3 );
@@ -1030,34 +1176,36 @@
{
my $field = shift;
- my @labels;
- $labels[0] = 'name';
- $labels[1] = 'account';
- $labels[2] = 'password';
- $labels[3] = 'lastchange';
- $labels[255] = 'notes';
-
- my ($len) = unpack "S1", $field;
+ my ($len) = unpack "n", $field;
if ($len + 4 > length $field) {
return undef, $field;
}
- my $unpackstr = "S1 C1 C1 A$len";
- if ($len % 2 && $len + 4 < length $field) {
+ my $unpackstr = "x2 C1 C1 A$len";
+ my $offset = 2 +1 +1 +$len;
+ if ($len % 2) {
# trim the 0/1 byte padding for next even address.
+ $offset++;
$unpackstr .= ' x'
}
- $unpackstr .= ' A*';
- my (undef, $label, $font, $data, $leftover)
- = unpack $unpackstr, $field;
+ my ($label, $font, $data) = unpack $unpackstr, $field;
+ my $leftover = substr $field, $offset;
- if ($label == 3) {
+ my $label_id = $label;
+ my $l = labels($label);
+ if ($l) {
+ $label = $l->{name} || $l->{id};
+ $label_id = $l->{id};
+ }
+
+ if ($label_id && $label_id == 3) {
+ ($data) = substr $field, 4, $len;
$data = _parse_keyring_date($data);
}
return {
#len => $len,
- label => $labels[ $label ] || $label,
- label_id => $label,
+ label => $label,
+ label_id => $label_id,
font => $font,
data => $data,
}, $leftover;
@@ -1067,29 +1215,36 @@
{
my $field = shift;
- my %labels = (
- name => 0,
- account => 1,
- password => 2,
- lastchange => 3,
- notes => 255,
- );
+ my $packed;
+ if (defined $field) {
+ my $label = $field->{label_id} || 0;
+ if (defined $field->{label} && ! $label) {
+ $label = $field->{label};
+ }
- my $label = $field->{label_id} || $labels{ $field->{label} };
- my $font = $field->{font} || 0;
- my $data = $field->{data} || '';
+ my $l = labels($field->{label});
+ if ($l) {
+ $label = $l->{id};
+ }
- if ($label == 3) {
- $data = _pack_keyring_date($data);
- }
- my $len = length $data;
- my $packstr = "S1 C1 C1 A*";
+ my $font = $field->{font} || 0;
+ my $data = defined $field->{data} ? $field->{data} : $EMPTY;
- my $packed = pack $packstr, ($len, $label, $font, $data);
+ if ($label && $label == 3) {
+ $data = _pack_keyring_date($data);
+ }
+ my $len = length $data;
+ my $packstr = "n1 C1 C1 A*";
- if ($len % 2) {
- # add byte padding for next even address.
- $packed .= $NULL;
+ $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;
@@ -1121,7 +1276,7 @@
$year -= 4;
$month++;
- return pack 'n', $day | ($month << 5) | ($year << 9);
+ return pack 'n*', $day | ($month << 5) | ($year << 9);
}
@@ -1200,7 +1355,7 @@
return substr($t, 0, $keylen);
}
-sub DES_odd_parity($) {
+sub _DES_odd_parity($) {
my $key = $_[0];
my ($r, $i);
my @odd_parity = (
@@ -1228,7 +1383,6 @@
1;
__END__
-
=head1 NAME
Palm::Keyring - Handler for Palm Keyring databases.
@@ -1239,15 +1393,12 @@
parses Keyring for Palm OS databases. See
L.
-It has the standard Palm::PDB methods with 2 additional public methods.
-Decrypt and Encrypt.
+It has the standard Palm::PDB methods with 4 additional public methods.
+Unlock, Lock, 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 as well as
+the pre-release v5 databases.
-This module doesn't store the decrypted content. It only keeps it until it
-returns it to you or encrypts it.
-
=head1 SYNOPSIS
use Palm::PDB;
@@ -1258,18 +1409,18 @@
my $pdb = new Palm::PDB;
$pdb->Load($file);
- foreach (0..$#{ $pdb->{records} }) {
- next if $_ = 0; # skip the password record
- my $rec = $pdb->{records}->[$_];
- my $acct = $pdb->Decrypt($rec, $pass);
- print $rec->{name}, ' - ', $acct->{account}, "\n";
+ $pdb->Unlock($pass);
+ foreach my $rec (@{ $pdb->{records} }) {
+ print $rec->{plaintext}->{0}->{data}, ' - ',
+ $rec->{plaintext}->{1}->{data}, "\n";
}
+ $pdb->Lock();
=head1 SUBROUTINES/METHODS
=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.
@@ -1277,53 +1428,194 @@
Use this method if you're creating a Keyring PDB from scratch otherwise you
can just use Palm::PDB::new() before calling Load().
-If you pass in a password, it will initalize the first record with the encrypted
+If you pass in a password, it will initalize the database 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);
+
+=over
+
+=item Supported options
+
+=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 cipher
+
+The cipher to use. Either the number or the name. Only used by v5 datbases.
+
+ 0 => None
+ 1 => DES_EDE3
+ 2 => AES128
+ 3 => AES256
+
+=item iterations
+
+The number of iterations to encrypt with. Only used by somy crypts in v5 databases.
+
+=back
+
+=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
+ 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 => ,
+ blocksize => ,
+ default_iter => ,
+ };
+
+If it is unable to find the crypt it will return undef.
+
+=head2 labels
+
+Pass in the id or the name of the label. The label id is used as a key
+to the different parts of the records.
+See Encrypt() for details on where the label is used.
+
+This is a function, not a method.
+
+ my $l = Palm::Keyring::labels($label);
+
+$l is now:
+
+ $l = {
+ id => 0,
+ name => 'name',
+ };
+
+If what you passed in was a number that doesn't have a name, it will return:
+
+ $l => {
+ id => $num_passed_in,
+ name => undef,
+ }
+
+If you pass in a name that it can't find, then it returns undef.
+
=head2 Encrypt
- $pdb->Encrypt($rec, $acct[, $password]);
+=head3 B The order of the arguments to Encrypt has
+changed. $password and $plaintext used to be swapped. They changed
+because you can now set $rec->{plaintext} and not pass in $plaintext so
+$password is more important.
+ $pdb->Encrypt($rec[, $password[, $plaintext[, $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().
-$acct is a hashref in the format below.
+$rec->{plaintext} is a hashref in the format below.
- my $acct = {
- name => $rec->{name},
- account => $account,
- password => $password,
- notes => $notes,
- lastchange => {
- year => 107, # years since 1900
- month => 0, # 0-11, 0 = January, 11 = December
- day => 30, # 1-31, same as localtime
+ $plaintext = {
+ 0 => {
+ label => 'name',
+ label_id => 0,
+ font => 0,
+ data => $name,
+ 1 => {
+ label => 'account',
+ label_id => 1,
+ font => 0,
+ data => $account,
},
+ 2 => {
+ label => 'password',
+ label_id => 2,
+ font => 0,
+ data => $password,
+ },
+ 3 => {
+ label => 'lastchange',
+ label_id => 3,
+ font => 0,
+ data => {
+ year => $year, # usually the year - 1900
+ mon => $mon, # range 0-11
+ day => $day, # range 1-31
+ },
+ },
+ 255 => {
+ label => 'notes',
+ label_id => 255,
+ font => 0,
+ data => $notes,
+ },
};
+The account name is stored in $rec->{plaintext}->{0}->{data} for both v4
+and v5 databases even when the record has not been Decrypt()ed.
+
+ $rec->{plaintext}->{0} => {
+ label => 'name',
+ label_id => 0,
+ font => 0,
+ data => '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.
If you pass in a lastchange field that is different than the one in the
record, it will honor what you passed in.
-Encrypt() only uses the $acct->{name} if there is not already a $rec->{name}.
+You can either set $rec->{plaintext} or pass in $plaintext. $plaintext
+is used over anything in $rec->{plaintext}.
+
=head2 Decrypt
- my $acct = $pdb->Decrypt($rec[, $password]);
+ my $plaintext = $pdb->Decrypt($rec[, $password]);
-Decrypts the record and returns a hashref for the account as described
-under Encrypt().
+Decrypts the record and returns a reference for the plaintext account as
+described under Encrypt().
+Also sets $rec->{plaintext} with the same information as $plaintext as
+described in Encrypt().
- foreach (0..$#{ $pdb->{records}) {
- next if $_ == 0;
- my $rec = $pdb->{records}->[$_];
- my $acct = $pdb->Decrypt($rec[, $password]);
- # do something with $acct
+ foreach my $rec (@{ $pdb->{records} }) {
+ my $plaintext = $pdb->Decrypt($rec);
+ # do something with $plaintext
}
+
=head2 Password
$pdb->Password([$password[, $new_password]]);
@@ -1337,20 +1629,133 @@
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;
+ $pdb->{encpassword} = the password as stored in the pdb;
+
+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 Unlock
+
+ $pdb->Unlock([$password]);
+
+Decrypts all the records. Sets $rec->{plaintext} for all records.
+
+This makes it easy to show all decrypted information.
+
+ my $pdb = Palm::KeyRing->new();
+ $pdb->Load($keyring_file);
+ $pdb->Unlock($password);
+ foreach my $plaintext (map { $_->{plaintext} } @{ $pdb->{records} }) {
+ # Do something like display the account.
+ }
+ $pdb->Lock();
+
+=head2 Lock
+
+ $pdb->Lock();
+
+Unsets $rec->{plaintext} for all records and unsets the saved password.
+
+This does NOT Encrypt() any of the records before clearing them, so if
+you are not careful you will lose information.
+
+B This only does "delete $rec->{plaintext}" and the same for the
+password. If someone knows of a cross platform reliable way to make
+sure that the information is actually cleared from memory I would
+appreciate it. Also, if someone knows how to make sure that the stuff
+in $rec->{plaintext} is not written to swap, that would be very handy as
+well.
+
+=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
+ };
+
+For v4 databases it also removes record 0 and moves the encrypted password
+to $self->{encpassword}.
+
+=item PackRecord
+
+Reverses ParseRecord and then sends it through Palm::StdAppInfo::PackRecord()
+
+=item Write
+
+For v4 databases it puts back the record 0 for the encrypted password before
+writing it.
+
+=back
+
=head1 DEPENDENCIES
Palm::StdAppInfo
+B
+
Digest::MD5
Crypt::DES
-Readonly
+B
+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
-and helped me get my first module posted. L
+I would like to thank the helpful Perlmonk shigetsu who gave me some great
+advice and helped me get my first module posted.
+L
I would also like to thank
Johan Vromans
@@ -1361,8 +1766,32 @@
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 Ehoenicke@gmail.comE
+(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.
+
+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.
+
+This module does not do anything special with the plaintext data. It SHOULD
+treat it somehow special so that it can't be found in RAM or in a swap file
+anywhere. I don't have a clue how to do this.
+
+I need to fix all this before it is a 1.0 candidate.
+
Please report any bugs or feature requests to
C, or through the web interface at
L. I will be notified, and then you'll automatically be
@@ -1387,6 +1816,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