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.28 and 1.35

version 1.28, 2007/02/18 05:50:25

version 1.35, 2007/02/22 04:11:35

Line 1

package Palm::Keyring;

# $RedRiver: Keyring.pm,v 1.27 2007/02/10 16:21:28 andrew Exp $

# $RedRiver: Keyring.pm,v 1.34 2007/02/21 05:24:14 andrew Exp $

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

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

Line 16

use warnings;

use Carp;

$Carp::Verbose = 1;

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;

my $ENCRYPT = 1;

my $DECRYPT = 0;

my $MD5_CBLOCK = 64;

Line 35

Line 29

my $NULL = chr 0;

my @CRYPTS = (

{ # None

{

alias => 'None',

name => 'None',

keylen => 8,

blocksize => 1,

default_iter => 500,

{ # DES-EDE3

{

alias => 'DES-EDE3',

name => 'DES_EDE3',

keylen => 24,

blocksize => 8,

DES_odd_parity => 1,

default_iter => 1000,

{ # AES128

{

alias => 'AES128',

name => 'Rijndael',

keylen => 16,

blocksize => 16,

default_iter => 100,

{ # AES256

{

alias => 'AES256',

name => 'Rijndael',

keylen => 32,

blocksize => 16,

default_iter => 250,

);

Line 72

Line 74

}

# CGI style arguments

elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {

elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {

my %tmp = @_;

while ( my($key,$value) = each %tmp) {

$key =~ s/^-//;

Line 103

Line 105

# Set options

$self->{options} = $options;

# Set defaults

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

$self->{options}->{cipher} ||= 0; # 'None'

$self->{options}->{iterations} ||=

$CRYPTS[ $self->{options}->{cipher} ]{default_iter};

$self->{appinfo}->{cipher} ||= $self->{options}->{cipher};

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

};

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

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

}

Line 116

Line 128

return 1;

}

# PackRecord

# Accessors

sub crypts

{

my $crypt = shift;

if ($crypt =~ /\D/) {

foreach my $c (@CRYPTS) {

if ($c->{alias} eq $crypt) {

return $c;

}

# didn't find it.

return;

} else {

return $CRYPTS[$crypt];

}

# ParseRecord

sub ParseRecord

{

my $self = shift;

Line 137

Line 167

delete $rec->{data};

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

my $blocksize = $self->{appinfo}->{blocksize};

my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};

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

my ($ivec, $encrypted) = unpack "A$blocksize A*", $extra;

my $ivec = substr $extra, 0, $blocksize;

my $encrypted = substr $extra, $blocksize;

if ($self->{options}->{v4compatible}) {

$rec->{name} = $field->{data};

} else {

$rec->{name} = $field;

}

$rec->{ivec} = $ivec;

$rec->{encrypted} = $encrypted;

delete $rec->{data};

} else {

# XXX Unsupported version!

die 'Unsupported Version';

return;

}

return $rec;

}

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

Line 189

Line 201

delete $rec->{name};

delete $rec->{encrypted};

}

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

# XXX do something

my $field = {

'label_id' => 1,

'data' => $rec->{name},

'font' => 0,

};

my $packed .= _pack_field($field);

$rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};

} else {

# XXX Unsupported version!

die 'Unsupported Version';

return;

}

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

}

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

Line 238

Line 245

_parse_appinfo_v5($appinfo) || return;

} else {

# XXX Unknown version

die "Unsupported Version";

return;

}

Line 256

Line 263

my $unpackstr

= ("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

my (@salt, $iter, $cipher, @hash);

Line 266

Line 273

$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};

Line 287

Line 290

# Nothing to do for v4

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

croak("Unsupported version!");

_pack_appinfo_v5($self->{appinfo});

#$self->{appinfo}{other} = <pack application-specific data>;

} else {

# XXX Unknown version

die "Unsupported Version";

return;

}

return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});

}

sub _pack_appinfo_v5

