| 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 |
| |
|