=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.28 retrieving revision 1.34 diff -u -r1.28 -r1.34 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/18 05:50:25 1.28 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/21 05:24:14 1.34 @@ -1,5 +1,5 @@ package Palm::Keyring; -# $RedRiver: Keyring.pm,v 1.27 2007/02/10 16:21:28 andrew Exp $ +# $RedRiver: Keyring.pm,v 1.33 2007/02/21 01:26:07 andrew Exp $ ######################################################################## # Keyring.pm *** Perl class for Keyring for Palm OS databases. # @@ -19,13 +19,6 @@ 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; @@ -35,26 +28,34 @@ 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, + default_iter => 250, }, ); @@ -72,7 +73,7 @@ } # CGI style arguments - elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) { + elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) { my %tmp = @_; while ( my($key,$value) = each %tmp) { $key =~ s/^-//; @@ -103,6 +104,16 @@ # Set options $self->{options} = $options; + # 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}; + }; + if ( defined $options->{password} ) { $self->Password($options->{password}); } @@ -116,8 +127,26 @@ return 1; } -# PackRecord +# Accessors +sub crypts +{ + my $crypt = shift; + if ($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 { my $self = shift; @@ -137,42 +166,24 @@ delete $rec->{data}; } elsif ($self->{version} == 5) { - my $blocksize = $self->{appinfo}->{blocksize}; + 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; + delete $rec->{data}; } else { - # XXX Unsupported version! + die 'Unsupported Version'; return; } return $rec; } -sub _parse_keyring_date -{ - my $data = shift; - - my $u = unpack 'n', $data; - my $year = (($u & 0xFE00) >> 9) + 4; # since 1900 - my $month = (($u & 0x01E0) >> 5) - 1; # 0-11 - my $day = (($u & 0x001F) >> 0); # 1-31 - - return { - year => $year, - month => $month || 0, - day => $day || 1, - }; -} - # PackRecord sub PackRecord @@ -189,29 +200,24 @@ delete $rec->{name}; delete $rec->{encrypted}; } + } elsif ($self->{version} == 5) { - # XXX do something + my $field = { + 'label_id' => 1, + 'data' => $rec->{name}, + 'font' => 0, + }; + my $packed .= _pack_field($field); + + $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted}; + } else { - # XXX Unsupported version! - return; + die 'Unsupported Version'; } return $self->SUPER::PackRecord($rec, @_); } -sub _pack_keyring_date -{ - my $d = shift; - my $year = $d->{year}; - my $month = $d->{month}; - my $day = $d->{day}; - - $year -= 4; - $month++; - - return pack 'n', $day | ($month << 5) | ($year << 9); -} - # ParseAppInfoBlock sub ParseAppInfoBlock @@ -238,7 +244,7 @@ _parse_appinfo_v5($appinfo) || return; } else { - # XXX Unknown version + die "Unsupported Version"; return; } @@ -266,10 +272,6 @@ $appinfo->{salt} = sprintf "%02x" x 8, @salt; $appinfo->{iter} = $iter; $appinfo->{cipher} = $cipher; - $appinfo->{keylen} = $CRYPTS[$appinfo->{cipher}]{keylen}; - $appinfo->{blocksize} = $CRYPTS[$appinfo->{cipher}]{blocksize}; - $appinfo->{DES_odd_parity} = $CRYPTS[$appinfo->{cipher}]{DES_odd_parity}; - $appinfo->{cipher_name} = $CRYPTS[$appinfo->{cipher}]{name}; $appinfo->{masterhash} = sprintf "%02x" x 8, @hash; delete $appinfo->{other}; @@ -287,15 +289,38 @@ # Nothing to do for v4 } elsif ($self->{version} == 5) { - croak("Unsupported version!"); - #$self->{appinfo}{other} = ; + _pack_appinfo_v5($self->{appinfo}); } else { - # XXX Unknown version + die "Unsupported Version"; return; } return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo}); } +sub _pack_appinfo_v5 +{ + my $appinfo = shift; + + my $packstr + = ("C1" x 8) # 8 uint8s in an array for the salt + . ("S1" 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; + my @hash = map { hex $_ } $appinfo->{masterhash} =~ /../gxm; + + my $packed = pack($packstr, + @salt, + $appinfo->{iter}, + $appinfo->{cipher}, + @hash + ); + + $appinfo->{other} = $packed; + + return $appinfo +} + # Encrypt sub Encrypt @@ -304,8 +329,9 @@ my $rec = shift; my $data = shift; my $pass = shift || $self->{password}; + my $ivec = shift; - if ( ! $pass && ! $self->{key}) { + if ( ! $pass && ! $self->{appinfo}->{key}) { croak("password not set!\n"); } @@ -317,60 +343,94 @@ croak("Needed parameter 'data' not passed!\n"); } - if ( ! $self->Password($pass)) { + if ( $pass && ! $self->Password($pass)) { croak("Incorrect Password!\n"); } + my $acct; + if ($rec->{encrypted}) { + $acct = $self->Decrypt($rec, $pass); + } + + my $encrypted; if ($self->{version} == 4) { $self->{digest} ||= _calc_keys( $pass ); - my $acct = {}; - if ($rec->{encrypted}) { - $acct = $self->Decrypt($rec, $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 $encrypted = _encrypt_v4($data, $self->{digest}, $acct); - if ($encrypted) { - $rec->{attributes}{Dirty} = 1; - $rec->{attributes}{dirty} = 1; - $rec->{name} ||= $data->{name}; - $rec->{encrypted} = $encrypted; + + ($encrypted, $ivec) = _encrypt_v5( + @accts, + $self->{appinfo}->{key}, + $self->{appinfo}->{cipher}, + $ivec, + ); + if (defined $ivec) { + $rec->{ivec} = $ivec; + } + + } else { + die "Unsupported Version"; + } + + if ($encrypted) { + if ($encrypted eq '1') { return 1; } - } elsif ($self->{version} == 5) { - croak("Unsupported version!"); - return _encrypt_v5( - $rec->{encrypted}, $rec->{ivec}, $self->{key}, - $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name}, - ); + + $rec->{attributes}{Dirty} = 1; + $rec->{attributes}{dirty} = 1; + $rec->{encrypted} = $encrypted; + + return 1; } else { - # XXX Unsupported version! + return; } - return; } sub _encrypt_v4 { - my $data = shift; + require Crypt::CBC; + + my $new = shift; + my $old = shift; my $digest = shift; - my $acct = shift; - $data->{account} ||= $EMPTY; - $data->{password} ||= $EMPTY; - $data->{notes} ||= $EMPTY; + $new->{account} ||= $EMPTY; + $new->{password} ||= $EMPTY; + $new->{notes} ||= $EMPTY; my $changed = 0; my $need_newdate = 0; - if (%{ $acct }) { - foreach my $key (keys %{ $data }) { + if ($old && %{ $old }) { + foreach my $key (keys %{ $new }) { next if $key eq 'lastchange'; - if ($data->{$key} ne $acct->{$key}) { + if ($new->{$key} ne $old->{$key}) { $changed = 1; last; } } - if ( exists $data->{lastchange} && exists $acct->{lastchange} && ( - $data->{lastchange}->{day} != $acct->{lastchange}->{day} || - $data->{lastchange}->{month} != $acct->{lastchange}->{month} || - $data->{lastchange}->{year} != $acct->{lastchange}->{year} + if ( exists $new->{lastchange} && exists $old->{lastchange} && ( + $new->{lastchange}->{day} != $old->{lastchange}->{day} || + $new->{lastchange}->{month} != $old->{lastchange}->{month} || + $new->{lastchange}->{year} != $old->{lastchange}->{year} )) { $changed = 1; $need_newdate = 0; @@ -387,10 +447,10 @@ my ($day, $month, $year); - if ($data->{lastchange} && ! $need_newdate ) { - $day = $data->{lastchange}->{day} || 1; - $month = $data->{lastchange}->{month} || 0; - $year = $data->{lastchange}->{year} || 0; + if ($new->{lastchange} && ! $need_newdate ) { + $day = $new->{lastchange}->{day} || 1; + $month = $new->{lastchange}->{month} || 0; + $year = $new->{lastchange}->{year} || 0; # XXX Need to actually validate the above information somehow if ($year >= 1900) { @@ -404,27 +464,134 @@ ($day, $month, $year) = (localtime)[3,4,5]; } - my $packeddate = _pack_keyring_date( { + my $packed_date = _pack_keyring_date( { year => $year, month => $month, day => $day, }); my $plaintext = join $NULL, - $data->{account}, $data->{password}, $data->{notes}, $packeddate; + $new->{account}, $new->{password}, $new->{notes}, $packed_date; return _crypt3des( $plaintext, $digest, $ENCRYPT ); } +sub _encrypt_v5 +{ + my $new = shift; + my $old = shift; + 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}; + + if (! defined $ivec) { + $ivec = pack("C*",map {rand(256)} 1..$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; + last; + } + + } elsif ($old && $#{ $new } == $#{ $old }) { + my $n = join ':', %{ $new->[$i] }; + my $o = join ':', %{ $old->[$i] }; + 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) { + my ($day, $month, $year) = (localtime)[3,4,5]; + my $date = { + 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; + } + } + + my $decrypted; + foreach my $field (@{ $new }) { + $decrypted .= _pack_field($field); + } + my $encrypted; + if ($cipher_name eq 'None') { + # do nothing + $encrypted = $decrypted; + + } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') { + my $c = Crypt::CBC->new( + -literal_key => 1, + -key => $key, + -iv => $ivec, + -cipher => $cipher_name, + -keysize => $keylen, + -blocksize => $blocksize, + -header => 'none', + -padding => 'oneandzeroes', + ); + + if (! $c) { + croak("Unable to set up encryption!"); + } + + $encrypted = $c->encrypt($decrypted); + + } else { + die "Unsupported Version"; + } + + return $encrypted, $ivec; +} + # Decrypt -sub Decrypt +sub Decrypt { my $self = shift; my $rec = shift; my $pass = shift || $self->{password}; - if ( ! $pass && ! $self->{key}) { + if ( ! $pass && ! $self->{appinfo}->{key}) { croak("password not set!\n"); } @@ -432,7 +599,7 @@ croak("Needed parameter 'record' not passed!\n"); } - if ( ! $self->Password($pass)) { + if ( $pass && ! $self->Password($pass)) { croak("Invalid Password!\n"); } @@ -445,10 +612,11 @@ my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest}); $acct->{name} ||= $rec->{name}; return $acct; + } elsif ($self->{version} == 5) { my $fields = _decrypt_v5( - $rec->{encrypted}, $rec->{ivec}, $self->{key}, - $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name}, + $rec->{encrypted}, $self->{appinfo}->{key}, + $self->{appinfo}->{cipher}, $rec->{ivec}, ); if ($self->{options}->{v4compatible}) { my %acct; @@ -460,8 +628,9 @@ } else { return $fields; } + } else { - # XXX Unsupported version! + die "Unsupported Version"; } return; } @@ -472,12 +641,12 @@ my $digest = shift; my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT ); - my ( $account, $password, $notes, $packeddate ) + my ( $account, $password, $notes, $packed_date ) = split /$NULL/xm, $decrypted, 4; my $modified; - if ($packeddate) { - $modified = _parse_keyring_date($packeddate); + if ($packed_date) { + $modified = _parse_keyring_date($packed_date); } return { @@ -490,28 +659,44 @@ sub _decrypt_v5 { + require Crypt::CBC; + my $encrypted = shift; - my $ivec = shift; my $key = shift; - my $keylen = shift; my $cipher = shift; + my $ivec = shift; + my $keylen = $CRYPTS[ $cipher ]{keylen}; + my $cipher_name = $CRYPTS[ $cipher ]{name}; + my $blocksize = $CRYPTS[ $cipher ]{blocksize}; + my $decrypted; - if ($cipher eq 'None') { + if ($cipher_name eq 'None') { # do nothing $decrypted = $encrypted; - } elsif ($cipher eq 'DES_EDE3' or $cipher eq 'Rijndael') { - my $c = _setup_cipher_v5($ivec, $key, $keylen, $cipher); + } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') { + my $c = Crypt::CBC->new( + -literal_key => 1, + -key => $key, + -iv => $ivec, + -cipher => $cipher_name, + -keysize => $keylen, + -blocksize => $blocksize, + -header => 'none', + -padding => 'oneandzeroes', + ); + if (! $c) { croak("Unable to set up encryption!"); } - $encrypted .= $NULL x $keylen; # pad out a keylen + my $len = $blocksize - length($encrypted) % $blocksize; + $encrypted .= $NULL x $len; $decrypted = $c->decrypt($encrypted); } else { - # XXX Unknown encryption + die "Unsupported Version"; return; } @@ -538,20 +723,29 @@ if (! $pass) { delete $self->{password}; + delete $self->{appinfo}->{key}; return 1; } - if (! exists $self->{records}) { - # Give the PDB the first record that will hold the encrypted password - $self->{records} = [ $self->new_Record ]; + if ( + ($self->{version} == 4 && ! exists $self->{records}) || + ($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 ($i == 0) { + if ($self->{version} == 4 && $i == 0) { push @accts, undef; next; } @@ -568,10 +762,14 @@ $pass = $new_pass; foreach my $i (0..$#accts) { - next if $i == 0; + if ($self->{version} == 4 && $i == 0) { + next; + } delete $self->{records}->[$i]->{encrypted}; $self->Encrypt($self->{records}->[$i], $accts[$i], $pass); } + + $self->{options}->{v4compatible} = $v4compat; } if (defined $self->{password} && $pass eq $self->{password}) { @@ -584,7 +782,7 @@ # always in the first entry my $valid = _password_verify_v4($pass, $self->{records}->[0]->{data}); -# 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} ) { @@ -593,8 +791,7 @@ } } } elsif ($self->{version} == 5) { - $self->{key} = _password_verify_v5($pass, $self->{appinfo}); - return 1 if $self->{key}; + return _password_verify_v5($pass, $self->{appinfo}); } else { # XXX unsupported version } @@ -604,6 +801,9 @@ sub _password_verify_v4 { + require Digest::MD5; + import Digest::MD5 qw(md5); + my $pass = shift; my $data = shift; @@ -621,7 +821,7 @@ my $digest = md5($msg); - if (! $data eq $salt . $digest ) { + if ($data ne $salt . $digest ) { return; } @@ -635,29 +835,128 @@ my $salt = pack("H*", $appinfo->{salt}); - my $key = _pbkdf2( - $pass, $salt, $appinfo->{iter}, $appinfo->{keylen}, \&hmac_sha1 + my ($key, $hash) = _calc_key_v5( + $pass, $salt, $appinfo->{iter}, + $CRYPTS[ $appinfo->{cipher} ]{keylen}, + $CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity}, ); - if ($appinfo->{DES_odd_parity}) { - $key = DES_odd_parity($key); - } - my $newhash = unpack("H*", substr(sha1($key.$salt),0, 8)); - #print "Key: '". unpack("H*", $key) . "'\n"; - #print "Hash: '". $newhash . "'\n"; + #print "Hash: '". $hash . "'\n"; #print "Hash: '". $appinfo->{masterhash} . "'\n"; - if ($appinfo->{masterhash} eq $newhash) { + if ($appinfo->{masterhash} eq $hash) { $appinfo->{key} = $key; } else { return; } + return $key; } -# V4 helpers +sub _password_update +{ + # It is very important to Encrypt after calling this + # (Although it is generally only called by Encrypt) + # because otherwise the data will be out of sync with the + # password, and that would suck! + my $self = shift; + my $pass = shift; + + if ($self->{version} == 4) { + my $data = _password_update_v4($pass, @_); + + if (! $data) { + carp("Failed to update password!"); + return; + } + + # AFAIK the thing we use to test the password is + # always in the first entry + $self->{records}->[0]->{data} = $data; + $self->{password} = $pass; + $self->{digest} = _calc_keys( $self->{password} ); + + return 1; + + } elsif ($self->{version} == 5) { + my $cipher = shift || $self->{appinfo}->{cipher}; + my $iter = shift || $self->{appinfo}->{iter}; + my $salt = shift || 0; + + my $hash = _password_update_v5( + $self->{appinfo}, $pass, $cipher, $iter, $salt + ); + + if (! $hash) { + carp("Failed to update password!"); + return; + } + + return 1; + } else { + croak("Unsupported version ($self->{version})"); + } + + return; +} + +sub _password_update_v4 +{ + require Digest::MD5; + import Digest::MD5 qw(md5); + + my $pass = shift; + + if (! defined $pass) { croak('No password specified!'); }; + + my $salt; + for ( 1 .. $kSalt_Size ) { + $salt .= chr int rand 255; + } + + my $msg = $salt . $pass; + + $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); + + my $digest = md5($msg); + + my $data = $salt . $digest; # . "\0"; + + return $data; +} + +sub _password_update_v5 +{ + my $appinfo = shift; + my $pass = shift; + my $cipher = shift; + my $iter = shift; + + # I thought this 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 ($key, $hash) = _calc_key_v5( + $pass, $salt, $iter, + $CRYPTS[ $cipher ]->{keylen}, + $CRYPTS[ $cipher ]->{DES_odd_parity}, + ); + + $appinfo->{salt} = unpack "H*", $salt; + $appinfo->{iter} = $iter; + $appinfo->{cipher} = $cipher; + + $appinfo->{key} = $key; + $appinfo->{masterhash} = $hash; + + return $key; +} + +# Helpers + sub _calc_keys { my $pass = shift; @@ -682,8 +981,27 @@ return $digest; } +sub _calc_key_v5 +{ + 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); } + + my $hash = unpack("H*", substr(sha1($key.$salt),0, 8)); + + return $key, $hash; +} + sub _crypt3des { + require Crypt::DES; + my ( $plaintext, $passphrase, $flag ) = @_; $passphrase .= $SPACE x ( 16 * 3 ); @@ -731,26 +1049,6 @@ return $cyphertext; } -# V5 helpers - -sub _setup_cipher_v5 -{ - my $ivec = shift; - my $key = shift; - my $keylen = shift; - my $cipher = shift; - - return Crypt::CBC->new( - -literal_key => 1, - -key => $key, - -iv => $ivec, - -cipher => $cipher, - -keysize => $keylen, - -header => 'none', - -padding => 'oneandzeroes', - ); -} - sub _parse_field { my $field = shift; @@ -766,15 +1064,16 @@ if ($len + 4 > length $field) { return undef, $field; } - my $unpackstr = "S1 C1 C1 A$len"; - if ($len % 2) { + my $unpackstr = "x2 C1 C1 A$len"; + 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) - = unpack $unpackstr, $field; + my ($label, $font, $data) = unpack $unpackstr, $field; + my $leftover = substr $field, $offset; if ($label == 3) { $data = _parse_keyring_date($data); @@ -788,46 +1087,68 @@ }, $leftover; } -# All version helpers - -sub _password_update +sub _pack_field { + my $field = shift; - # It is very important to Encrypt after calling this - # (Although it is generally only called by Encrypt) - # because otherwise the data will be out of sync with the - # password, and that would suck! - my $self = shift; - my $pass = shift; + my %labels = ( + name => 0, + account => 1, + password => 2, + lastchange => 3, + notes => 255, + ); - # XXX have to separate this out to v4 and v5 sections. - die "Unsupported version" unless $self->{version} == 4; + my $label = $field->{label_id} || $labels{ $field->{label} }; + my $font = $field->{font} || 0; + my $data = $field->{data} || ''; - if (! defined $pass) { croak('No password specified!'); }; + if ($label == 3) { + $data = _pack_keyring_date($data); + } + my $len = length $data; + my $packstr = "S1 C1 C1 A*"; - my $salt; - for ( 1 .. $kSalt_Size ) { - $salt .= chr int rand 255; + my $packed = pack $packstr, ($len, $label, $font, $data); + + if ($len % 2) { + # add byte padding for next even address. + $packed .= $NULL; } - my $msg = $salt . $pass; + return $packed; +} - $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); +sub _parse_keyring_date +{ + my $data = shift; - my $digest = md5($msg); + my $u = unpack 'n', $data; + my $year = (($u & 0xFE00) >> 9) + 4; # since 1900 + my $month = (($u & 0x01E0) >> 5) - 1; # 0-11 + my $day = (($u & 0x001F) >> 0); # 1-31 - my $data = $salt . $digest; # . "\0"; + return { + year => $year, + month => $month || 0, + day => $day || 1, + }; +} - # AFAIK the thing we use to test the password is - # always in the first entry - $self->{records}->[0]->{data} = $data; +sub _pack_keyring_date +{ + my $d = shift; + my $year = $d->{year}; + my $month = $d->{month}; + my $day = $d->{day}; - $self->{password} = $pass; - $self->{digest} = _calc_keys( $self->{password} ); + $year -= 4; + $month++; - return 1; + return pack 'n', $day | ($month << 5) | ($year << 9); } + sub _hexdump { my $prefix = shift; # What to print in front of each line @@ -931,7 +1252,6 @@ 1; __END__ - =head1 NAME Palm::Keyring - Handler for Palm Keyring databases. @@ -945,8 +1265,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. @@ -962,7 +1283,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"; @@ -972,7 +1294,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. @@ -983,17 +1305,77 @@ 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 crypt + +Pass in the alias of the crypt to use, or the index. + +This is a function, not a method. + + 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 => , + }; + + =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(). -$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, @@ -1005,6 +1387,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. @@ -1017,16 +1432,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]]); @@ -1090,6 +1506,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