palm/Palm-Keyring/lib/Palm/Keyring.pm - diff

Return to Keyring.pm CVS log

Up to [local] / palm / Palm-Keyring / lib / Palm

Diff for /palm/Palm-Keyring/lib/Palm/Keyring.pm between version 1.47 and 1.63

version 1.47, 2007/09/12 01:30:10

version 1.63, 2011/09/18 00:45:33

Line 1

package Palm::Keyring;

# $RedRiver: Keyring.pm,v 1.46 2007/08/10 04:13:31 andrew Exp $

# $RedRiver: Keyring.pm,v 1.61 2008/09/19 05:55:35 andrew Exp $

########################################################################

# Keyring.pm *** Perl class for Keyring for Palm OS databases.

Line 15

use strict;

use warnings;

require 5.006_001;

use Carp;

use base qw/ Palm::StdAppInfo /;

Line 83

Line 85

);

our $VERSION = '0.96_01';

our $VERSION = '0.96_07';

sub new

{

Line 108

Line 110

else {

$options->{password} = shift;

$options->{version} = shift;

$options->{cipher} = shift;

}

Line 139

Line 142

$self->{appinfo}->{iter} ||= $self->{options}->{iterations};

};

if ( defined $options->{file} ) {

$self->Load($options->{file});

}

if ( defined $options->{password} ) {

$self->Password($options->{password});

}

Line 217

Line 224

}

my $rc = $self->SUPER::Write(@_);

my @rc = $self->SUPER::Write(@_);

if ($self->{version} == 4) {

shift @{ $self->{records} };

}

return $rc;

return @rc;

}

# ParseRecord

Line 233

Line 240

my $self = shift;

my $rec = $self->SUPER::ParseRecord(@_);

return $rec if ! exists $rec->{data};

return $rec if !(defined $rec->{data} && length $rec->{data} );

if ($self->{version} == 4) {

# skip the first record because it contains the password.

Line 241

Line 248

$self->{encpassword} = $rec->{data};

return '__DELETE_ME__';

}

if ($self->{records}->[0] eq '__DELETE_ME__') {

shift @{ $self->{records} };

}

Line 249

Line 256

my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2;

return $rec if ! $encrypted;