{

my $appinfo = shift;

my $packstr

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

. ("n1" x 2) # the iter (uint16) and the cipher (uint16)

. ("C1" x 8); # and finally 8 more uint8s for the hash

my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm;

my @hash = map { hex $_ } $appinfo->{masterhash} =~ /../gxm;

my $packed = pack($packstr,

@salt,

$appinfo->{iter},

$appinfo->{cipher},

@hash

);

$appinfo->{other} = $packed;

return $appinfo

}

# Encrypt

sub Encrypt

Line 304

Line 330

my $rec = shift;

my $data = shift;

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

my $ivec = shift;

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

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

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

}

Line 317

Line 344

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

}

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

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

croak("Incorrect Password!\n");

}

my $acct;

if ($rec->{encrypted}) {

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

}

my $encrypted;

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

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

my $acct = {};

$encrypted = _encrypt_v4($data, $acct, $self->{digest});

if ($rec->{encrypted}) {

$rec->{name} ||= $data->{name};

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

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

}

my $encrypted = _encrypt_v4($data, $self->{digest}, $acct);

if ($encrypted) {

($encrypted, $ivec) = _encrypt_v5(

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

@accts,

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

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

$rec->{name} ||= $data->{name};

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

$rec->{encrypted} = $encrypted;

$ivec,

);

if (defined $ivec) {

$rec->{ivec} = $ivec;

}

} else {

die "Unsupported Version";

}

if ($encrypted) {

if ($encrypted eq '1') {

return 1;

}

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

croak("Unsupported version!");

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

return _encrypt_v5(

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

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

$rec->{encrypted} = $encrypted;

$self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},

);

return 1;

} else {

# XXX Unsupported version!

return;

}

return;

}

sub _encrypt_v4

