| version 1.34, 2007/02/21 05:24:14 |
version 1.48, 2007/09/12 03:44:36 |
|
|
| package Palm::Keyring; |
package Palm::Keyring; |
| # $RedRiver: Keyring.pm,v 1.33 2007/02/21 01:26:07 andrew Exp $ |
# $RedRiver: Keyring.pm,v 1.47 2007/09/12 00:30:10 andrew Exp $ |
| ######################################################################## |
######################################################################## |
| # Keyring.pm *** Perl class for Keyring for Palm OS databases. |
# Keyring.pm *** Perl class for Keyring for Palm OS databases. |
| # |
# |
|
|
| }, |
}, |
| ); |
); |
| |
|
| |
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_01'; |
| |
|
| sub new |
sub new |
| { |
{ |
| my $classname = shift; |
my $classname = shift; |
| my $options = {}; |
my $options = {}; |
| |
|
| # hashref arguments |
if (@_) { |
| if (ref $_[0] eq 'HASH') { |
# hashref arguments |
| $options = shift; |
if (ref $_[0] eq 'HASH') { |
| } |
$options = shift; |
| |
} |
| |
|
| # CGI style arguments |
# CGI style arguments |
| elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) { |
elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) { |
| my %tmp = @_; |
my %tmp = @_; |
| while ( my($key,$value) = each %tmp) { |
while ( my($key,$value) = each %tmp) { |
| $key =~ s/^-//; |
$key =~ s/^-//; |
| $options->{lc $key} = $value; |
$options->{lc $key} = $value; |
| } |
} |
| } |
} |
| |
|
| else { |
else { |
| $options->{password} = shift; |
$options->{password} = shift; |
| $options->{version} = shift; |
$options->{version} = shift; |
| |
} |
| } |
} |
| |
|
| # Create a generic PDB. No need to rebless it, though. |
# Create a generic PDB. No need to rebless it, though. |
|
|
| # Set defaults |
# Set defaults |
| if ($self->{version} == 5) { |
if ($self->{version} == 5) { |
| $self->{options}->{cipher} ||= 0; # 'None' |
$self->{options}->{cipher} ||= 0; # 'None' |
| $self->{options}->{iterations} ||= |
my $c = crypts($self->{options}->{cipher}) |
| $CRYPTS[ $self->{options}->{cipher} ]{default_iter}; |
or croak('Unknown cipher ' . $self->{options}->{cipher}); |
| |
$self->{options}->{iterations} ||= $c->{default_iter}; |
| $self->{appinfo}->{cipher} ||= $self->{options}->{cipher}; |
$self->{appinfo}->{cipher} ||= $self->{options}->{cipher}; |
| $self->{appinfo}->{iter} ||= $self->{options}->{iterations}; |
$self->{appinfo}->{iter} ||= $self->{options}->{iterations}; |
| }; |
}; |
| |
|
| if ( defined $options->{password} ) { |
if ( defined $options->{password} ) { |
|
|
| sub crypts |
sub crypts |
| { |
{ |
| my $crypt = shift; |
my $crypt = shift; |
| if ($crypt =~ /\D/) { |
if ((! defined $crypt) || (! length $crypt)) { |
| |
return; |
| |
} elsif ($crypt =~ /\D/) { |
| foreach my $c (@CRYPTS) { |
foreach my $c (@CRYPTS) { |
| if ($c->{alias} eq $crypt) { |
if ($c->{alias} eq $crypt) { |
| return $c; |
return $c; |
|
|
| } |
} |
| } |
} |
| |
|
| |
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 |
# ParseRecord |
| |
|
| sub ParseRecord |
sub ParseRecord |
|
|
| |
|
| 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. |
| 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; |
my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2; |
| |
|
| return $rec if ! $encrypted; |
return $rec if ! $encrypted; |
| $rec->{name} = $name; |
$rec->{plaintext}->{0} = { |
| |
label => 'name', |
| |
label_id => 0, |
| |
data => $name, |
| |
font => 0, |
| |
}; |
| $rec->{encrypted} = $encrypted; |
$rec->{encrypted} = $encrypted; |
| delete $rec->{data}; |
delete $rec->{data}; |
| |
|
| } elsif ($self->{version} == 5) { |
} 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 ($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}; |
delete $rec->{data}; |
| |
|
| |
$rec->{plaintext}->{0} = $field; |
| |
$rec->{ivec} = substr $extra, 0, $blocksize; |
| |
$rec->{encrypted} = substr $extra, $blocksize; |
| |
|
| } else { |
} else { |
| die 'Unsupported Version'; |
croak "Unsupported Version $self->{version}"; |
| return; |
return; |
| } |
} |
| |
|
|
|
| |
|
| if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
| if ($rec->{encrypted}) { |
if ($rec->{encrypted}) { |
| if (! defined $rec->{name}) { |
my $name = $rec->{plaintext}->{0}->{data} || $EMPTY; |
| $rec->{name} = $EMPTY; |
$rec->{data} = join $NULL, $name, $rec->{encrypted}; |
| } |
delete $rec->{plaintext}; |
| $rec->{data} = join $NULL, $rec->{name}, $rec->{encrypted}; |
|
| delete $rec->{name}; |
|
| delete $rec->{encrypted}; |
delete $rec->{encrypted}; |
| } |
} |
| |
|
| } elsif ($self->{version} == 5) { |
} elsif ($self->{version} == 5) { |
| my $field = { |
my $field; |
| 'label_id' => 1, |
if ($rec->{plaintext}->{0}) { |
| 'data' => $rec->{name}, |
$field = $rec->{plaintext}->{0}; |
| 'font' => 0, |
} else { |
| }; |
$field = { |
| my $packed .= _pack_field($field); |
'label' => 'name', |
| |
'label_id' => 0, |
| |
'data' => $EMPTY, |
| |
'font' => 0, |
| |
}; |
| |
} |
| |
my $packed = _pack_field($field); |
| |
|
| $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted}; |
$rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted}; |
| |
|
| } else { |
} else { |
| die 'Unsupported Version'; |
croak "Unsupported Version $self->{version}"; |
| } |
} |
| |
|
| return $self->SUPER::PackRecord($rec, @_); |
return $self->SUPER::PackRecord($rec, @_); |
|
|
| _parse_appinfo_v5($appinfo) || return; |
_parse_appinfo_v5($appinfo) || return; |
| |
|
| } else { |
} else { |
| die "Unsupported Version"; |
croak "Unsupported Version $self->{version}"; |
| return; |
|
| } |
} |
| |
|
| return $appinfo; |
return $appinfo; |
|
|
| |
|
| my $unpackstr |
my $unpackstr |
| = ("C1" x 8) # 8 uint8s in an array for the salt |
= ("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 |
. ("C1" x 8); # and finally 8 more uint8s for the hash |
| |
|
| my (@salt, $iter, $cipher, @hash); |
my (@salt, $iter, $cipher, @hash); |
|
|
| } elsif ($self->{version} == 5) { |
} elsif ($self->{version} == 5) { |
| _pack_appinfo_v5($self->{appinfo}); |
_pack_appinfo_v5($self->{appinfo}); |
| } else { |
} else { |
| die "Unsupported Version"; |
croak "Unsupported Version $self->{version}"; |
| return; |
|
| } |
} |
| return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo}); |
return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo}); |
| } |
} |
|
|
| |
|
| my $packstr |
my $packstr |
| = ("C1" x 8) # 8 uint8s in an array for the salt |
= ("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 |
. ("C1" x 8); # and finally 8 more uint8s for the hash |
| |
|
| my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm; |
my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm; |
|
|
| { |
{ |
| my $self = shift; |
my $self = shift; |
| my $rec = shift; |
my $rec = shift; |
| my $data = shift; |
|
| my $pass = shift || $self->{password}; |
my $pass = shift || $self->{password}; |
| |
my $data = shift || $rec->{plaintext}; |
| my $ivec = shift; |
my $ivec = shift; |
| |
|
| if ( ! $pass && ! $self->{appinfo}->{key}) { |
if ( ! $pass && ! $self->{appinfo}->{key}) { |
|
|
| } |
} |
| |
|
| if ( ! $data) { |
if ( ! $data) { |
| croak("Needed parameter 'data' not passed!\n"); |
croak("Needed 'plaintext' not passed!\n"); |
| } |
} |
| |
|
| if ( $pass && ! $self->Password($pass)) { |
if ( $pass && ! $self->Password($pass)) { |
|
|
| my $encrypted; |
my $encrypted; |
| if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
| $self->{digest} ||= _calc_keys( $pass ); |
$self->{digest} ||= _calc_keys( $pass ); |
| $encrypted = _encrypt_v4($data, $acct, $self->{digest}); |
my $datav4 = { |
| $rec->{name} ||= $data->{name}; |
name => $data->{0}->{data}, |
| |
account => $data->{1}->{data}, |
| |
password => $data->{2}->{data}, |
| |
lastchange => $data->{3}->{data}, |
| |
notes => $data->{255}->{data}, |
| |
}; |
| |
my $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) { |
} 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; |
|
| } |
|
| } |
|
| |
|
| ($encrypted, $ivec) = _encrypt_v5( |
($encrypted, $ivec) = _encrypt_v5( |
| @accts, |
$data, $acct, |
| $self->{appinfo}->{key}, |
$self->{appinfo}->{key}, |
| $self->{appinfo}->{cipher}, |
$self->{appinfo}->{cipher}, |
| $ivec, |
$ivec, |
|
|
| } |
} |
| |
|
| } else { |
} else { |
| die "Unsupported Version"; |
croak "Unsupported Version $self->{version}"; |
| } |
} |
| |
|
| |
$rec->{plaintext}->{0} = $data->{0}; |
| |
|
| if ($encrypted) { |
if ($encrypted) { |
| if ($encrypted eq '1') { |
if ($encrypted eq '1') { |
| return 1; |
return 1; |
|
|
| |
|
| sub _encrypt_v4 |
sub _encrypt_v4 |
| { |
{ |
| require Crypt::CBC; |
|
| |
|
| my $new = shift; |
my $new = shift; |
| my $old = shift; |
my $old = shift; |
| my $digest = shift; |
my $digest = shift; |
|
|
| my $changed = 0; |
my $changed = 0; |
| my $need_newdate = 0; |
my $need_newdate = 0; |
| if ($old && %{ $old }) { |
if ($old && %{ $old }) { |
| |
no warnings 'uninitialized'; |
| foreach my $key (keys %{ $new }) { |
foreach my $key (keys %{ $new }) { |
| next if $key eq 'lastchange'; |
next if $key eq 'lastchange'; |
| if ($new->{$key} ne $old->{$key}) { |
if ($new->{$key} ne $old->{$key}) { |
|
|
| my $key = shift; |
my $key = shift; |
| my $cipher = shift; |
my $cipher = shift; |
| my $ivec = shift; |
my $ivec = shift; |
| my $blocksize = $CRYPTS[ $cipher ]{blocksize}; |
my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); |
| my $keylen = $CRYPTS[ $cipher ]{keylen}; |
|
| my $cipher_name = $CRYPTS[ $cipher ]{name}; |
|
| |
|
| if (! defined $ivec) { |
if (! defined $ivec) { |
| $ivec = pack("C*",map {rand(256)} 1..$blocksize); |
$ivec = pack("C*",map {rand(256)} 1..$c->{blocksize}); |
| } |
} |
| |
|
| my $changed = 0; |
my $changed = 0; |
| my $need_newdate = 1; |
my $need_newdate = 1; |
| my $date_index; |
if ($new->{3}->{data}) { |
| for (my $i = 0; $i < @{ $new }; $i++) { |
$need_newdate = 0; |
| if ( |
} |
| (exists $new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) || |
foreach my $k (keys %{ $new }) { |
| (exists $new->[$i]->{label} && $new->[$i]->{label} eq 'lastchange') |
if (! $old) { |
| ) { |
$changed = 1; |
| $date_index = $i; |
} elsif ($k == 3) { |
| if ( $old && $#{ $new } == $#{ $old } && ( |
if ($old && ( |
| $new->[$i]->{data}->{day} != $old->[$i]->{data}->{day} || |
$new->{$k}{data}{day} == $old->{$k}{data}{day} && |
| $new->[$i]->{data}->{month} != $old->[$i]->{data}->{month} || |
$new->{$k}{data}{month} == $old->{$k}{data}{month} && |
| $new->[$i]->{data}->{year} != $old->[$i]->{data}->{year} |
$new->{$k}{data}{year} == $old->{$k}{data}{year} |
| )) { |
)) { |
| $changed = 1; |
$changed = 1; |
| $need_newdate = 0; |
$need_newdate = 1; |
| last; |
|
| } |
} |
| |
|
| } elsif ($old && $#{ $new } == $#{ $old }) { |
} else { |
| my $n = join ':', %{ $new->[$i] }; |
my $n = join ':', sort %{ $new->{$k} }; |
| my $o = join ':', %{ $old->[$i] }; |
my $o = join ':', sort %{ $old->{$k} }; |
| if ($n ne $o) { |
if ($n ne $o) { |
| $changed = 1; |
$changed = 1; |
| } |
} |
| } elsif ($#{ $new } != $#{ $old }) { |
|
| $changed = 1; |
|
| } |
} |
| } |
} |
| if ($old && (! @{ $old }) && $date_index) { |
|
| $need_newdate = 0; |
|
| } |
|
| |
|
| return 1, 0 if $changed == 0; |
return 1, 0 if $changed == 0; |
| |
|
| if ($need_newdate || ! defined $date_index) { |
if ($need_newdate) { |
| my ($day, $month, $year) = (localtime)[3,4,5]; |
my ($day, $month, $year) = (localtime)[3,4,5]; |
| my $date = { |
$new->{3} = { |
| year => $year, |
label => 'lastchange', |
| month => $month, |
label_id => 3, |
| day => $day, |
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 { |
} else { |
| # XXX Need to actually validate the above information somehow |
# XXX Need to actually validate the above information somehow |
| if ($new->[$date_index]->{data}->{year} >= 1900) { |
if ($new->{3}->{data}->{year} >= 1900) { |
| $new->[$date_index]->{data}->{year} -= 1900; |
$new->{3}->{data}->{year} -= 1900; |
| } |
} |
| } |
} |
| |
|
| my $decrypted; |
my $plaintext; |
| foreach my $field (@{ $new }) { |
foreach my $k (keys %{ $new }) { |
| $decrypted .= _pack_field($field); |
$plaintext .= _pack_field($new->{$k}); |
| } |
} |
| |
|
| my $encrypted; |
my $encrypted; |
| if ($cipher_name eq 'None') { |
if ($c->{name} eq 'None') { |
| # do nothing |
# do nothing |
| $encrypted = $decrypted; |
$encrypted = $plaintext; |
| |
|
| } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') { |
} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') { |
| my $c = Crypt::CBC->new( |
require Crypt::CBC; |
| -literal_key => 1, |
my $cbc = Crypt::CBC->new( |
| -key => $key, |
-key => $key, |
| |
-literal_key => 1, |
| -iv => $ivec, |
-iv => $ivec, |
| -cipher => $cipher_name, |
-cipher => $c->{name}, |
| -keysize => $keylen, |
-keysize => $c->{keylen}, |
| -blocksize => $blocksize, |
-blocksize => $c->{blocksize}, |
| -header => 'none', |
-header => 'none', |
| -padding => 'oneandzeroes', |
-padding => 'oneandzeroes', |
| ); |
); |
|
|
| croak("Unable to set up encryption!"); |
croak("Unable to set up encryption!"); |
| } |
} |
| |
|
| $encrypted = $c->encrypt($decrypted); |
$encrypted = $cbc->encrypt($plaintext); |
| |
|
| } else { |
} else { |
| die "Unsupported Version"; |
croak "Unsupported Crypt $c->{name}"; |
| } |
} |
| |
|
| return $encrypted, $ivec; |
return $encrypted, $ivec; |
|
|
| croak("No encrypted content!"); |
croak("No encrypted content!"); |
| } |
} |
| |
|
| |
my $plaintext; |
| if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
| $self->{digest} ||= _calc_keys( $pass ); |
$self->{digest} ||= _calc_keys( $pass ); |
| my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest}); |
my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest}); |
| $acct->{name} ||= $rec->{name}; |
$plaintext = { |
| return $acct; |
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) { |
} elsif ($self->{version} == 5) { |
| my $fields = _decrypt_v5( |
$plaintext = _decrypt_v5( |
| $rec->{encrypted}, $self->{appinfo}->{key}, |
$rec->{encrypted}, $self->{appinfo}->{key}, |
| $self->{appinfo}->{cipher}, $rec->{ivec}, |
$self->{appinfo}->{cipher}, $rec->{ivec}, |
| ); |
); |
| if ($self->{options}->{v4compatible}) { |
$plaintext->{0} ||= $rec->{plaintext}->{0}; |
| my %acct; |
|
| foreach my $f (@{ $fields }) { |
|
| $acct{ $f->{label} } = $f->{data}; |
|
| } |
|
| $acct{name} ||= $rec->{name}; |
|
| return \%acct; |
|
| } else { |
|
| return $fields; |
|
| } |
|
| |
|
| } else { |
} else { |
| die "Unsupported Version"; |
croak "Unsupported Version $self->{version}"; |
| } |
} |
| |
|
| |
if ($plaintext) { |
| |
$rec->{plaintext} = $plaintext; |
| |
return $plaintext; |
| |
} |
| return; |
return; |
| } |
} |
| |
|
|
|
| my $encrypted = shift; |
my $encrypted = shift; |
| my $digest = shift; |
my $digest = shift; |
| |
|
| my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT ); |
my $plaintext = _crypt3des( $encrypted, $digest, $DECRYPT ); |
| my ( $account, $password, $notes, $packed_date ) |
my ( $account, $password, $notes, $packed_date ) |
| = split /$NULL/xm, $decrypted, 4; |
= split /$NULL/xm, $plaintext, 4; |
| |
|
| my $modified; |
my $modified; |
| if ($packed_date) { |
if ($packed_date) { |
|
|
| |
|
| sub _decrypt_v5 |
sub _decrypt_v5 |
| { |
{ |
| require Crypt::CBC; |
|
| |
|
| my $encrypted = shift; |
my $encrypted = shift; |
| my $key = shift; |
my $key = shift; |
| my $cipher = shift; |
my $cipher = shift; |
| my $ivec = shift; |
my $ivec = shift; |
| |
|
| my $keylen = $CRYPTS[ $cipher ]{keylen}; |
my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher); |
| my $cipher_name = $CRYPTS[ $cipher ]{name}; |
|
| my $blocksize = $CRYPTS[ $cipher ]{blocksize}; |
|
| |
|
| my $decrypted; |
my $plaintext; |
| |
|
| if ($cipher_name eq 'None') { |
if ($c->{name} eq 'None') { |
| # do nothing |
# do nothing |
| $decrypted = $encrypted; |
$plaintext = $encrypted; |
| |
|
| } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') { |
} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') { |
| my $c = Crypt::CBC->new( |
require Crypt::CBC; |
| -literal_key => 1, |
my $cbc = Crypt::CBC->new( |
| -key => $key, |
-key => $key, |
| |
-literal_key => 1, |
| -iv => $ivec, |
-iv => $ivec, |
| -cipher => $cipher_name, |
-cipher => $c->{name}, |
| -keysize => $keylen, |
-keysize => $c->{keylen}, |
| -blocksize => $blocksize, |
-blocksize => $c->{blocksize}, |
| -header => 'none', |
-header => 'none', |
| -padding => 'oneandzeroes', |
-padding => 'oneandzeroes', |
| ); |
); |
|
|
| if (! $c) { |
if (! $c) { |
| croak("Unable to set up encryption!"); |
croak("Unable to set up encryption!"); |
| } |
} |
| my $len = $blocksize - length($encrypted) % $blocksize; |
my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize}; |
| $encrypted .= $NULL x $len; |
$encrypted .= $NULL x $len; |
| $decrypted = $c->decrypt($encrypted); |
$plaintext = $cbc->decrypt($encrypted); |
| |
|
| } else { |
} else { |
| die "Unsupported Version"; |
croak "Unsupported Crypt $c->{name}"; |
| return; |
|
| } |
} |
| |
|
| my @fields; |
my %fields; |
| while ($decrypted) { |
while ($plaintext) { |
| my $field; |
my $field; |
| ($field, $decrypted) = _parse_field($decrypted); |
($field, $plaintext) = _parse_field($plaintext); |
| if (! $field) { |
if (! $field) { |
| last; |
last; |
| } |
} |
| push @fields, $field; |
$fields{ $field->{label_id} } = $field; |
| } |
} |
| |
|
| return \@fields; |
return \%fields; |
| } |
} |
| |
|
| # Password |
# Password |
|
|
| } |
} |
| |
|
| if ( |
if ( |
| ($self->{version} == 4 && ! exists $self->{records}) || |
($self->{version} == 4 && ! exists $self->{encpassword}) || |
| ($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash}) |
($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); |
return $self->_password_update($pass); |
| } |
} |
| |
|
| if ($new_pass) { |
if ($new_pass) { |
| my $v4compat = $self->{options}->{v4compatible}; |
|
| $self->{options}->{v4compatible} = 0; |
|
| |
|
| my @accts = (); |
my @accts = (); |
| foreach my $i (0..$#{ $self->{records} }) { |
foreach my $rec (@{ $self->{records} }) { |
| if ($self->{version} == 4 && $i == 0) { |
my $acct = $self->Decrypt($rec, $pass); |
| push @accts, undef; |
|
| next; |
|
| } |
|
| my $acct = $self->Decrypt($self->{records}->[$i], $pass); |
|
| if ( ! $acct ) { |
if ( ! $acct ) { |
| croak("Couldn't decrypt $self->{records}->[$i]->{name}"); |
croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}"); |
| } |
} |
| push @accts, $acct; |
push @accts, $acct; |
| } |
} |
|
|
| $pass = $new_pass; |
$pass = $new_pass; |
| |
|
| foreach my $i (0..$#accts) { |
foreach my $i (0..$#accts) { |
| if ($self->{version} == 4 && $i == 0) { |
|
| next; |
|
| } |
|
| delete $self->{records}->[$i]->{encrypted}; |
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; |
|
| } |
} |
| |
|
| if (defined $self->{password} && $pass eq $self->{password}) { |
if (defined $self->{password} && $pass eq $self->{password}) { |
|
|
| } |
} |
| |
|
| if ($self->{version} == 4) { |
if ($self->{version} == 4) { |
| # AFAIK the thing we use to test the password is |
my $valid = _password_verify_v4($pass, $self->{encpassword}); |
| # 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) { |
if ($valid) { |
| $self->{digest} = _calc_keys($pass); |
$self->{digest} = _calc_keys($pass); |
| if ($self->{digest} ) { |
if ($self->{digest} ) { |
|
|
| } |
} |
| } |
} |
| } elsif ($self->{version} == 5) { |
} elsif ($self->{version} == 5) { |
| return _password_verify_v5($pass, $self->{appinfo}); |
return _password_verify_v5($self->{appinfo}, $pass); |
| } else { |
} else { |
| # XXX unsupported version |
croak "Unsupported version $self->{version}"; |
| } |
} |
| |
|
| return; |
return; |
|
|
| |
|
| sub _password_verify_v5 |
sub _password_verify_v5 |
| { |
{ |
| my $pass = shift; |
|
| my $appinfo = shift; |
my $appinfo = shift; |
| |
my $pass = shift; |
| |
|
| my $salt = pack("H*", $appinfo->{salt}); |
my $salt = pack("H*", $appinfo->{salt}); |
| |
|
| |
my $c = crypts($appinfo->{cipher}) |
| |
or croak('Unknown cipher ' . $appinfo->{cipher}); |
| my ($key, $hash) = _calc_key_v5( |
my ($key, $hash) = _calc_key_v5( |
| $pass, $salt, $appinfo->{iter}, |
$pass, $salt, $appinfo->{iter}, |
| $CRYPTS[ $appinfo->{cipher} ]{keylen}, |
$c->{keylen}, |
| $CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity}, |
$c->{DES_odd_parity}, |
| ); |
); |
| |
|
| |
#print "Iter: '" . $appinfo->{iter} . "'\n"; |
| #print "Key: '". unpack("H*", $key) . "'\n"; |
#print "Key: '". unpack("H*", $key) . "'\n"; |
| |
#print "Salt: '". unpack("H*", $salt) . "'\n"; |
| #print "Hash: '". $hash . "'\n"; |
#print "Hash: '". $hash . "'\n"; |
| #print "Hash: '". $appinfo->{masterhash} . "'\n"; |
#print "Hash: '". $appinfo->{masterhash} . "'\n"; |
| |
|
|
|
| |
|
| # AFAIK the thing we use to test the password is |
# AFAIK the thing we use to test the password is |
| # always in the first entry |
# always in the first entry |
| $self->{records}->[0]->{data} = $data; |
$self->{encpassword} = $data; |
| $self->{password} = $pass; |
$self->{password} = $pass; |
| $self->{digest} = _calc_keys( $self->{password} ); |
$self->{digest} = _calc_keys( $self->{password} ); |
| |
|
|
|
| my $length = 8; |
my $length = 8; |
| my $salt = shift || pack("C*",map {rand(256)} 1..$length); |
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( |
my ($key, $hash) = _calc_key_v5( |
| $pass, $salt, $iter, |
$pass, $salt, $iter, |
| $CRYPTS[ $cipher ]->{keylen}, |
$c->{keylen}, |
| $CRYPTS[ $cipher ]->{DES_odd_parity}, |
$c->{DES_odd_parity}, |
| ); |
); |
| |
|
| $appinfo->{salt} = unpack "H*", $salt; |
$appinfo->{salt} = unpack "H*", $salt; |
| $appinfo->{iter} = $iter; |
$appinfo->{iter} = $iter; |
| $appinfo->{cipher} = $cipher; |
$appinfo->{cipher} = $cipher; |
| |
|
| $appinfo->{key} = $key; |
|
| $appinfo->{masterhash} = $hash; |
$appinfo->{masterhash} = $hash; |
| |
$appinfo->{key} = $key; |
| |
|
| return $key; |
return $key; |
| } |
} |
| |
|
| |
sub Unlock |
| |
{ |
| |
my $self = shift; |
| |
my ($pass) = @_; |
| |
$pass ||= $self->{password}; |
| |
|
| |
if ( $pass && ! $self->Password($pass)) { |
| |
croak("Invalid Password!\n"); |
| |
} |
| |
|
| |
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 |
# Helpers |
| |
|
| sub _calc_keys |
sub _calc_keys |
|
|
| import Digest::SHA1 qw(sha1); |
import Digest::SHA1 qw(sha1); |
| |
|
| my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 ); |
my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 ); |
| if ($dop) { $key = DES_odd_parity($key); } |
if ($dop) { $key = _DES_odd_parity($key); } |
| |
|
| my $hash = unpack("H*", substr(sha1($key.$salt),0, 8)); |
my $hash = unpack("H*", substr(sha1($key.$salt),0, 8)); |
| |
|
|
|
| { |
{ |
| my $field = shift; |
my $field = shift; |
| |
|
| my @labels; |
my ($len) = unpack "n", $field; |
| $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) { |
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; |
| if ($len % 2) { # && $len + 4 < length $field) { |
if ($len % 2) { |
| # trim the 0/1 byte padding for next even address. |
# trim the 0/1 byte padding for next even address. |
| $offset++; |
$offset++; |
| $unpackstr .= ' x' |
$unpackstr .= ' x' |
|
|
| my ($label, $font, $data) = unpack $unpackstr, $field; |
my ($label, $font, $data) = unpack $unpackstr, $field; |
| my $leftover = substr $field, $offset; |
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); |
$data = _parse_keyring_date($data); |
| } |
} |
| return { |
return { |
| #len => $len, |
#len => $len, |
| label => $labels[ $label ] || $label, |
label => $label, |
| label_id => $label, |
label_id => $label_id, |
| font => $font, |
font => $font, |
| data => $data, |
data => $data, |
| }, $leftover; |
}, $leftover; |
|
|
| { |
{ |
| my $field = shift; |
my $field = shift; |
| |
|
| my %labels = ( |
my $packed; |
| name => 0, |
if (defined $field) { |
| account => 1, |
my $label = $field->{label_id} || 0; |
| password => 2, |
if (defined $field->{label} && ! $label) { |
| lastchange => 3, |
$label = $field->{label}; |
| notes => 255, |
} |
| ); |
|
| |
|
| my $label = $field->{label_id} || $labels{ $field->{label} }; |
my $l = labels($field->{label}); |
| my $font = $field->{font} || 0; |
if ($l) { |
| my $data = $field->{data} || ''; |
$label = $l->{id}; |
| |
} |
| |
|
| if ($label == 3) { |
my $font = $field->{font} || 0; |
| $data = _pack_keyring_date($data); |
my $data = defined $field->{data} ? $field->{data} : $EMPTY; |
| } |
|
| my $len = length $data; |
|
| my $packstr = "S1 C1 C1 A*"; |
|
| |
|
| 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) { |
$packed = pack $packstr, ($len, $label, $font, $data); |
| # add byte padding for next even address. |
|
| $packed .= $NULL; |
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; |
return $packed; |
|
|
| $year -= 4; |
$year -= 4; |
| $month++; |
$month++; |
| |
|
| return pack 'n', $day | ($month << 5) | ($year << 9); |
return pack 'n*', $day | ($month << 5) | ($year << 9); |
| } |
} |
| |
|
| |
|
|
|
| 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 = ( |
|
|
| It has the standard Palm::PDB methods with 2 additional public methods. |
It has the standard Palm::PDB methods with 2 additional public methods. |
| Decrypt and Encrypt. |
Decrypt and Encrypt. |
| |
|
| It currently supports the v4 Keyring databases. |
It currently supports the v4 Keyring databases as well as |
| The pre-release v5 databases are mostly supported. There are definitely some |
the pre-release v5 databases. I am not completely happy with the interface |
| bugs, For example, t/keyring5.t sometimes fails. I am not sure why yet. |
for accessing v5 databases, so any suggestions on improvements on |
| |
the interface are appreciated. |
| |
|
| This module doesn't store the decrypted content. It only keeps it until it |
This module doesn't store the plaintext content. It only keeps it until it |
| returns it to you or encrypts it. |
returns it to you or encrypts it. |
| |
|
| =head1 SYNOPSIS |
=head1 SYNOPSIS |
|
|
| my $pdb = new Palm::PDB; |
my $pdb = new Palm::PDB; |
| $pdb->Load($file); |
$pdb->Load($file); |
| |
|
| foreach (0..$#{ $pdb->{records} }) { |
foreach my $rec (@{ $pdb->{records} }) { |
| # skip the password record for version 4 databases |
my $plaintext = $pdb->Decrypt($rec, $pass); |
| next if $_ == 0 && $pdb->{version} == 4; |
print $plaintext->{0}->{data}, ' - ', $plaintext->{1}->{data}, "\n"; |
| my $rec = $pdb->{records}->[$_]; |
|
| my $acct = $pdb->Decrypt($rec, $pass); |
|
| print $rec->{name}, ' - ', $acct->{account}, "\n"; |
|
| } |
} |
| |
|
| =head1 SUBROUTINES/METHODS |
=head1 SUBROUTINES/METHODS |
|
|
| $pdb = new Palm::Keyring({ key1 => value1, key2 => value2 }); |
$pdb = new Palm::Keyring({ key1 => value1, key2 => value2 }); |
| $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 |
=over |
| |
|
| =item password |
=item password |
|
|
| |
|
| The version of database to create. Accepts either 4 or 5. Currently defaults to 4. |
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 |
=item cipher |
| |
|
| The cipher to use. 0, 1, 2 or 3. |
The cipher to use. Either the number or the name. |
| |
|
| 0 => None |
0 => None |
| 1 => DES_EDE3 |
1 => DES_EDE3 |
|
|
| |
|
| The number of iterations to encrypt with. |
The number of iterations to encrypt with. |
| |
|
| |
=item options |
| |
|
| |
A hashref of the options that are set |
| |
|
| =back |
=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<Palm::StdAppInfo> |
| |
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. |
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. |
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); |
my $c = Palm::Keyring::crypt($cipher); |
| |
|
| $c is now: |
$c is now: |
|
|
| $c = { |
$c = { |
| alias => (None|DES_EDE3|AES128|AES256), |
alias => (None|DES_EDE3|AES128|AES256), |
| name => (None|DES_EDE3|Rijndael), |
name => (None|DES_EDE3|Rijndael), |
| keylen => <key length of the ciphe>, |
keylen => <key length of the cipher>, |
| blocksize => <block size of the cipher>, |
blocksize => <block size of the cipher>, |
| default_iter => <default iterations for the cipher>, |
default_iter => <default iterations for the cipher>, |
| }; |
}; |
| |
|
| |
If it is unable to find the crypt it will return undef. |
| |
|
| |
=head2 labels |
| |
|
| |
Pass in the id or the name of the label; |
| |
|
| |
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 |
=head2 Encrypt |
| |
|
| $pdb->Encrypt($rec, $acct[, $password[, $ivec]]); |
$pdb->Encrypt($rec[, $password[, $plaintext[, $ivec]]]); |
| |
|
| Encrypts an account into a record, either with the password previously |
Encrypts an account into a record, either with the password previously |
| used, or with a password that is passed. |
used, or with a password that is passed. |
|
|
| randomly. |
randomly. |
| |
|
| $rec is a record from $pdb->{records} or a new_Record(). |
$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 = { |
$plaintext = { |
| name => $rec->{name}, |
0 => { |
| account => $account, |
label => 'name', |
| password => $password, |
label_id => 0, |
| notes => $notes, |
font => 0, |
| lastchange => { |
data => $name, |
| year => 107, # years since 1900 |
1 => { |
| month => 0, # 0-11, 0 = January, 11 = December |
label => 'account', |
| day => 30, # 1-31, same as localtime |
label_id => 1, |
| |
font => 0, |
| |
data => $account, |
| }, |
}, |
| }; |
2 => { |
| |
label => 'password', |
| The v5 $acct is an arrayref full of hashrefs that contain each encrypted field. |
label_id => 2, |
| |
font => 0, |
| my $v5acct = [ |
data => $password, |
| { |
|
| 'label_id' => 2, |
|
| 'data' => 'abcd1234', |
|
| 'label' => 'password', |
|
| 'font' => 0 |
|
| }, |
}, |
| { |
3 => { |
| 'label_id' => 3, |
label => 'lastchange', |
| 'data' => { |
label_id => 3, |
| 'month' => 1, |
font => 0, |
| 'day' => 11, |
data => $lastchange, |
| 'year' => 107 |
|
| }, |
|
| 'label' => 'lastchange', |
|
| 'font' => 0 |
|
| }, |
}, |
| { |
255 => { |
| 'label_id' => 255, |
label => 'notes', |
| 'data' => 'This is a short note.', |
label_id => 255, |
| 'label' => 'notes', |
font => 0, |
| 'font' => 0 |
data => $notes, |
| } |
}, |
| ]; |
}; |
| |
|
| |
The account name is also stored in $rec->{plaintext}->{0}->{data} for both v4 |
| |
and v5 databases. |
| |
|
| The account name is stored in $rec->{name} for both v4 and v5 databases. |
$rec->{plaintext}->{0} => { |
| It is not returned in the decrypted information for v5. |
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 |
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. |
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 |
If you pass in a lastchange field that is different than the one in the |
| record, it will honor what you passed in. |
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 |
=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 |
Decrypts the record and returns a reference for the plaintext account as |
| under Encrypt(). |
described under L<Encrypt>. |
| |
Also sets $rec->{plaintext} with the same information as $plaintext as |
| |
described in L<Encrypt>. |
| |
|
| foreach (0..$#{ $pdb->{records}) { |
foreach my $rec (@{ $pdb->{records} }) { |
| next if $_ == 0 && $pdb->{version} == 4; |
my $plaintext = $pdb->Decrypt($rec); |
| my $rec = $pdb->{records}->[$_]; |
# do something with $plaintext |
| my $acct = $pdb->Decrypt($rec); |
|
| # do something with $acct |
|
| } |
} |
| |
|
| |
|
|
|
| |
|
| If nothing is passed, it forgets the password that it was remembering. |
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 L<Encrypt> any of the records before clearing them, so if |
| |
you are not careful you will lose information. |
| |
|
| |
B<CAVEAT!> 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 |
=head1 DEPENDENCIES |
| |
|
| Palm::StdAppInfo |
Palm::StdAppInfo |
| |
|
| |
B<For v4 databases> |
| |
|
| Digest::MD5 |
Digest::MD5 |
| |
|
| Crypt::DES |
Crypt::DES |
| |
|
| Readonly |
B<For v5 databases> |
| |
|
| |
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 |
=head1 THANKS |
| |
|
| I would like to thank the helpful Perlmonk shigetsu who gave me some great advice |
I would like to thank the helpful Perlmonk shigetsu who gave me some great |
| and helped me get my first module posted. L<http://perlmonks.org/?node_id=596998> |
advice and helped me get my first module posted. |
| |
L<http://perlmonks.org/?node_id=596998> |
| |
|
| I would also like to thank |
I would also like to thank |
| Johan Vromans |
Johan Vromans |
|
|
| as giving me some very helpful hints about doing a few things that I was |
as giving me some very helpful hints about doing a few things that I was |
| unsure of. He is really great. |
unsure of. He is really great. |
| |
|
| |
And finally, |
| |
thanks to Jochen Hoenicke E<lt>hoenicke@gmail.comE<gt> |
| |
(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 |
=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. |
| |
|
| |
I am not very happy with the data structures used by Encrypt() and |
| |
Decrypt() for v5 databases, but I am not sure of a better way. |
| |
|
| |
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. I need |
| |
to fix all that before it is a 1.0 candidate. |
| |
|
| Please report any bugs or feature requests to |
Please report any bugs or feature requests to |
| C<bug-palm-keyring at rt.cpan.org>, or through the web interface at |
C<bug-palm-keyring at rt.cpan.org>, or through the web interface at |