$rec->{decrypted}->{0} = {

$rec->{plaintext}->{0} = {

label => 'name',

label_id => 0,

data => $name,

Line 265

Line 272

my ($field, $extra) = _parse_field($rec->{data});

delete $rec->{data};

$rec->{decrypted}->{0} = $field;

$rec->{plaintext}->{0} = $field;

$rec->{ivec} = substr $extra, 0, $blocksize;

$rec->{encrypted} = substr $extra, $blocksize;

} else {

# XXX Can never get here to test, ParseAppInfoBlock is always run

# XXX first by Load().

croak "Unsupported Version $self->{version}";

return;

}

return $rec;

Line 286

Line 294

if ($self->{version} == 4) {

if ($rec->{encrypted}) {

my $name = $rec->{decrypted}->{0}->{data} || $EMPTY;

my $name = $rec->{plaintext}->{0}->{data} || $EMPTY;

$rec->{data} = join $NULL, $name, $rec->{encrypted};

delete $rec->{decrypted};

delete $rec->{encrypted};

}

} elsif ($self->{version} == 5) {

croak 'No encrypted data in record' if !defined $rec->{encrypted};

croak 'No ivec!' if !$rec->{ivec};

my $field;

if ($rec->{decrypted}->{0}) {

if ($rec->{plaintext}->{0}) {

$field = $rec->{decrypted}->{0};

$field = $rec->{plaintext}->{0};

} else {

$field = {

'label' => 'name',

Line 311

Line 320

} else {

croak "Unsupported Version $self->{version}";

}

# XXX Should I?

delete $rec->{plaintext};

delete $rec->{encrypted};

croak 'No data in record to pack' if !$rec->{data};

return $self->SUPER::PackRecord($rec, @_);

}

Line 338

Line 352

# Nothing extra for version 4

} elsif ($self->{version} == 5) {

_parse_appinfo_v5($appinfo) || return;

_parse_appinfo_v5($appinfo);

} else {

croak "Unsupported Version $self->{version}";

Line 351

Line 365

{

my $appinfo = shift;

if (! exists $appinfo->{other}) {

croak 'Corrupt appinfo? no {other}' if ! $appinfo->{other};

# XXX Corrupt appinfo?

return;

}

my $unpackstr

= ("C1" x 8) # 8 uint8s in an array for the salt

Line 422

Line 433

{

my $self = shift;

my $rec = shift;

my $data = shift;

my $pass = shift || $self->{password};

if ( !$rec ) {

croak('Needed parameter [record] not passed!');

}

my $data = shift || $rec->{plaintext};

my $ivec = shift;

if ( ! $pass && ! $self->{appinfo}->{key}) {

croak("password not set!\n");

croak('password not set!');

}

if ( ! $rec) {

croak("Needed parameter 'record' not passed!\n");

}

if ( ! $data) {

croak("Needed parameter 'data' not passed!\n");

croak('Needed parameter [plaintext] not passed!');

}

if ( $pass && ! $self->Password($pass)) {

croak("Incorrect Password!\n");

croak('Incorrect Password!');

}

my $acct;

Line 467

Line 480

$encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});

} elsif ($self->{version} == 5) {

($encrypted, $ivec) = _encrypt_v5(

($encrypted, $rec->{ivec}) = _encrypt_v5(

$data, $acct,

$self->{appinfo}->{key},

$self->{appinfo}->{cipher},

$ivec,

);

if (defined $ivec) {

$rec->{ivec} = $ivec;

}

} else {

croak "Unsupported Version $self->{version}";

croak "Unsupported version $self->{version}";

}

$rec->{decrypted}->{0} = $data->{0};

$rec->{plaintext}->{0} = $data->{0};

if ($encrypted) {

if ($encrypted ne '1') {

if ($encrypted eq '1') {

return 1;

}

$rec->{attributes}{Dirty} = 1;

$rec->{attributes}{dirty} = 1;

$rec->{encrypted} = $encrypted;

return 1;

} else {

return;

}

return 1;

}

sub _encrypt_v4

Line 578

Line 582

my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);

if (! defined $ivec) {

$ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});

while (! $ivec) {

$ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});

}

my $changed = 0;

Line 608

Line 614

}

return 1, 0 if $changed == 0;

return (1, $ivec) if $changed == 0;

if ($need_newdate) {

my ($day, $month, $year) = (localtime)[3,4,5];

Line 629

Line 635

}

my $decrypted;

my $plaintext;

foreach my $k (keys %{ $new }) {

$decrypted .= _pack_field($new->{$k});

next if $new->{$k}->{label_id} == 0;

$plaintext .= _pack_field($new->{$k});

}

$plaintext .= chr(0xff) x 2;

my $encrypted;

if ($c->{name} eq 'None') {

# do nothing

$encrypted = $decrypted;

$encrypted = $plaintext;

} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {

require Crypt::CBC;

Line 656

Line 664

croak("Unable to set up encryption!");

}

$encrypted = $cbc->encrypt($decrypted);

$encrypted = $cbc->encrypt($plaintext);

} else {

croak "Unsupported Crypt $c->{name}";

Line 689

Line 697

croak("No encrypted content!");

}

my $plaintext;

if ($self->{version} == 4) {

$self->{digest} ||= _calc_keys( $pass );

my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});

return {

$plaintext = {

0 => $rec->{decrypted}->{0},

0 => $rec->{plaintext}->{0},

1 => {

label => 'account',

label_id => 1,

Line 721

Line 730

};

} elsif ($self->{version} == 5) {

my $decrypted = _decrypt_v5(

$plaintext = _decrypt_v5(

$rec->{encrypted}, $self->{appinfo}->{key},

$self->{appinfo}->{cipher}, $rec->{ivec},

);

$decrypted->{0} ||= $rec->{decrypted}->{0};

$plaintext->{0} ||= $rec->{plaintext}->{0};

return $decrypted;

} else {

croak "Unsupported Version $self->{version}";

}

if ($plaintext) {

$rec->{plaintext} = $plaintext;

return $plaintext;

}

return;

}

Line 739

Line 752

my $encrypted = shift;

my $digest = shift;

my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );

