=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.21 retrieving revision 1.28 diff -u -r1.21 -r1.28 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/01/31 05:32:20 1.21 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/18 05:50:25 1.28 @@ -1,111 +1,312 @@ package Palm::Keyring; - -# $RedRiver: Keyring.pm,v 1.20 2007/01/31 04:29:08 andrew Exp $ +# $RedRiver: Keyring.pm,v 1.27 2007/02/10 16:21:28 andrew Exp $ +######################################################################## +# Keyring.pm *** Perl class for Keyring for Palm OS databases. # -# Perl class for dealing with Keyring for Palm OS databases. -# # This started as Memo.pm, I just made it work for Keyring. - +# +# 2006.01.26 #*#*# andrew fresh +######################################################################## +# Copyright (C) 2006, 2007 by Andrew Fresh +# +# This program is free software; you can redistribute it and/or modify +# it under the same terms as Perl itself. +######################################################################## use strict; use warnings; + use Carp; 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; -use Readonly; -Readonly my $ENCRYPT => 1; -Readonly my $DECRYPT => 0; -Readonly my $MD5_CBLOCK => 64; -Readonly my $kSalt_Size => 4; -Readonly my $EMPTY => q{}; -Readonly my $SPACE => q{ }; -Readonly my $NULL => chr 0; +my $ENCRYPT = 1; +my $DECRYPT = 0; +my $MD5_CBLOCK = 64; +my $kSalt_Size = 4; +my $EMPTY = q{}; +my $SPACE = q{ }; +my $NULL = chr 0; -# One liner, to allow MakeMaker to work. -our $VERSION = 0.92; +my @CRYPTS = ( + { # None + name => 'None', + keylen => 8, + blocksize => 1, + }, + { # DES-EDE3 + name => 'DES_EDE3', + keylen => 24, + blocksize => 8, + DES_odd_parity => 1, + }, + { # AES128 + name => 'Rijndael', + keylen => 16, + blocksize => 16, + }, + { # AES256 + name => 'Rijndael', + keylen => 32, + blocksize => 16, + }, +); -sub new { + +our $VERSION = 0.95; + +sub new +{ my $classname = shift; - my $pass = shift; + my $options = {}; + # hashref arguments + if (ref $_[0] eq 'HASH') { + $options = shift; + } + + # CGI style arguments + elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) { + my %tmp = @_; + while ( my($key,$value) = each %tmp) { + $key =~ s/^-//; + $options->{lc $key} = $value; + } + } + + else { + $options->{password} = shift; + $options->{version} = shift; + } + # Create a generic PDB. No need to rebless it, though. - my $self = $classname->SUPER::new(@_); + my $self = $classname->SUPER::new(); - $self->{'name'} = 'Keys-Gtkr'; # Default - $self->{'creator'} = 'Gtkr'; - $self->{'type'} = 'Gkyr'; + $self->{name} = 'Keys-Gtkr'; # Default + $self->{creator} = 'Gtkr'; + $self->{type} = 'Gkyr'; # The PDB is not a resource database by # default, but it's worth emphasizing, # since MemoDB is explicitly not a PRC. - $self->{'attributes'}{'resource'} = 0; + $self->{attributes}{resource} = 0; - # Initialize the AppInfo block - $self->{'appinfo'} = {}; - - # Add the standard AppInfo block stuff - Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} ); - # Set the version - $self->{'version'} = 4; + $self->{version} = $options->{version} || 4; - if ( defined $pass ) { - $self->Password($pass); + # Set options + $self->{options} = $options; + + if ( defined $options->{password} ) { + $self->Password($options->{password}); } return $self; } -sub import { +sub import +{ Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], ); return 1; } -sub ParseRecord { +# PackRecord + +sub ParseRecord +{ my $self = shift; my $rec = $self->SUPER::ParseRecord(@_); + return $rec if ! exists $rec->{data}; - # skip the 0 record that holds the password - return $rec if ! exists $self->{'records'}; - return $rec if ! exists $rec->{'data'}; + if ($self->{version} == 4) { + # skip the first record because it contains the password. + return $rec if ! exists $self->{records}; - my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; + my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2; - return $rec if ! $encrypted; - delete $rec->{'data'}; - $rec->{'name'} = $name; - $rec->{'encrypted'} = $encrypted; + return $rec if ! $encrypted; + $rec->{name} = $name; + $rec->{encrypted} = $encrypted; + delete $rec->{data}; + } elsif ($self->{version} == 5) { + my $blocksize = $self->{appinfo}->{blocksize}; + my ($field, $extra) = _parse_field($rec->{data}); + my ($ivec, $encrypted) = unpack "A$blocksize A*", $extra; + + if ($self->{options}->{v4compatible}) { + $rec->{name} = $field->{data}; + } else { + $rec->{name} = $field; + } + $rec->{ivec} = $ivec; + $rec->{encrypted} = $encrypted; + + } else { + # XXX Unsupported version! + return; + } + return $rec; } -sub PackRecord { +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 +{ my $self = shift; my $rec = shift; - my $rec0_id = $self->{'records'}->[0]->{'id'}; - - if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) { - $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'}; - delete $rec->{'name'}; - delete $rec->{'encrypted'}; + 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}; + } + } elsif ($self->{version} == 5) { + # XXX do something + } else { + # XXX Unsupported version! + return; } return $self->SUPER::PackRecord($rec, @_); } -sub Encrypt { +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 +{ my $self = shift; + my $data = shift; + my $appinfo = {}; + + &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data); + + # int8/uint8 + # - Signed or Unsigned Byte (8 bits). C types: char, unsigned char + # int16/uint16 + # - Signed or Unsigned Word (16 bits). C types: short, unsigned short + # int32/uint32 + # - Signed or Unsigned Doubleword (32 bits). C types: int, unsigned int + # sz + # - Zero-terminated C-style string + + if ($self->{version} == 4) { + # Nothing extra for version 4 + + } elsif ($self->{version} == 5) { + _parse_appinfo_v5($appinfo) || return; + + } else { + # XXX Unknown version + return; + } + + return $appinfo; +} + +sub _parse_appinfo_v5 +{ + my $appinfo = shift; + + if (! exists $appinfo->{other}) { + # XXX Corrupt appinfo? + return; + } + + my $unpackstr + = ("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, $iter, $cipher, @hash); + (@salt[0..7], $iter, $cipher, @hash[0..7]) + = unpack $unpackstr, $appinfo->{other}; + + $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}; + + return $appinfo +} + +# PackAppInfoBlock + +sub PackAppInfoBlock +{ + my $self = shift; + my $retval; + + if ($self->{version} == 4) { + # Nothing to do for v4 + + } elsif ($self->{version} == 5) { + croak("Unsupported version!"); + #$self->{appinfo}{other} = ; + } else { + # XXX Unknown version + return; + } + return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo}); +} + +# Encrypt + +sub Encrypt +{ + my $self = shift; my $rec = shift; my $data = shift; - my $pass = shift || $self->{'password'}; + my $pass = shift || $self->{password}; - if ( ! $pass) { - croak("'password' not set!\n"); + if ( ! $pass && ! $self->{key}) { + croak("password not set!\n"); } if ( ! $rec) { @@ -120,46 +321,111 @@ croak("Incorrect Password!\n"); } - $self->{'digest'} ||= _calc_keys( $pass ); + if ($self->{version} == 4) { + $self->{digest} ||= _calc_keys( $pass ); + my $acct = {}; + if ($rec->{encrypted}) { + $acct = $self->Decrypt($rec, $pass); + } + 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; + 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}, + ); + } else { + # XXX Unsupported version! + } + return; +} - $data->{'account'} ||= $EMPTY; - $data->{'password'} ||= $EMPTY; - $data->{'notes'} ||= $EMPTY; +sub _encrypt_v4 +{ + my $data = shift; + my $digest = shift; + my $acct = shift; - my ($day, $month, $year); + $data->{account} ||= $EMPTY; + $data->{password} ||= $EMPTY; + $data->{notes} ||= $EMPTY; - # XXX the 0 here is a placeholder for $record_has_changed. - if ( 0 || ! $data->{'lastchange'}) { - ($day, $month, $year) = (localtime)[3,4,5]; - $year -= 4; - $month++; + my $changed = 0; + my $need_newdate = 0; + if (%{ $acct }) { + foreach my $key (keys %{ $data }) { + next if $key eq 'lastchange'; + if ($data->{$key} ne $acct->{$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} + )) { + $changed = 1; + $need_newdate = 0; + } else { + $need_newdate = 1; + } + + } else { + $changed = 1; } - my $p = $day | ($month << 5) | ($year << 9); - my $packeddate = pack 'n', $p; + # no need to re-encrypt if it has not changed. + return 1 if ! $changed; - my $plaintext = join $NULL, - $data->{'account'}, $data->{'password'}, $data->{'notes'}, $packeddate; + my ($day, $month, $year); - my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT ); + if ($data->{lastchange} && ! $need_newdate ) { + $day = $data->{lastchange}->{day} || 1; + $month = $data->{lastchange}->{month} || 0; + $year = $data->{lastchange}->{year} || 0; - return if ! $encrypted; + # XXX Need to actually validate the above information somehow + if ($year >= 1900) { + $year -= 1900; + } + } else { + $need_newdate = 1; + } - $rec->{'attributes'}{'Dirty'} = 1; - $rec->{'attributes'}{'dirty'} = 1; - $rec->{'name'} ||= $data->{'name'}; - $rec->{'encrypted'} = $encrypted; + if ($need_newdate) { + ($day, $month, $year) = (localtime)[3,4,5]; + } - return 1; + my $packeddate = _pack_keyring_date( { + year => $year, + month => $month, + day => $day, + }); + + my $plaintext = join $NULL, + $data->{account}, $data->{password}, $data->{notes}, $packeddate; + + return _crypt3des( $plaintext, $digest, $ENCRYPT ); } -sub Decrypt { +# Decrypt + +sub Decrypt +{ my $self = shift; my $rec = shift; - my $pass = shift || $self->{'password'}; + my $pass = shift || $self->{password}; - if ( ! $pass) { - croak("'password' not set!\n"); + if ( ! $pass && ! $self->{key}) { + croak("password not set!\n"); } if ( ! $rec) { @@ -170,62 +436,128 @@ croak("Invalid Password!\n"); } - if ( ! $rec->{'encrypted'} ) { + if ( ! $rec->{encrypted} ) { croak("No encrypted content!"); } - $self->{'digest'} ||= _calc_keys( $pass ); + if ($self->{version} == 4) { + $self->{digest} ||= _calc_keys( $pass ); + 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}, + ); + if ($self->{options}->{v4compatible}) { + my %acct; + foreach my $f (@{ $fields }) { + $acct{ $f->{label} } = $f->{data}; + } + $acct{name} ||= $rec->{name}; + return \%acct; + } else { + return $fields; + } + } else { + # XXX Unsupported version! + } + return; +} - my $decrypted = - _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT ); - my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm, - $decrypted, 4; +sub _decrypt_v4 +{ + my $encrypted = shift; + my $digest = shift; - my %Modified; - if ($packeddate) { - my $u = unpack 'n', $packeddate; - my $year = (($u & 0xFE00) >> 9) + 4; # since 1900 - my $month = (($u & 0x01E0) >> 5) - 1; # 0-11 - my $day = (($u & 0x001F) >> 0); # 1-31 + my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT ); + my ( $account, $password, $notes, $packeddate ) + = split /$NULL/xm, $decrypted, 4; - %Modified = ( - year => $year, - month => $month || 0, - day => $day || 1, - ); + my $modified; + if ($packeddate) { + $modified = _parse_keyring_date($packeddate); } return { - name => $rec->{'name'}, account => $account, password => $password, notes => $notes, - lastchange => \%Modified, + lastchange => $modified, }; } -sub Password { +sub _decrypt_v5 +{ + my $encrypted = shift; + my $ivec = shift; + my $key = shift; + my $keylen = shift; + my $cipher = shift; + + my $decrypted; + + if ($cipher eq 'None') { + # do nothing + $decrypted = $encrypted; + + } elsif ($cipher eq 'DES_EDE3' or $cipher eq 'Rijndael') { + my $c = _setup_cipher_v5($ivec, $key, $keylen, $cipher); + if (! $c) { + croak("Unable to set up encryption!"); + } + $encrypted .= $NULL x $keylen; # pad out a keylen + $decrypted = $c->decrypt($encrypted); + + } else { + # XXX Unknown encryption + return; + } + + my @fields; + while ($decrypted) { + my $field; + ($field, $decrypted) = _parse_field($decrypted); + if (! $field) { + last; + } + push @fields, $field; + } + + return \@fields; +} + +# Password + +sub Password +{ my $self = shift; - my $pass = shift || $self->{'password'}; + my $pass = shift; my $new_pass = shift; - if (! exists $self->{'records'}) { + if (! $pass) { + delete $self->{password}; + return 1; + } + + if (! exists $self->{records}) { # Give the PDB the first record that will hold the encrypted password - $self->{'records'} = [ $self->new_Record ]; + $self->{records} = [ $self->new_Record ]; return $self->_password_update($pass); } if ($new_pass) { my @accts = (); - foreach my $i (0..$#{ $self->{'records'} }) { + foreach my $i (0..$#{ $self->{records} }) { if ($i == 0) { push @accts, undef; next; } - my $acct = $self->Decrypt($self->{'records'}->[$i], $pass); + my $acct = $self->Decrypt($self->{records}->[$i], $pass); if ( ! $acct ) { - croak("Couldn't decrypt $self->{'records'}->[$i]->{'name'}"); + croak("Couldn't decrypt $self->{records}->[$i]->{name}"); } push @accts, $acct; } @@ -237,15 +569,98 @@ foreach my $i (0..$#accts) { next if $i == 0; - $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass); + delete $self->{records}->[$i]->{encrypted}; + $self->Encrypt($self->{records}->[$i], $accts[$i], $pass); } } - return $self->_password_verify($pass); + 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}); + +# 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) { + $self->{key} = _password_verify_v5($pass, $self->{appinfo}); + return 1 if $self->{key}; + } else { + # XXX unsupported version + } + + return; } -sub _calc_keys { +sub _password_verify_v4 +{ my $pass = shift; + my $data = shift; + + if (! $pass) { croak('No password specified!'); }; + + # 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; + + my $msg = $salt . $pass; + $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); + + my $digest = md5($msg); + + if (! $data eq $salt . $digest ) { + return; + } + + return 1; +} + +sub _password_verify_v5 +{ + my $pass = shift; + my $appinfo = shift; + + my $salt = pack("H*", $appinfo->{salt}); + + my $key = _pbkdf2( + $pass, $salt, $appinfo->{iter}, $appinfo->{keylen}, \&hmac_sha1 + ); + 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: '". $appinfo->{masterhash} . "'\n"; + + if ($appinfo->{masterhash} eq $newhash) { + $appinfo->{key} = $key; + } else { + return; + } + return $key; +} + +# V4 helpers + +sub _calc_keys +{ + my $pass = shift; if (! defined $pass) { croak('No password defined!'); }; my $digest = md5($pass); @@ -267,48 +682,117 @@ return $digest; } -sub _password_verify { - my $self = shift; - my $pass = shift; +sub _crypt3des +{ + my ( $plaintext, $passphrase, $flag ) = @_; - if (! $pass) { croak('No password specified!'); }; + $passphrase .= $SPACE x ( 16 * 3 ); + my $cyphertext = $EMPTY; - if (defined $self->{'password'} && $pass eq $self->{'password'}) { - # already verified this password - return 1; + my $size = length $plaintext; + + #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n"; + + my @C; + for ( 0 .. 2 ) { + $C[$_] = + new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 )); } - # AFAIK the thing we use to test the password is - # always in the first entry - my $data = $self->{'records'}->[0]->{'data'}; + for ( 0 .. ( ($size) / 8 ) ) { + my $pt = substr $plaintext, $_ * 8, 8; - #die "No encrypted password in file!" unless defined $data; - if ( ! defined $data) { return; }; + #print "PT: '$pt' - Length: " . length($pt) . "\n"; + if (! length $pt) { next; }; + if ( (length $pt) < 8 ) { + if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; + my $len = 8 - (length $pt); + $pt .= ($NULL x $len); + } + if ( $flag == $ENCRYPT ) { + $pt = $C[0]->encrypt($pt); + $pt = $C[1]->decrypt($pt); + $pt = $C[2]->encrypt($pt); + } + else { + $pt = $C[0]->decrypt($pt); + $pt = $C[1]->encrypt($pt); + $pt = $C[2]->decrypt($pt); + } - $data =~ s/$NULL$//xm; + #print "PT: '$pt' - Length: " . length($pt) . "\n"; + $cyphertext .= $pt; + } - my $salt = substr $data, 0, $kSalt_Size; + $cyphertext =~ s/$NULL+$//xm; - my $msg = $salt . $pass; + #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n"; - $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); + return $cyphertext; +} - my $digest = md5($msg); +# V5 helpers - if ( $data eq $salt . $digest ) { +sub _setup_cipher_v5 +{ + my $ivec = shift; + my $key = shift; + my $keylen = shift; + my $cipher = shift; -# May as well generate the keys we need now, since we know the password is right - $self->{'digest'} = _calc_keys($pass); - if ( $self->{'digest'} ) { - $self->{'password'} = $pass; - return 1; - } + 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; + + my @labels; + $labels[0] = 'name'; + $labels[1] = 'account'; + $labels[2] = 'password'; + $labels[3] = 'lastchange'; + $labels[255] = 'notes'; + + my ($len) = unpack "S1", $field; + if ($len + 4 > length $field) { + return undef, $field; } - return; + my $unpackstr = "S1 C1 C1 A$len"; + if ($len % 2) { + # trim the 0/1 byte padding for next even address. + $unpackstr .= ' x' + } + $unpackstr .= ' A*'; + + my (undef, $label, $font, $data, $leftover) + = unpack $unpackstr, $field; + + if ($label == 3) { + $data = _parse_keyring_date($data); + } + return { + #len => $len, + label => $labels[ $label ] || $label, + label_id => $label, + font => $font, + data => $data, + }, $leftover; } -sub _password_update { +# All version 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 @@ -316,6 +800,9 @@ my $self = shift; my $pass = shift; + # XXX have to separate this out to v4 and v5 sections. + die "Unsupported version" unless $self->{version} == 4; + if (! defined $pass) { croak('No password specified!'); }; my $salt; @@ -333,66 +820,113 @@ # AFAIK the thing we use to test the password is # always in the first entry - $self->{'records'}->[0]->{'data'} = $data; + $self->{records}->[0]->{data} = $data; - $self->{'password'} = $pass; - $self->{'digest'} = _calc_keys( $self->{'password'} ); + $self->{password} = $pass; + $self->{digest} = _calc_keys( $self->{password} ); return 1; } -sub _crypt3des { - my ( $plaintext, $passphrase, $flag ) = @_; +sub _hexdump +{ + my $prefix = shift; # What to print in front of each line + my $data = shift; # The data to dump + my $maxlines = shift; # Max # of lines to dump + my $offset; # Offset of current chunk - $passphrase .= $SPACE x ( 16 * 3 ); - my $cyphertext = $EMPTY; + for ($offset = 0; $offset < length($data); $offset += 16) + { + my $hex; # Hex values of the data + my $ascii; # ASCII values of the data + my $chunk; # Current chunk of data - my $size = length $plaintext; + last if defined($maxlines) && ($offset >= ($maxlines * 16)); - #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n"; + $chunk = substr($data, $offset, 16); - my @C; - for ( 0 .. 2 ) { - $C[$_] = - new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 )); + ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges; + + ($ascii = $chunk) =~ y/\040-\176/./c; + + printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii; } +} - for ( 0 .. ( ($size) / 8 ) ) { - my $pt = substr $plaintext, $_ * 8, 8; +sub _bindump +{ + my $prefix = shift; # What to print in front of each line + my $data = shift; # The data to dump + my $maxlines = shift; # Max # of lines to dump + my $offset; # Offset of current chunk - #print "PT: '$pt' - Length: " . length($pt) . "\n"; - if (! length $pt) { next; }; - if ( (length $pt) < 8 ) { - if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; - my $len = 8 - (length $pt); + for ($offset = 0; $offset < length($data); $offset += 8) + { + my $bin; # binary values of the data + my $ascii; # ASCII values of the data + my $chunk; # Current chunk of data - #print "LENGTH: $len\n"; - #print "Binary: '" . unpack("b*", $pt) . "'\n"; - $pt .= ($NULL x $len); + last if defined($maxlines) && ($offset >= ($maxlines * 8)); - #print "PT: '$pt' - Length: " . length($pt) . "\n"; - #print "Binary: '" . unpack("b*", $pt) . "'\n"; - } - if ( $flag == $ENCRYPT ) { - $pt = $C[0]->encrypt($pt); - $pt = $C[1]->decrypt($pt); - $pt = $C[2]->encrypt($pt); - } - else { - $pt = $C[0]->decrypt($pt); - $pt = $C[1]->encrypt($pt); - $pt = $C[2]->decrypt($pt); - } + $chunk = substr($data, $offset, 8); - #print "PT: '$pt' - Length: " . length($pt) . "\n"; - $cyphertext .= $pt; + ($bin = $chunk) =~ s/./sprintf "%08b ", ord($&)/ges; + + ($ascii = $chunk) =~ y/\040-\176/./c; + + printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii; } +} - $cyphertext =~ s/$NULL+$//xm; +# Thanks to Jochen Hoenicke +# (one of the authors of Palm Keyring) +# for these next two subs. - #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n"; +# Usage pbkdf2(password, salt, iter, keylen, prf) +# iter is number of iterations +# keylen is length of generated key in bytes +# prf is the pseudo random function (e.g. hmac_sha1) +# returns the key. +sub _pbkdf2($$$$$) +{ + my ($password, $salt, $iter, $keylen, $prf) = @_; + my ($k, $t, $u, $ui, $i); + $t = ""; + for ($k = 1; length($t) < $keylen; $k++) { + $u = $ui = &$prf($salt.pack('N', $k), $password); + for ($i = 1; $i < $iter; $i++) { + $ui = &$prf($ui, $password); + $u ^= $ui; + } + $t .= $u; + } + return substr($t, 0, $keylen); +} - return $cyphertext; +sub DES_odd_parity($) { + my $key = $_[0]; + my ($r, $i); + my @odd_parity = ( + 1, 1, 2, 2, 4, 4, 7, 7, 8, 8, 11, 11, 13, 13, 14, 14, + 16, 16, 19, 19, 21, 21, 22, 22, 25, 25, 26, 26, 28, 28, 31, 31, + 32, 32, 35, 35, 37, 37, 38, 38, 41, 41, 42, 42, 44, 44, 47, 47, + 49, 49, 50, 50, 52, 52, 55, 55, 56, 56, 59, 59, 61, 61, 62, 62, + 64, 64, 67, 67, 69, 69, 70, 70, 73, 73, 74, 74, 76, 76, 79, 79, + 81, 81, 82, 82, 84, 84, 87, 87, 88, 88, 91, 91, 93, 93, 94, 94, + 97, 97, 98, 98,100,100,103,103,104,104,107,107,109,109,110,110, +112,112,115,115,117,117,118,118,121,121,122,122,124,124,127,127, +128,128,131,131,133,133,134,134,137,137,138,138,140,140,143,143, +145,145,146,146,148,148,151,151,152,152,155,155,157,157,158,158, +161,161,162,162,164,164,167,167,168,168,171,171,173,173,174,174, +176,176,179,179,181,181,182,182,185,185,186,186,188,188,191,191, +193,193,194,194,196,196,199,199,200,200,203,203,205,205,206,206, +208,208,211,211,213,213,214,214,217,217,218,218,220,220,223,223, +224,224,227,227,229,229,230,230,233,233,234,234,236,236,239,239, +241,241,242,242,244,244,247,247,248,248,251,251,253,253,254,254); + for ($i = 0; $i< length($key); $i++) { + $r .= chr($odd_parity[ord(substr($key, $i, 1))]); + } + return $r; } 1; @@ -427,11 +961,11 @@ my $pdb = new Palm::PDB; $pdb->Load($file); - foreach (0..$#{ $pdb->{'records'} }) { + foreach (0..$#{ $pdb->{records} }) { next if $_ = 0; # skip the password record - my $rec = $pdb->{'records'}->[$_]; + my $rec = $pdb->{records}->[$_]; my $acct = $pdb->Decrypt($rec, $pass); - print $rec->{'name'}, ' - ', $acct->{'account'}, "\n"; + print $rec->{name}, ' - ', $acct->{account}, "\n"; } =head1 SUBROUTINES/METHODS @@ -446,18 +980,21 @@ 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 +password. + =head2 Encrypt - $pdb->Encrypt($rec, $acct, [$password]); + $pdb->Encrypt($rec, $acct[, $password]); Encrypts an account into a record, either with the password previously used, or with a password that is passed. -$rec is a record from $pdb->{'records'} or a newly generated record. +$rec is a record from $pdb->{records} or a new_Record(). $acct is a hashref in the format below. my $acct = { - name => $rec->{'name'}, + name => $rec->{name}, account => $account, password => $password, notes => $notes, @@ -468,18 +1005,24 @@ }, }; +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}. + =head2 Decrypt my $acct = $pdb->Decrypt($rec[, $password]); Decrypts the record and returns a hashref for the account as described under Encrypt(). -However, it ignores the "lastchange" field and generates its own. -It also only uses the "name" field if there is not already a $rec->{'name'}. - foreach (0..$#{ $pdb->{'records'}) { + foreach (0..$#{ $pdb->{records}) { next if $_ == 0; - my $rec = $pdb->{'records'}->[$_]; + my $rec = $pdb->{records}->[$_]; my $acct = $pdb->Decrypt($rec[, $password]); # do something with $acct } @@ -495,8 +1038,7 @@ called new(), you only need to pass one password and it will set that as the password. -If nothing is passed, and there has been a password used before, -it just verifies that the password was correct. +If nothing is passed, it forgets the password that it was remembering. =head1 DEPENDENCIES @@ -508,9 +1050,22 @@ Readonly +=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 also like to thank +Johan Vromans +Ejvromans@squirrel.nlE -- +L. +He had his own Palm::KeyRing module that he posted a couple of days before +mine was ready and he was kind enough to let me have the namespace as well +as giving me some very helpful hints about doing a few things that I was +unsure of. He is really great. + =head1 BUGS AND LIMITATIONS -Once this module is uploaded, you can 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 @@ -518,7 +1073,7 @@ =head1 AUTHOR -Andrew Fresh Eandrew@mad-techies.orgE +Andrew Fresh Eandrew@cpan.orgE =head1 LICENSE AND COPYRIGHT @@ -535,3 +1090,6 @@ The Keyring for Palm OS website: L + +Johan Vromans also has a wxkeyring app that now uses this module, available +from his website at L