| version 1.54, 2007/12/05 05:42:29 | version 1.56, 2008/09/18 07:04:55 | 
|  |  | 
| package Palm::Keyring; | package Palm::Keyring; | 
| # $RedRiver: Keyring.pm,v 1.53 2007/12/04 03:34:17 andrew Exp $ | # $RedRiver: Keyring.pm,v 1.55 2008/09/17 14:47:47 andrew Exp $ | 
| ######################################################################## | ######################################################################## | 
| # Keyring.pm *** Perl class for Keyring for Palm OS databases. | # Keyring.pm *** Perl class for Keyring for Palm OS databases. | 
| # | # | 
|  |  | 
| else { | else { | 
| $options->{password} = shift; | $options->{password} = shift; | 
| $options->{version}  = shift; | $options->{version}  = shift; | 
|  | $options->{cipher}   = shift; | 
| } | } | 
| } | } | 
|  |  | 
|  |  | 
| $self->{appinfo}->{iter}   ||= $self->{options}->{iterations}; | $self->{appinfo}->{iter}   ||= $self->{options}->{iterations}; | 
| }; | }; | 
|  |  | 
|  | if ( defined $options->{file} ) { | 
|  | $self->Load($options->{file}); | 
|  | } | 
|  |  | 
| if ( defined $options->{password} ) { | if ( defined $options->{password} ) { | 
| $self->Password($options->{password}); | $self->Password($options->{password}); | 
| } | } | 
|  |  | 
| } | } | 
| } | } | 
|  |  | 
| my $rc = $self->SUPER::Write(@_); | my @rc = $self->SUPER::Write(@_); | 
|  |  | 
| if ($self->{version} == 4) { | if ($self->{version} == 4) { | 
| shift @{ $self->{records} }; | shift @{ $self->{records} }; | 
| } | } | 
|  |  | 
| return $rc; | return @rc; | 
| } | } | 
|  |  | 
| # ParseRecord | # ParseRecord | 
|  |  | 
| my $self     = shift; | my $self     = shift; | 
|  |  | 
| my $rec = $self->SUPER::ParseRecord(@_); | my $rec = $self->SUPER::ParseRecord(@_); | 
| return $rec if ! exists $rec->{data}; | return $rec if !(defined $rec->{data} && length $rec->{data} ); | 
|  |  | 
| if ($self->{version} == 4) { | if ($self->{version} == 4) { | 
| # skip the first record because it contains the password. | # skip the first record because it contains the password. | 
|  |  | 
| $self->{encpassword} = $rec->{data}; | $self->{encpassword} = $rec->{data}; | 
| return '__DELETE_ME__'; | return '__DELETE_ME__'; | 
| } | } | 
|  |  | 
| if ($self->{records}->[0] eq '__DELETE_ME__') { | if ($self->{records}->[0] eq '__DELETE_ME__') { | 
| shift @{ $self->{records} }; | shift @{ $self->{records} }; | 
| } | } | 
|  |  | 
| $rec->{encrypted} = substr $extra, $blocksize; | $rec->{encrypted} = substr $extra, $blocksize; | 
|  |  | 
| } else { | } else { | 
|  | # XXX Can never get here to test, ParseAppInfoBlock is always run | 
|  | # XXX first by Load(). | 
| croak "Unsupported Version $self->{version}"; | croak "Unsupported Version $self->{version}"; | 
| return; |  | 
| } | } | 
|  |  | 
| return $rec; | return $rec; | 
|  |  | 
| my $self = shift; | my $self = shift; | 
| my $rec  = shift; | my $rec  = shift; | 
|  |  | 
|  | # XXX This probably shouldn't croak, just make something up | 
|  | croak "No encrypted content to pack" if !defined $rec->{encrypted}; | 
|  |  | 
| if ($self->{version} == 4) { | if ($self->{version} == 4) { | 
| if ($rec->{encrypted}) { | if ($rec->{encrypted}) { | 
| my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; | my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; | 
| $rec->{data} = join $NULL, $name, $rec->{encrypted}; | $rec->{data} = join $NULL, $name, $rec->{encrypted}; | 
| delete $rec->{plaintext}; |  | 
| delete $rec->{encrypted}; |  | 
| } | } | 
|  |  | 
| } elsif ($self->{version} == 5) { | } elsif ($self->{version} == 5) { | 
|  | # XXX This probably shouldn't croak, just make something up | 
|  | croak "No ivec" if !$rec->{ivec}; | 
|  |  | 
| my $field; | my $field; | 
| if ($rec->{plaintext}->{0}) { | if ($rec->{plaintext}->{0}) { | 
| $field = $rec->{plaintext}->{0}; | $field = $rec->{plaintext}->{0}; | 
|  |  | 
| } else { | } else { | 
| croak "Unsupported Version $self->{version}"; | croak "Unsupported Version $self->{version}"; | 
| } | } | 
|  | # XXX Should I? | 
|  | delete $rec->{plaintext}; | 
|  | delete $rec->{encrypted}; | 
|  |  | 
| return $self->SUPER::PackRecord($rec, @_); | return $self->SUPER::PackRecord($rec, @_); | 
| } | } | 
|  |  | 
|  |  | 
| my ($len) = unpack "n", $field; | my ($len) = unpack "n", $field; | 
| if ($len + 4 > length $field) { | if ($len + 4 > length $field) { | 
| return undef, $field; | return (undef, $field); | 
| } | } | 
| my $unpackstr = "x2 C1 C1 A$len"; | my $unpackstr = "x2 C1 C1 A$len"; | 
| my $offset    =   2 +1 +1 +$len; | my $offset    =   2 +1 +1 +$len; | 
|  |  | 
| my $maxlines = shift; # Max # of lines to dump | my $maxlines = shift; # Max # of lines to dump | 
| my $offset;           # Offset of current chunk | my $offset;           # Offset of current chunk | 
|  |  | 
|  | my @lines; | 
|  |  | 
| for ($offset = 0; $offset < length($data); $offset += 16) | for ($offset = 0; $offset < length($data); $offset += 16) | 
| { | { | 
| my $hex;   # Hex values of the data | my $hex;   # Hex values of the data | 
|  |  | 
|  |  | 
| ($ascii = $chunk) =~ y/\040-\176/./c; | ($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 | sub _bindump | 
|  |  | 
| my $maxlines = shift; # Max # of lines to dump | my $maxlines = shift; # Max # of lines to dump | 
| my $offset;           # Offset of current chunk | my $offset;           # Offset of current chunk | 
|  |  | 
|  | my @lines; | 
|  |  | 
| for ($offset = 0; $offset < length($data); $offset += 8) | for ($offset = 0; $offset < length($data); $offset += 8) | 
| { | { | 
| my $bin;   # binary values of the data | my $bin;   # binary values of the data | 
|  |  | 
|  |  | 
| ($ascii = $chunk) =~ y/\040-\176/./c; | ($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 <hoenicke@gmail.com> | # Thanks to Jochen Hoenicke <hoenicke@gmail.com> | 
|  |  | 
| # keylen is length of generated key in bytes | # keylen is length of generated key in bytes | 
| # prf is the pseudo random function (e.g. hmac_sha1) | # prf is the pseudo random function (e.g. hmac_sha1) | 
| # returns the key. | # returns the key. | 
| sub _pbkdf2($$$$$) | sub _pbkdf2 | 
| { | { | 
| my ($password, $salt, $iter, $keylen, $prf) = @_; | my ($password, $salt, $iter, $keylen, $prf) = @_; | 
| my ($k, $t, $u, $ui, $i); | my ($k, $t, $u, $ui, $i); | 
|  |  | 
| return substr($t, 0, $keylen); | return substr($t, 0, $keylen); | 
| } | } | 
|  |  | 
| sub _DES_odd_parity($) { | sub _DES_odd_parity { | 
| my $key = $_[0]; | my $key = $_[0]; | 
| my ($r, $i); | my ($r, $i); | 
| my @odd_parity = ( | my @odd_parity = ( | 
|  |  | 
|  |  | 
| =head2 new | =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 | Create a new PDB, initialized with the various Palm::Keyring fields | 
| and an empty record list. | and an empty record list. | 
|  |  | 
| =item iterations | =item iterations | 
|  |  | 
| The number of iterations to encrypt with.  Only used by somy crypts in v5 databases. | 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 | =back | 
|  |  |