my $plaintext = _crypt3des( $encrypted, $digest, $DECRYPT );

my ( $account, $password, $notes, $packed_date )

= split /$NULL/xm, $decrypted, 4;

= split /$NULL/xm, $plaintext, 4;

my $modified;

if ($packed_date) {

Line 766

Line 779

my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);

my $decrypted;

my $plaintext;

if ($c->{name} eq 'None') {

# do nothing

$decrypted = $encrypted;

$plaintext = $encrypted;

} elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {

require Crypt::CBC;

Line 790

Line 803

}

my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};

$encrypted .= $NULL x $len;

$decrypted = $cbc->decrypt($encrypted);

$plaintext = $cbc->decrypt($encrypted);

} else {

croak "Unsupported Crypt $c->{name}";

}

my %fields;

while ($decrypted) {

while ($plaintext) {

my $field;

($field, $decrypted) = _parse_field($decrypted);

($field, $plaintext) = _parse_field($plaintext);

if (! $field) {

last;

}

Line 835

Line 848

foreach my $rec (@{ $self->{records} }) {

my $acct = $self->Decrypt($rec, $pass);

if ( ! $acct ) {

croak("Couldn't decrypt $rec->{decrypted}->{0}->{data}");

croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");

}

push @accts, $acct;

}

Line 847

Line 860

foreach my $i (0..$#accts) {

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

}

Line 885

Line 899

my $pass = shift;

my $data = shift;

if (! $pass) { croak('No password specified!'); };

if (! $pass) { croak('No password specified!'); }

if (! $data) { croak("No encrypted password in file!"); }

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

Line 1037

Line 1049

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

sub _calc_keys

{

require Digest::MD5;

import Digest::MD5 qw(md5);

my $pass = shift;

if (! defined $pass) { croak('No password defined!'); };

Line 1137

Line 1185

my ($len) = unpack "n", $field;

if ($len + 4 > length $field) {

return undef, $field;

return (undef, $field);

}

my $unpackstr = "x2 C1 C1 A$len";

my $offset = 2 +1 +1 +$len;

Line 1246

Line 1294

my $maxlines = shift; # Max # of lines to dump

my $offset; # Offset of current chunk

my @lines;

for ($offset = 0; $offset < length($data); $offset += 16)

{

my $hex; # Hex values of the data

Line 1260

Line 1310

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

Line 1271

Line 1322

my $maxlines = shift; # Max # of lines to dump

my $offset; # Offset of current chunk

my @lines;

for ($offset = 0; $offset < length($data); $offset += 8)

{

my $bin; # binary values of the data

Line 1285

Line 1338

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

Line 1298

Line 1352

# keylen is length of generated key in bytes

# prf is the pseudo random function (e.g. hmac_sha1)

# returns the key.

sub _pbkdf2($$$$$)

sub _pbkdf2

{

my ($password, $salt, $iter, $keylen, $prf) = @_;

my ($k, $t, $u, $ui, $i);

Line 1314

Line 1368

return substr($t, 0, $keylen);

}

sub _DES_odd_parity($) {

sub _DES_odd_parity {

my $key = $_[0];

my ($r, $i);

my @odd_parity = (

Line 1352

Line 1406

parses Keyring for Palm OS databases. See

L<http://gnukeyring.sourceforge.net/>.

It has the standard Palm::PDB methods with 2 additional public methods.

It has the standard Palm::PDB methods with 4 additional public methods.

Decrypt and Encrypt.

Unlock, Lock, Decrypt and Encrypt.

It currently supports the v4 Keyring databases as well as

the pre-release v5 databases. I am not completely happy with the interface

the pre-release v5 databases.

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

returns it to you or encrypts it.

=head1 SYNOPSIS

use Palm::PDB;

Line 1373

Line 1422

my $pdb = new Palm::PDB;

$pdb->Load($file);

$pdb->Unlock($pass);

foreach my $rec (@{ $pdb->{records} }) {

my $acct = $pdb->Decrypt($rec, $pass);

print $rec->{plaintext}->{0}->{data}, ' - ',

print $acct->{0}->{data}, ' - ', $acct->{1}->{data}, "\n";

$rec->{plaintext}->{1}->{data}, "\n";

}

$pdb->Lock();

=head1 SUBROUTINES/METHODS

=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

and an empty record list.

Line 1390

Line 1441

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

If you pass in a password, it will initalize the database with the encrypted

password.

new() now also takes options in other formats

Line 1414

Line 1465

=item cipher

The cipher to use. Either the number or the name.

The cipher to use. Either the number or the name. Only used by v5 datbases.

0 => None

1 => DES_EDE3

Line 1423

Line 1474

=item iterations

The number of iterations to encrypt with.

The number of iterations to encrypt with. Only used by somy crypts in v5 databases.

=item options

=item file

A hashref of the options that are set

The name of a file to Load(). This will override many of the other options.

=back

Line 1468

Line 1519

=head2 labels

Pass in the id or the name of the label;

Pass in the id or the name of the label. The label id is used as a key

to the different parts of the records.

See Encrypt() for details on where the label is used.

This is a function, not a method.

Line 1492

Line 1545

=head2 Encrypt

$pdb->Encrypt($rec, $acct[, $password[, $ivec]]);

=head3 B<!!! IMPORTANT !!!> The order of the arguments to Encrypt has

changed. $password and $plaintext used to be swapped. They changed

because you can now set $rec->{plaintext} and not pass in $plaintext so

$password is more important.

$pdb->Encrypt($rec[, $password[, $plaintext[, $ivec]]]);

Encrypts an account into a record, either with the password previously

used, or with a password that is passed.

Line 1502

Line 1560

randomly.

$rec is a record from $pdb->{records} or a new_Record().

The $acct is a hashref in the format below.

$rec->{plaintext} is a hashref in the format below.

my $acct = {

$plaintext = {

0 => {

label => 'name',

label_id => 0,

Line 1526

Line 1584

label => 'lastchange',

label_id => 3,

font => 0,

data => $lastchange,

data => {

year => $year, # usually the year - 1900

mon => $mon, # range 0-11

day => $day, # range 1-31

255 => {

label => 'notes',

Line 1536

Line 1598

};

The account name is also stored in $rec->{decrypted}->{0}->{data} for both v4

The account name is stored in $rec->{plaintext}->{0}->{data} for both v4

and v5 databases.

and v5 databases even when the record has not been Decrypt()ed.

$rec->{decrypted}->{0} => {

$rec->{plaintext}->{0} => {

label => 'name',

label_id => 0,

font => 0,

Line 1552

Line 1614

If you pass in a lastchange field that is different than the one in the

record, it will honor what you passed in.

You can either set $rec->{plaintext} or pass in $plaintext. $plaintext

is used over anything in $rec->{plaintext}.

=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 Encrypt().

Also sets $rec->{plaintext} with the same information as $plaintext as

described in Encrypt().

foreach my $rec (@{ $pdb->{records} }) {

my $acct = $pdb->Decrypt($rec);

my $plaintext = $pdb->Decrypt($rec);

# do something with $acct

# do something with $plaintext

}

Line 1602

Line 1669

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

Line 1698

Line 1797

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 v4 compatibility mode does not insert a fake record 0 where

normally the encrypted password is stored.

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

Nothing initializes a lasterr method or anything like that.

to fix all that before it is a 1.0 candidate.

This module does not do anything special with the plaintext data. It SHOULD

treat it somehow special so that it can't be found in RAM or in a swap file

anywhere. I don't have a clue how to do this.

I need to fix all this before it is a 1.0 candidate.

Please report any bugs or feature requests to

C<bug-palm-keyring at rt.cpan.org>, or through the web interface at

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>