{

my $data = shift;

my $new = shift;

my $old = shift;

my $digest = shift;

my $acct = shift;

$data->{account} ||= $EMPTY;

$new->{account} ||= $EMPTY;

$data->{password} ||= $EMPTY;

$new->{password} ||= $EMPTY;

$data->{notes} ||= $EMPTY;

$new->{notes} ||= $EMPTY;

my $changed = 0;

my $need_newdate = 0;

if (%{ $acct }) {

if ($old && %{ $old }) {

foreach my $key (keys %{ $data }) {

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

next if $key eq 'lastchange';

if ($data->{$key} ne $acct->{$key}) {

if ($new->{$key} ne $old->{$key}) {

$changed = 1;

last;

}

if ( exists $data->{lastchange} && exists $acct->{lastchange} && (

if ( exists $new->{lastchange} && exists $old->{lastchange} && (

$data->{lastchange}->{day} != $acct->{lastchange}->{day} ||

$new->{lastchange}->{day} != $old->{lastchange}->{day} ||

$data->{lastchange}->{month} != $acct->{lastchange}->{month} ||

$new->{lastchange}->{month} != $old->{lastchange}->{month} ||

$data->{lastchange}->{year} != $acct->{lastchange}->{year}

$new->{lastchange}->{year} != $old->{lastchange}->{year}

)) {

$changed = 1;

$need_newdate = 0;

Line 387

Line 446

my ($day, $month, $year);

if ($data->{lastchange} && ! $need_newdate ) {

if ($new->{lastchange} && ! $need_newdate ) {

$day = $data->{lastchange}->{day} || 1;

$day = $new->{lastchange}->{day} || 1;

$month = $data->{lastchange}->{month} || 0;

$month = $new->{lastchange}->{month} || 0;

$year = $data->{lastchange}->{year} || 0;

$year = $new->{lastchange}->{year} || 0;

# XXX Need to actually validate the above information somehow

if ($year >= 1900) {

Line 404

Line 463

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

}

my $packeddate = _pack_keyring_date( {

my $packed_date = _pack_keyring_date( {

year => $year,

month => $month,

day => $day,

});

my $plaintext = join $NULL,

$data->{account}, $data->{password}, $data->{notes}, $packeddate;

$new->{account}, $new->{password}, $new->{notes}, $packed_date;

return _crypt3des( $plaintext, $digest, $ENCRYPT );

}

sub _encrypt_v5

{

my $new = shift;

my $old = shift;

my $key = shift;

my $cipher = shift;

my $ivec = shift;

my $blocksize = $CRYPTS[ $cipher ]{blocksize};

my $keylen = $CRYPTS[ $cipher ]{keylen};

my $cipher_name = $CRYPTS[ $cipher ]{name};

if (! defined $ivec) {

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

}

my $changed = 0;

my $need_newdate = 1;

my $date_index;

for (my $i = 0; $i < @{ $new }; $i++) {

if (

(exists $new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) ||

(exists $new->[$i]->{label} && $new->[$i]->{label} eq 'lastchange')

) {

$date_index = $i;

if ( $old && $#{ $new } == $#{ $old } && (

$new->[$i]->{data}->{day} != $old->[$i]->{data}->{day} ||

$new->[$i]->{data}->{month} != $old->[$i]->{data}->{month} ||

$new->[$i]->{data}->{year} != $old->[$i]->{data}->{year}

)) {

$changed = 1;

$need_newdate = 0;

last;

}

} elsif ($old && $#{ $new } == $#{ $old }) {

my $n = join ':', %{ $new->[$i] };

my $o = join ':', %{ $old->[$i] };

if ($n ne $o) {

$changed = 1;

}

} elsif ($#{ $new } != $#{ $old }) {

$changed = 1;

}

if ($old && (! @{ $old }) && $date_index) {

$need_newdate = 0;

}

return 1, 0 if $changed == 0;

if ($need_newdate || ! defined $date_index) {

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

my $date = {

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 {

# XXX Need to actually validate the above information somehow

if ($new->[$date_index]->{data}->{year} >= 1900) {

$new->[$date_index]->{data}->{year} -= 1900;

}

my $decrypted;

foreach my $field (@{ $new }) {

$decrypted .= _pack_field($field);

}

my $encrypted;

if ($cipher_name eq 'None') {

# do nothing

$encrypted = $decrypted;

} elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {

require Crypt::CBC;

my $c = Crypt::CBC->new(

-key => $key,

-literal_key => 1,

-iv => $ivec,

-cipher => $cipher_name,

-keysize => $keylen,

-blocksize => $blocksize,

-header => 'none',

-padding => 'oneandzeroes',

);

if (! $c) {

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

}

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

} else {

die "Unsupported Version";

}

return $encrypted, $ivec;

}

# Decrypt

sub Decrypt

{

my $self = shift;

my $rec = shift;

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

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

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

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

}

Line 432

Line 599

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

}

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

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

croak("Invalid Password!\n");

}

Line 445

Line 612

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

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

$self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},

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

);

if ($self->{options}->{v4compatible}) {

my %acct;

Line 460

Line 628

} else {

return $fields;

}

} else {

# XXX Unsupported version!

die "Unsupported Version";

}

return;

}

Line 472

Line 641

my $digest = shift;

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

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

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

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

my $modified;

if ($packeddate) {

if ($packed_date) {

$modified = _parse_keyring_date($packeddate);

$modified = _parse_keyring_date($packed_date);

}

return {

Line 490

Line 659

sub _decrypt_v5

{

my $encrypted = shift;

my $ivec = shift;

my $key = shift;

my $keylen = shift;

my $cipher = shift;

my $ivec = shift;

my $keylen = $CRYPTS[ $cipher ]{keylen};

my $cipher_name = $CRYPTS[ $cipher ]{name};

my $blocksize = $CRYPTS[ $cipher ]{blocksize};

my $decrypted;

if ($cipher eq 'None') {

if ($cipher_name eq 'None') {

# do nothing

$decrypted = $encrypted;

} elsif ($cipher eq 'DES_EDE3' or $cipher eq 'Rijndael') {

} elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {

my $c = _setup_cipher_v5($ivec, $key, $keylen, $cipher);

require Crypt::CBC;

my $c = Crypt::CBC->new(

-key => $key,

-literal_key => 1,

-iv => $ivec,

-cipher => $cipher_name,

-keysize => $keylen,

-blocksize => $blocksize,

-header => 'none',

-padding => 'oneandzeroes',

);

if (! $c) {

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

}

$encrypted .= $NULL x $keylen; # pad out a keylen

my $len = $blocksize - length($encrypted) % $blocksize;

$encrypted .= $NULL x $len;

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

} else {

# XXX Unknown encryption

die "Unsupported Version";

return;

}

Line 538

Line 723

if (! $pass) {

delete $self->{password};

delete $self->{appinfo}->{key};

return 1;

}

if (! exists $self->{records}) {

if (

# Give the PDB the first record that will hold the encrypted password

($self->{version} == 4 && ! exists $self->{records}) ||

$self->{records} = [ $self->new_Record ];

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

}

if ($new_pass) {

my $v4compat = $self->{options}->{v4compatible};

$self->{options}->{v4compatible} = 0;

my @accts = ();

foreach my $i (0..$#{ $self->{records} }) {

if ($i == 0) {

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

push @accts, undef;

next;

}

Line 568

Line 762

$pass = $new_pass;

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

next if $i == 0;

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

next;

}

delete $self->{records}->[$i]->{encrypted};

$self->Encrypt($self->{records}->[$i], $accts[$i], $pass);

}

$self->{options}->{v4compatible} = $v4compat;

}

if (defined $self->{password} && $pass eq $self->{password}) {

Line 584

Line 782

# 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} ) {

Line 593

Line 791

}

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

$self->{key} = _password_verify_v5($pass, $self->{appinfo});

return _password_verify_v5($self->{appinfo}, $pass);

return 1 if $self->{key};

} else {

# XXX unsupported version

}

Line 604

Line 801

sub _password_verify_v4

{

require Digest::MD5;

import Digest::MD5 qw(md5);

my $pass = shift;

my $data = shift;

Line 621

Line 821

my $digest = md5($msg);

if (! $data eq $salt . $digest ) {

if ($data ne $salt . $digest ) {

return;

}

Line 630

Line 830

sub _password_verify_v5

{

my $pass = shift;

my $appinfo = shift;

my $pass = shift;

my $salt = pack("H*", $appinfo->{salt});

my $key = _pbkdf2(

my ($key, $hash) = _calc_key_v5(

$pass, $salt, $appinfo->{iter}, $appinfo->{keylen}, \&hmac_sha1

$pass, $salt, $appinfo->{iter},

$CRYPTS[ $appinfo->{cipher} ]{keylen},

$CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity},

);

if ($appinfo->{DES_odd_parity}) {

$key = DES_odd_parity($key);

}

my $newhash = unpack("H*", substr(sha1($key.$salt),0, 8));

#print "Iter: '" . $appinfo->{iter} . "'\n";

#print "Key: '". unpack("H*", $key) . "'\n";

#print "Hash: '". $newhash . "'\n";

#print "Salt: '". unpack("H*", $salt) . "'\n";

#print "Hash: '". $hash . "'\n";

#print "Hash: '". $appinfo->{masterhash} . "'\n";

if ($appinfo->{masterhash} eq $newhash) {

if ($appinfo->{masterhash} eq $hash) {

$appinfo->{key} = $key;

} else {

return;

}

return $key;

}

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

# password, and that would suck!

my $self = shift;

my $pass = shift;

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

my $data = _password_update_v4($pass, @_);

if (! $data) {

carp("Failed to update password!");

return;

}

# AFAIK the thing we use to test the password is

# always in the first entry

$self->{records}->[0]->{data} = $data;

$self->{password} = $pass;

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

return 1;

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

my $cipher = shift || $self->{appinfo}->{cipher};

my $iter = shift || $self->{appinfo}->{iter};

my $salt = shift || 0;

my $hash = _password_update_v5(

$self->{appinfo}, $pass, $cipher, $iter, $salt

);

if (! $hash) {

carp("Failed to update password!");

return;

}

return 1;

} else {

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

}

return;

}

sub _password_update_v4

{

require Digest::MD5;

import Digest::MD5 qw(md5);

my $pass = shift;

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

my $salt;

for ( 1 .. $kSalt_Size ) {

$salt .= chr int rand 255;

}

my $msg = $salt . $pass;

$msg .= "\0" x ( $MD5_CBLOCK - length $msg );

my $digest = md5($msg);

my $data = $salt . $digest; # . "\0";

return $data;

}

sub _password_update_v5

{

my $appinfo = shift;

my $pass = shift;

my $cipher = shift;

my $iter = shift;

# I thought this needed to be 'blocksize', but apparently not.

#my $length = $CRYPTS[ $cipher ]{blocksize};

my $length = 8;

my $salt = shift || pack("C*",map {rand(256)} 1..$length);

my ($key, $hash) = _calc_key_v5(

$pass, $salt, $iter,

$CRYPTS[ $cipher ]->{keylen},

$CRYPTS[ $cipher ]->{DES_odd_parity},

);

$appinfo->{salt} = unpack "H*", $salt;

$appinfo->{iter} = $iter;

$appinfo->{cipher} = $cipher;

$appinfo->{key} = $key;

$appinfo->{masterhash} = $hash;

return $key;

}

# Helpers

sub _calc_keys

{

my $pass = shift;

Line 682

Line 983

return $digest;

}

sub _calc_key_v5

{

my ($pass, $salt, $iter, $keylen, $dop) = @_;

require Digest::HMAC_SHA1;

import Digest::HMAC_SHA1 qw(hmac_sha1);

require Digest::SHA1;

import Digest::SHA1 qw(sha1);

my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );

if ($dop) { $key = DES_odd_parity($key); }

my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));

return $key, $hash;

}

sub _crypt3des

{

require Crypt::DES;

my ( $plaintext, $passphrase, $flag ) = @_;

$passphrase .= $SPACE x ( 16 * 3 );

Line 731

Line 1051

return $cyphertext;

}

# V5 helpers

sub _setup_cipher_v5

{

my $ivec = shift;

my $key = shift;

my $keylen = shift;

my $cipher = shift;

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;

Line 762

Line 1062

$labels[3] = 'lastchange';

$labels[255] = 'notes';

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

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

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

return undef, $field;

}

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

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

if ($len % 2) {

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

if ($len % 2) { # && $len + 4 < length $field) {

# trim the 0/1 byte padding for next even address.

$offset++;

$unpackstr .= ' x'

}

$unpackstr .= ' A*';

my (undef, $label, $font, $data, $leftover)

my ($label, $font, $data) = unpack $unpackstr, $field;

= unpack $unpackstr, $field;

my $leftover = substr $field, $offset;

if ($label == 3) {

$data = _parse_keyring_date($data);

Line 788

Line 1089

}, $leftover;

}

# All version helpers

sub _pack_field

sub _password_update

{

my $field = shift;

# It is very important to Encrypt after calling this

my %labels = (

# (Although it is generally only called by Encrypt)

name => 0,

# because otherwise the data will be out of sync with the

account => 1,

# password, and that would suck!

password => 2,

my $self = shift;

lastchange => 3,

my $pass = shift;

notes => 255,

);

# XXX have to separate this out to v4 and v5 sections.

my $label = $field->{label_id} || $labels{ $field->{label} };

die "Unsupported version" unless $self->{version} == 4;

my $font = $field->{font} || 0;

my $data = $field->{data} || '';

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

if ($label == 3) {

$data = _pack_keyring_date($data);

}

my $len = length $data;

my $packstr = "n1 C1 C1 A*";

my $salt;

my $packed = pack $packstr, ($len, $label, $font, $data);

for ( 1 .. $kSalt_Size ) {

$salt .= chr int rand 255;

if ($len % 2) {

# add byte padding for next even address.

$packed .= $NULL;

}

my $msg = $salt . $pass;

return $packed;

}

$msg .= "\0" x ( $MD5_CBLOCK - length $msg );

sub _parse_keyring_date

{

my $data = shift;

my $digest = md5($msg);

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

my $data = $salt . $digest; # . "\0";

return {

year => $year,

month => $month || 0,

day => $day || 1,

};

}

# AFAIK the thing we use to test the password is

sub _pack_keyring_date

# always in the first entry

{

$self->{records}->[0]->{data} = $data;

my $d = shift;

my $year = $d->{year};

my $month = $d->{month};

my $day = $d->{day};

$self->{password} = $pass;

$year -= 4;

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

$month++;

return 1;

return pack 'n', $day | ($month << 5) | ($year << 9);

}

sub _hexdump

{

my $prefix = shift; # What to print in front of each line

Line 931

Line 1254

__END__

=head1 NAME

Palm::Keyring - Handler for Palm Keyring databases.

Line 945

Line 1267

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

Decrypt and Encrypt.

It currently supports the v4 Keyring databases. The v5 databases from

It currently supports the v4 Keyring databases.

the pre-release keyring-2.0 are not supported.

The pre-release v5 databases are mostly supported. There are definitely some

bugs, For example, t/keyring5.t sometimes fails. I am not sure why yet.

This module doesn't store the decrypted content. It only keeps it until it

returns it to you or encrypts it.

Line 962

Line 1285

$pdb->Load($file);

foreach (0..$#{ $pdb->{records} }) {

next if $_ = 0; # skip the password record

# skip the password record for version 4 databases

next if $_ == 0 && $pdb->{version} == 4;

my $rec = $pdb->{records}->[$_];

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

print $rec->{name}, ' - ', $acct->{account}, "\n";

Line 972

Line 1296

=head2 new

$pdb = new Palm::Keyring([$password]);

$pdb = new Palm::Keyring([$password[, $version]]);

Create a new PDB, initialized with the various Palm::Keyring fields

and an empty record list.

Line 983

Line 1307

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

password.

new() now also takes options in other formats

$pdb = new Palm::Keyring({ key1 => value1, key2 => value2 });

$pdb = new Palm::Keyring( -key1 => value1, -key2 => value2);

=head3 Supported options are:

=over

=item password

The password used to initialize the database

=item version

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

The cipher to use. 0, 1, 2 or 3.

0 => None

1 => DES_EDE3

2 => AES128

3 => AES256

=item iterations

The number of iterations to encrypt with.

=back

=head2 crypt

Pass in the alias of the crypt to use, or the index.

This is a function, not a method.

my $c = Palm::Keyring::crypt($cipher);

$c is now:

$c = {

alias => (None|DES_EDE3|AES128|AES256),

name => (None|DES_EDE3|Rijndael),

keylen => <key length of the ciphe>,

blocksize => <block size of the cipher>,

default_iter => <default iterations for the cipher>,

};

=head2 Encrypt

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

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

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

used, or with a password that is passed.

$ivec is the initialization vector to use to encrypt the record. This is

not used by v4 databases. Normally this is not passed and is generated

randomly.

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

$acct is a hashref in the format below.

The v4 $acct is a hashref in the format below.

my $acct = {

my $v4acct = {

name => $rec->{name},

account => $account,

password => $password,

Line 1005

Line 1389

};

The v5 $acct is an arrayref full of hashrefs that contain each encrypted field.

my $v5acct = [

{

'label_id' => 2,

'data' => 'abcd1234',

'label' => 'password',

'font' => 0

{

'label_id' => 3,

'data' => {

'month' => 1,

'day' => 11,

'year' => 107

'label' => 'lastchange',

'font' => 0

{

'label_id' => 255,

'data' => 'This is a short note.',

'label' => 'notes',

'font' => 0

}

];

The account name is stored in $rec->{name} for both v4 and v5 databases.

It is not returned in the decrypted information for v5.

$rec->{name} = 'account name';

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.

Line 1017

Line 1434

my $acct = $pdb->Decrypt($rec[, $password]);

Decrypts the record and returns a hashref for the account as described

Decrypts the record and returns a reference for the account as described

under Encrypt().

foreach (0..$#{ $pdb->{records}) {

next if $_ == 0;

next if $_ == 0 && $pdb->{version} == 4;

my $rec = $pdb->{records}->[$_];

my $acct = $pdb->Decrypt($rec[, $password]);

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

# do something with $acct

}

=head2 Password

$pdb->Password([$password[, $new_password]]);

Line 1090

Line 1508

The Keyring for Palm OS website:

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

The HACKING guide for palm keyring databases:

L<http://gnukeyring.cvs.sourceforge.net/*checkout*/gnukeyring/keyring/HACKING>

Johan Vromans also has a wxkeyring app that now uses this module, available

from his website at L<http://www.vromans.org/johan/software/sw_palmkeyring.html>

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