=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.34 retrieving revision 1.65 diff -u -r1.34 -r1.65 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/21 05:24:14 1.34 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2011/09/19 04:23:37 1.65 @@ -1,5 +1,5 @@ package Palm::Keyring; -# $RedRiver: Keyring.pm,v 1.33 2007/02/21 01:26:07 andrew Exp $ +# $RedRiver: Keyring.pm,v 1.62 2008/09/19 06:01:00 andrew Exp $ ######################################################################## # Keyring.pm *** Perl class for Keyring for Palm OS databases. # @@ -15,6 +15,8 @@ use strict; use warnings; +require 5.006_001; + use Carp; use base qw/ Palm::StdAppInfo /; @@ -57,33 +59,66 @@ blocksize => 16, default_iter => 250, }, + { # Only for testing + alias => 'TESTING', + name => 'Testing', + keylen => 0, + blocksize => 0, + default_iter => 0, + }, ); +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_07'; + 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; + $options->{cipher} = shift; + } } # Create a generic PDB. No need to rebless it, though. @@ -107,13 +142,17 @@ # 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->{file} ) { + $self->Load($options->{file}); + } + if ( defined $options->{password} ) { $self->Password($options->{password}); } @@ -132,7 +171,9 @@ sub crypts { my $crypt = shift; - if ($crypt =~ /\D/) { + if ((! defined $crypt) || (! length $crypt)) { + return; + } elsif ($crypt =~ /\D/) { foreach my $c (@CRYPTS) { if ($c->{alias} eq $crypt) { return $c; @@ -145,6 +186,60 @@ } } +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 @@ -152,33 +247,46 @@ my $self = shift; my $rec = $self->SUPER::ParseRecord(@_); - return $rec if ! exists $rec->{data}; + return $rec if !(defined $rec->{data} && length $rec->{data} ); 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; - - $rec->{name} = $field->{data}; - $rec->{ivec} = $ivec; - $rec->{encrypted} = $encrypted; delete $rec->{data}; + $rec->{plaintext}->{0} = $field; + $rec->{ivec} = substr $extra, 0, $blocksize; + $rec->{encrypted} = substr $extra, $blocksize; + } else { - die 'Unsupported Version'; - return; + # XXX Can never get here to test, ParseAppInfoBlock is always run + # XXX first by Load(). + croak "Unsupported Version $self->{version}"; } return $rec; @@ -193,28 +301,40 @@ 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}; - delete $rec->{encrypted}; + my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; + $rec->{data} = join $NULL, $name, $rec->{encrypted}; } - } elsif ($self->{version} == 5) { - my $field = { - 'label_id' => 1, - 'data' => $rec->{name}, - 'font' => 0, - }; - my $packed .= _pack_field($field); + } + elsif ($self->{version} == 5) { + croak 'No encrypted data in record' if !defined $rec->{encrypted}; + croak 'No ivec!' if !$rec->{ivec}; - $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted}; + my $field; + if ($rec->{plaintext}->{0}) { + $field = $rec->{plaintext}->{0}; + } else { + $field = { + 'label' => 'name', + 'label_id' => 0, + 'data' => $EMPTY, + 'font' => 0, + }; + } + my $packed = _pack_field($field); - } else { - die 'Unsupported Version'; + $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted}; + + } + else { + croak "Unsupported Version $self->{version}"; } + # XXX Should I? + #delete $rec->{plaintext}; + #delete $rec->{encrypted}; + croak 'No data in record to pack' if !$rec->{data}; + return $self->SUPER::PackRecord($rec, @_); } @@ -241,11 +361,10 @@ # Nothing extra for version 4 } elsif ($self->{version} == 5) { - _parse_appinfo_v5($appinfo) || return; + _parse_appinfo_v5($appinfo); } else { - die "Unsupported Version"; - return; + croak "Unsupported Version $self->{version}"; } return $appinfo; @@ -255,14 +374,11 @@ { my $appinfo = shift; - if (! exists $appinfo->{other}) { - # XXX Corrupt appinfo? - return; - } + croak 'Corrupt appinfo? no {other}' if ! $appinfo->{other}; 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); @@ -291,8 +407,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}); } @@ -303,7 +418,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; @@ -326,27 +441,15 @@ sub Encrypt { my $self = shift; - my $rec = shift; - my $data = shift; + my $rec = shift || croak('Needed parameter [record] not passed!'); my $pass = shift || $self->{password}; + my $data = shift || $rec->{plaintext}; my $ivec = shift; - if ( ! $pass && ! $self->{appinfo}->{key}) { - croak("password not set!\n"); - } + $self->_password_verify($pass); - if ( ! $rec) { - croak("Needed parameter 'record' not passed!\n"); - } + if ( !$data ) { croak('Needed parameter [plaintext] not passed!'); } - if ( ! $data) { - croak("Needed parameter 'data' not passed!\n"); - } - - if ( $pass && ! $self->Password($pass)) { - croak("Incorrect Password!\n"); - } - my $acct; if ($rec->{encrypted}) { $acct = $self->Decrypt($rec, $pass); @@ -355,60 +458,51 @@ my $encrypted; if ($self->{version} == 4) { $self->{digest} ||= _calc_keys( $pass ); - $encrypted = _encrypt_v4($data, $acct, $self->{digest}); - $rec->{name} ||= $data->{name}; - - } elsif ($self->{version} == 5) { - my @accts = ($data, $acct); - if ($self->{options}->{v4compatible}) { - $rec->{name} ||= $data->{name}; - foreach my $a (@accts) { - my @fields; - foreach my $k (sort keys %{ $a }) { - my $field = { - label => $k, - font => 0, - data => $a->{$k}, - }; - push @fields, $field; - } - $a = \@fields; - } + my $datav4 = { + name => $data->{0}->{data}, + account => $data->{1}->{data}, + password => $data->{2}->{data}, + lastchange => $data->{3}->{data}, + notes => $data->{255}->{data}, + }; + my $acctv4 = {}; + if ($acct) { + $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) { ($encrypted, $ivec) = _encrypt_v5( - @accts, + $data, $acct, $self->{appinfo}->{key}, $self->{appinfo}->{cipher}, $ivec, ); - if (defined $ivec) { - $rec->{ivec} = $ivec; - } + $rec->{ivec} = $ivec if $ivec; } else { - die "Unsupported Version"; + croak "Unsupported Version $self->{version}"; } - if ($encrypted) { - if ($encrypted eq '1') { - return 1; - } + $rec->{plaintext} = $data; + if ($encrypted ne '1') { $rec->{attributes}{Dirty} = 1; $rec->{attributes}{dirty} = 1; $rec->{encrypted} = $encrypted; - - return 1; - } else { - return; } + + return 1; } sub _encrypt_v4 { - require Crypt::CBC; - my $new = shift; my $old = shift; my $digest = shift; @@ -420,6 +514,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}) { @@ -483,101 +578,127 @@ my $key = shift; my $cipher = shift; my $ivec = shift; - my $blocksize = $CRYPTS[ $cipher ]{blocksize}; - my $keylen = $CRYPTS[ $cipher ]{keylen}; - my $cipher_name = $CRYPTS[ $cipher ]{name}; + my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); if (! defined $ivec) { - $ivec = pack("C*",map {rand(256)} 1..$blocksize); + if (!$c->{blocksize}) { + $ivec = $EMPTY; + } + else { + while (! $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} - )) { - $changed = 1; - $need_newdate = 0; + if ($new->{3}->{data}) { + $need_newdate = 0; + } + + if ($old) { + foreach my $k (keys %{ $new }) { + if (! $old->{$k} ) { + $changed = 1; last; + } + if (! $new->{$k}) { + $changed = 1; + last; } + elsif ($k == 3) { + if (! $new->{$k}->{data} && $old->{$k}->{data} ) { + $changed = 1; + last; + } - } elsif ($old && $#{ $new } == $#{ $old }) { - my $n = join ':', %{ $new->[$i] }; - my $o = join ':', %{ $old->[$i] }; - if ($n ne $o) { - $changed = 1; + my %n = %{ $new->{$k}->{data} }; + my %o = %{ $old->{$k}->{data} }; + + foreach (qw( day month year )) { + $n{$_} ||= 0; + $o{$_} ||= 0; + } + + if ( + $n{day} == $o{day} && + $n{month} == $o{month} && + $n{year} == $o{year} + ) { + $need_newdate = 1; + } + else { + $changed = 1; + last; + } + + } + else { + my $n = join ':', sort %{ $new->{$k} }; + my $o = join ':', sort %{ $old->{$k} }; + if ($n ne $o) { + $changed = 1; + last; + } } - } elsif ($#{ $new } != $#{ $old }) { - $changed = 1; } } - if ($old && (! @{ $old }) && $date_index) { - $need_newdate = 0; + else { + $changed = 1; } - return 1, 0 if $changed == 0; + return 1 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; + + #print "CRYPT(e): $c->{name} [$cipher]\n"; 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, - -blocksize => $blocksize, + -cipher => $c->{name}, + -keysize => $c->{keylen}, + -blocksize => $c->{blocksize}, -header => 'none', -padding => 'oneandzeroes', - ); + ) || croak("Unable to set up encryption!"); - if (! $c) { - croak("Unable to set up encryption!"); - } + $encrypted = $cbc->encrypt($plaintext); - $encrypted = $c->encrypt($decrypted); - } else { - die "Unsupported Version"; + croak "Unsupported Crypt $c->{name}"; } return $encrypted, $ivec; @@ -591,48 +712,56 @@ my $rec = shift; my $pass = shift || $self->{password}; - if ( ! $pass && ! $self->{appinfo}->{key}) { - croak("password not set!\n"); - } + if ( ! $rec) { croak('Needed parameter [record] not passed!'); } + if ( ! $rec->{encrypted} ) { croak('No encrypted content!'); } - if ( ! $rec) { - croak("Needed parameter 'record' not passed!\n"); - } + $self->_password_verify($pass); - if ( $pass && ! $self->Password($pass)) { - croak("Invalid Password!\n"); - } - - if ( ! $rec->{encrypted} ) { - 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}"; } - return; + + $rec->{plaintext} = $plaintext; + return $plaintext; } sub _decrypt_v4 @@ -640,12 +769,13 @@ 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) { + #print _hexdump('DATE:', $packed_date); $modified = _parse_keyring_date($packed_date); } @@ -659,58 +789,54 @@ sub _decrypt_v5 { - require Crypt::CBC; my $encrypted = shift; my $key = shift; my $cipher = shift; my $ivec = shift; - my $keylen = $CRYPTS[ $cipher ]{keylen}; - my $cipher_name = $CRYPTS[ $cipher ]{name}; - my $blocksize = $CRYPTS[ $cipher ]{blocksize}; + my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); - my $decrypted; + my $plaintext; - if ($cipher_name eq 'None') { + #print "CRYPT(d): $c->{name} [$cipher]\n"; + 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, - -blocksize => $blocksize, + -cipher => $c->{name}, + -keysize => $c->{keylen}, + -blocksize => $c->{blocksize}, -header => 'none', -padding => 'oneandzeroes', - ); + ) || croak("Unable to set up decryption!"); - if (! $c) { - croak("Unable to set up encryption!"); - } - my $len = $blocksize - length($encrypted) % $blocksize; + my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize}; $encrypted .= $NULL x $len; - $decrypted = $c->decrypt($encrypted); - } else { - die "Unsupported Version"; - return; + $plaintext = $cbc->decrypt($encrypted); + } + else { + croak "Unsupported Crypt $c->{name} in decrypt"; + } - my @fields; - while ($decrypted) { + my %fields; + while ($plaintext) { my $field; - ($field, $decrypted) = _parse_field($decrypted); - if (! $field) { - last; - } - push @fields, $field; + ($field, $plaintext) = _parse_field($plaintext); + last if ! $field; + $fields{ $field->{label_id} } = $field; } - return \@fields; + return \%fields; } # Password @@ -728,75 +854,66 @@ } 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); - if ( ! $acct ) { - croak("Couldn't decrypt $self->{records}->[$i]->{name}"); - } + foreach my $rec (@{ $self->{records} }) { + my $acct = $self->Decrypt($rec, $pass) + || croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); push @accts, $acct; } - if ( ! $self->_password_update($new_pass)) { - croak("Couldn't set new password!"); - } + $self->_password_update($new_pass); $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; + return $self->_password_verify($pass); +} + +sub _password_verify { + my $self = shift; + my $pass = shift; + if (!defined $pass) { + $pass = $self->{password}; } + if ( !$pass ) { + croak("Password not set!\n"); + } + if (defined $self->{password} && $pass eq $self->{password}) { # already verified this password return 1; } 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}); + _password_verify_v4($pass, $self->{encpassword}); - # 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} ) { - $self->{password} = $pass; - return 1; - } - } - } elsif ($self->{version} == 5) { - return _password_verify_v5($pass, $self->{appinfo}); - } else { - # XXX unsupported version + # May as well generate the keys we need now, + # since we know the password is right + $self->{digest} = _calc_keys($pass); + $self->{password} = $pass; + + return 1; + } + elsif ($self->{version} == 5) { + _password_verify_v5($self->{appinfo}, $pass); + $self->{password} = $pass; + return 1; } - return; + croak "Unsupported Version $self->{version}"; } sub _password_verify_v4 @@ -807,11 +924,9 @@ my $pass = shift; my $data = shift; - if (! $pass) { croak('No password specified!'); }; + if (! $pass) { croak('No password specified!'); } + if (! $data) { croak('No encrypted password in file!'); } - # XXX die "No encrypted password in file!" unless defined $data; - if ( ! defined $data) { return; }; - $data =~ s/$NULL$//xm; my $salt = substr $data, 0, $kSalt_Size; @@ -819,10 +934,10 @@ my $msg = $salt . $pass; $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); - my $digest = md5($msg); + my $digest = md5($msg) || croak('MD5 Failed'); if ($data ne $salt . $digest ) { - return; + croak("Incorrect Password!"); } return 1; @@ -830,28 +945,30 @@ 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"; - if ($appinfo->{masterhash} eq $hash) { - $appinfo->{key} = $key; - } else { - return; + if ($appinfo->{masterhash} && $appinfo->{masterhash} ne $hash) { + croak('Incorrect Password'); } - - return $key; + $appinfo->{key} = $key; + return 1; } @@ -867,20 +984,17 @@ if ($self->{version} == 4) { my $data = _password_update_v4($pass, @_); - if (! $data) { - carp("Failed to update password!"); - return; - } + if (! $data) { croak "Failed to update password!"; } # 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} ); return 1; - - } elsif ($self->{version} == 5) { + } + elsif ($self->{version} == 5) { my $cipher = shift || $self->{appinfo}->{cipher}; my $iter = shift || $self->{appinfo}->{iter}; my $salt = shift || 0; @@ -889,17 +1003,14 @@ $self->{appinfo}, $pass, $cipher, $iter, $salt ); - if (! $hash) { - carp("Failed to update password!"); - return; - } + if (! $hash) { croak "Failed to update password!"; } + $self->{password} = $pass; + return 1; - } else { - croak("Unsupported version ($self->{version})"); } - return; + croak "Unsupported Version $self->{version}"; } sub _password_update_v4 @@ -909,7 +1020,7 @@ my $pass = shift; - if (! defined $pass) { croak('No password specified!'); }; + croak('No password specified!') if ! defined $pass; my $salt; for ( 1 .. $kSalt_Size ) { @@ -920,7 +1031,7 @@ $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); - my $digest = md5($msg); + my $digest = md5($msg) || croak('MD5 failed'); my $data = $salt . $digest; # . "\0"; @@ -934,31 +1045,65 @@ my $cipher = shift; my $iter = shift; - # I thought this needed to be 'blocksize', but apparently not. + # I thought $length needed to be 'blocksize', but apparently not. #my $length = $CRYPTS[ $cipher ]{blocksize}; 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}; + + $self->_password_verify($pass); + + 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 { + require Digest::MD5; + import Digest::MD5 qw(md5); + my $pass = shift; if (! defined $pass) { croak('No password defined!'); }; @@ -991,7 +1136,7 @@ import Digest::SHA1 qw(sha1); my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 ); - if ($dop) { $key = DES_odd_parity($key); } + $key = _DES_odd_parity($key) if $dop; my $hash = unpack("H*", substr(sha1($key.$salt),0, 8)); @@ -1053,20 +1198,13 @@ { 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; + return (undef, $field); } my $unpackstr = "x2 C1 C1 A$len"; my $offset = 2 +1 +1 +$len; - if ($len % 2) { # && $len + 4 < length $field) { + if ($len % 2) { # trim the 0/1 byte padding for next even address. $offset++; $unpackstr .= ' x' @@ -1075,13 +1213,21 @@ 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; @@ -1091,29 +1237,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; @@ -1145,7 +1298,7 @@ $year -= 4; $month++; - return pack 'n', $day | ($month << 5) | ($year << 9); + return pack 'n*', $day | ($month << 5) | ($year << 9); } @@ -1156,6 +1309,8 @@ my $maxlines = shift; # Max # of lines to dump my $offset; # Offset of current chunk + my @lines; + for ($offset = 0; $offset < length($data); $offset += 16) { my $hex; # Hex values of the data @@ -1170,8 +1325,9 @@ ($ascii = $chunk) =~ y/\040-\176/./c; - printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii; + push @lines, sprintf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii; } + return wantarray ? @lines : \@lines; } sub _bindump @@ -1181,6 +1337,8 @@ my $maxlines = shift; # Max # of lines to dump my $offset; # Offset of current chunk + my @lines; + for ($offset = 0; $offset < length($data); $offset += 8) { my $bin; # binary values of the data @@ -1195,8 +1353,9 @@ ($ascii = $chunk) =~ y/\040-\176/./c; - printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii; + push @lines, sprintf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii; } + return wantarray ? @lines : \@lines; } # Thanks to Jochen Hoenicke @@ -1208,7 +1367,7 @@ # keylen is length of generated key in bytes # prf is the pseudo random function (e.g. hmac_sha1) # returns the key. -sub _pbkdf2($$$$$) +sub _pbkdf2 { my ($password, $salt, $iter, $keylen, $prf) = @_; my ($k, $t, $u, $ui, $i); @@ -1224,7 +1383,7 @@ return substr($t, 0, $keylen); } -sub DES_odd_parity($) { +sub _DES_odd_parity { my $key = $_[0]; my ($r, $i); my @odd_parity = ( @@ -1262,16 +1421,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 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. +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; @@ -1282,19 +1437,18 @@ my $pdb = new Palm::PDB; $pdb->Load($file); - foreach (0..$#{ $pdb->{records} }) { - # 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"; + $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[, $version]]); + $pdb = new Palm::Keyring([$password[, $version[, $cipher]]]); Create a new PDB, initialized with the various Palm::Keyring fields and an empty record list. @@ -1302,7 +1456,7 @@ 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 @@ -1310,8 +1464,10 @@ $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 @@ -1322,14 +1478,9 @@ 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. +The cipher to use. Either the number or the name. Only used by v5 datbases. 0 => None 1 => DES_EDE3 @@ -1338,16 +1489,35 @@ =item iterations -The number of iterations to encrypt with. +The number of iterations to encrypt with. Only used by somy crypts in v5 databases. +=item file + +The name of a file to Load(). This will override many of the other options. + =back -=head2 crypt +=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: @@ -1355,16 +1525,48 @@ $c = { alias => (None|DES_EDE3|AES128|AES256), name => (None|DES_EDE3|Rijndael), - keylen => , + 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[, $ivec]]); +=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. @@ -1373,73 +1575,76 @@ randomly. $rec is a record from $pdb->{records} or a new_Record(). -The v4 $acct is a hashref in the format below. +$rec->{plaintext} is a hashref in the format below. - my $v4acct = { - 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, }, - }; - -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 + 2 => { + label => 'password', + label_id => 2, + font => 0, + data => $password, }, - { - 'label_id' => 3, - 'data' => { - 'month' => 1, - 'day' => 11, - 'year' => 107 + 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 }, - 'label' => 'lastchange', - 'font' => 0 }, - { - 'label_id' => 255, - 'data' => 'This is a short note.', - 'label' => 'notes', - 'font' => 0 - } - ]; + 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. -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->{plaintext}->{0} => { + label => 'name', + label_id => 0, + font => 0, + data => 'account name', + }; - $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. 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 reference 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 && $pdb->{version} == 4; - my $rec = $pdb->{records}->[$_]; - my $acct = $pdb->Decrypt($rec); - # do something with $acct + foreach my $rec (@{ $pdb->{records} }) { + my $plaintext = $pdb->Decrypt($rec); + # do something with $plaintext } @@ -1456,20 +1661,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 @@ -1480,7 +1798,31 @@ 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