| version 1.7, 2006/11/10 16:45:42 | version 1.15, 2007/01/29 02:49:41 | 
|  |  | 
| # Palm::Keyring.pm | package Palm::Keyring; | 
|  |  | 
|  | # $RedRiver: Keyring.pm,v 1.14 2007/01/28 22:24:17 andrew Exp $ | 
| # | # | 
| # Perl class for dealing with Keyring for Palm OS databases. | # Perl class for dealing with Keyring for Palm OS databases. | 
| # | # | 
| #       Copyright (C) 2004, Andrew Fresh |  | 
| #       You may distribute this file under the terms of the Artistic |  | 
| #       License, as specified in the README file distributed with the p5-Palm distribution. |  | 
| # |  | 
| #   This started as Memo.pm, I just made it work for Keyring. | #   This started as Memo.pm, I just made it work for Keyring. | 
| # |  | 
| # $Id$ |  | 
| # $RedRiver: Keyring.pm,v 1.6 2006/11/10 16:18:59 andrew Exp $ |  | 
|  |  | 
| use strict; | use strict; | 
| package Palm::Keyring; | use warnings; | 
| use Palm::Raw(); | use Carp; | 
| use Palm::StdAppInfo(); |  | 
| use vars qw( $VERSION @ISA ); |  | 
|  |  | 
|  | use base qw/ Palm::StdAppInfo /; | 
|  |  | 
| use Digest::MD5 qw(md5); | use Digest::MD5 qw(md5); | 
| use Crypt::DES; | use Crypt::DES; | 
|  | use Readonly; | 
|  |  | 
| use constant ENCRYPT    =>  1; | Readonly my $ENCRYPT    => 1; | 
| use constant DECRYPT    =>  0; | Readonly my $DECRYPT    => 0; | 
| use constant MD5_CBLOCK => 64; | Readonly my $MD5_CBLOCK => 64; | 
| my $kSaltSize = 4; | Readonly my $kSalt_Size => 4; | 
|  | Readonly my $EMPTY      => q{}; | 
|  | Readonly my $SPACE      => q{ }; | 
|  | Readonly my $NULL       => chr 0; | 
|  |  | 
|  |  | 
| # One liner, to allow MakeMaker to work. | # One liner, to allow MakeMaker to work. | 
| $VERSION = do { my @r = (q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; | our ($VERSION) = q$Revision$ =~ m{ Revision: \s+ (\S+) }xm; | 
|  |  | 
| @ISA = qw( Palm::StdAppInfo Palm::Raw ); | #@ISA = qw( Palm::StdAppInfo Palm::Raw ); | 
|  |  | 
| =head1 NAME | sub new { | 
|  | my $classname = shift; | 
|  | my $pass      = shift; | 
|  |  | 
| Palm::Keyring - Handler for Palm Keyring databases. | # Create a generic PDB. No need to rebless it, though. | 
|  | my $self = $classname->SUPER::new(@_); | 
|  |  | 
| =head1 SYNOPSIS | $self->{'name'}    = 'Keys-Gtkr';    # Default | 
|  | $self->{'creator'} = 'Gtkr'; | 
|  | $self->{'type'}    = 'Gkyr'; | 
|  |  | 
| use Palm::Keyring; | # The PDB is not a resource database by | 
| $pdb->Decrypt('mypassword'); | # default, but it's worth emphasizing, | 
|  | # since MemoDB is explicitly not a PRC. | 
|  | $self->{'attributes'}{'resource'} = 0; | 
|  |  | 
| =head1 DESCRIPTION | # Initialize the AppInfo block | 
|  | $self->{'appinfo'} = {}; | 
|  |  | 
| The Keyring PDB handler is a helper class for the Palm::PDB package. It | # Add the standard AppInfo block stuff | 
| parses Keyring databases.  See | Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} ); | 
| L<http://gnukeyring.sourceforge.net/>. |  | 
|  |  | 
| It is just the standard Palm::Raw with 2 additional public methods.  Decrypt and Encrypt. | # Set the version | 
|  | $self->{'version'} = 4; | 
|  |  | 
| =cut | # Give the PDB the first record that will hold the encrypted password | 
| =head2 new | $self->{'records'} = [ $self->new_Record ]; | 
|  |  | 
| $pdb = new Palm::Keyring ('password'); | if ( defined $pass ) { | 
|  | $self->Encrypt($pass); | 
|  | } | 
|  |  | 
| Create a new PDB, initialized with the various Palm::Keyring fields | return $self; | 
| and an empty record list. | } | 
|  |  | 
| Use this method if you're creating a Keyring PDB from scratch. | sub import { | 
|  | Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], ); | 
|  | return 1; | 
|  | } | 
|  |  | 
| =cut | sub Load { | 
| #' | my $self     = shift; | 
| sub new | my $filename = shift; | 
| { | my $password = shift; | 
| my $classname   = shift; |  | 
| my $pass = shift; |  | 
|  |  | 
| # Create a generic PDB. No need to rebless it, though. | $self->{'appinfo'} = {}; | 
| my $self        = $classname->SUPER::new(@_); | $self->{'records'} = []; | 
|  | $self->SUPER::Load($filename); | 
|  |  | 
| $self->{name} = "Keys-Gtkr";    # Default | foreach my $rec ( @{ $self->{'records'} } ) { | 
| $self->{creator} = "Gtkr"; | if ( ! exists $rec->{'data'}) { next; }; | 
| $self->{type} = "Gkyr"; | my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; | 
| # The PDB is not a resource database by | if ( ! $encrypted ) { next }; | 
| # default, but it's worth emphasizing, | $rec->{'plaintext'}->{'name'} = $name; | 
| # since MemoDB is explicitly not a PRC. | $rec->{'encrypted'} = $encrypted; | 
| $self->{attributes}{resource} = 0; | } | 
|  |  | 
| # Initialize the AppInfo block | return $self->Decrypt($password) if defined $password; | 
| $self->{appinfo} = {}; |  | 
|  |  | 
| # Add the standard AppInfo block stuff | return 1; | 
| &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo}); | } | 
|  |  | 
| # Set the version | sub Write { | 
| $self->{version} = 4; | my $self     = shift; | 
|  | my $filename = shift; | 
|  | my $password = shift; | 
|  |  | 
| # Give the PDB the first record that will hold the encrypted password | $self->Encrypt($password) || return; | 
| $self->{records} = [ { | return $self->SUPER::Write($filename); | 
| 'category'   => 0, | } | 
| 'attributes' => { |  | 
| 'private' => 1, |  | 
| 'Secret'  => 1, |  | 
| 'Dirty'   => 1, |  | 
| 'dirty'   => 1, |  | 
| }, |  | 
| }, ]; |  | 
|  |  | 
| if ($pass) { | sub Encrypt { | 
| $self->Encrypt($pass); | my $self = shift; | 
| } | my $pass = shift; | 
|  |  | 
| return $self; | if ($pass) { | 
| } | if ( | 
|  | !( exists $self->{'records'}->[0]->{'data'} | 
|  | && $self->_keyring_verify($pass) ) | 
|  | ) | 
|  | { | 
|  |  | 
| sub import | # This would encrypt with a new password. | 
| { | # First decrypting everything with the old password of course. | 
| &Palm::PDB::RegisterPDBHandlers(__PACKAGE__, | $self->_keyring_update($pass) || return; | 
| [ "Gtkr", "Gkyr" ], | $self->_keyring_verify($pass) || return; | 
| ); | } | 
|  | } | 
|  |  | 
|  | $self->{'digest'} ||= _calc_keys( $self->{'password'} ); | 
|  |  | 
|  | foreach my $rec ( @{ $self->{'records'} } ) { | 
|  | if (!defined $rec->{'plaintext'}) { next; }; | 
|  |  | 
|  | my $name = | 
|  | defined $rec->{'plaintext'}->{'name'} | 
|  | ? $rec->{'plaintext'}->{'name'} | 
|  | : $EMPTY; | 
|  | my $account = | 
|  | defined $rec->{'plaintext'}->{'account'} | 
|  | ? $rec->{'plaintext'}->{'account'} | 
|  | : $EMPTY; | 
|  | my $password = | 
|  | defined $rec->{'plaintext'}->{'password'} | 
|  | ? $rec->{'plaintext'}->{'password'} | 
|  | : $EMPTY; | 
|  | my $description = | 
|  | defined $rec->{'plaintext'}->{'description'} | 
|  | ? $rec->{'plaintext'}->{'description'} | 
|  | : $EMPTY; | 
|  | my $extra = $EMPTY; | 
|  |  | 
|  | my $plaintext = join "$NULL", $account, $password, $description, $extra; | 
|  |  | 
|  | my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT ); | 
|  |  | 
|  | $rec->{'data'} = join "$NULL", $name, $encrypted; | 
|  | } | 
|  |  | 
|  | return 1; | 
| } | } | 
|  |  | 
| sub Load | sub Decrypt { | 
| { | my $self = shift; | 
| my $self = shift; | my $pass = shift; | 
| $self->SUPER::Load(@_); |  | 
|  |  | 
| foreach my $record (@{ $self->{records} }) { | if ($pass) { | 
| next unless exists $record->{data}; | $self->_keyring_verify($pass) || return; | 
| my ($name, $encrypted) = split /\000/, $record->{data}, 2; | } | 
| next unless $encrypted; |  | 
| $record->{plaintext}->{name} = $name; | $self->{'digest'} ||= _calc_keys( $self->{'password'} ); | 
| $record->{encrypted} = $encrypted; |  | 
| } | my $reccount = 0; | 
| 1; | foreach my $rec ( @{ $self->{'records'} } ) { | 
|  | $reccount++; | 
|  |  | 
|  | # always skip the first record that has the password in it. | 
|  | next if $reccount <= 1; | 
|  | if ( ! defined $rec->{'data'} ) { | 
|  | warn 'Invalid record ' . ( $reccount - 1 ) . "\n"; | 
|  | next; | 
|  | } | 
|  |  | 
|  | my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; | 
|  | if (! $encrypted) { next; }; | 
|  |  | 
|  | $rec->{'plaintext'}->{'name'} = $name; | 
|  |  | 
|  | my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT ); | 
|  | my ( $account, $password, $description, $extra ) = split /$NULL/xm, | 
|  | $decrypted, 4; | 
|  |  | 
|  | $rec->{'plaintext'}->{'account'} = defined $account ? $account : $EMPTY; | 
|  | $rec->{'plaintext'}->{'password'} = | 
|  | defined $password ? $password : $EMPTY; | 
|  | $rec->{'plaintext'}->{'description'} = | 
|  | defined $description ? $description : $EMPTY; | 
|  |  | 
|  | #print "Name:      '$name'\n"; | 
|  | #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n"; | 
|  | #print "    Hex:   '" . unpack("H*", $encrypted) . "'\n"; | 
|  | #print "    Binary:'" . unpack("b*", $encrypted) . "'\n"; | 
|  | #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n"; | 
|  | #print "    Hex:   '" . unpack("H*", $decrypted) . "'\n"; | 
|  | #print "    Binary:'" . unpack("b*", $decrypted) . "'\n"; | 
|  | #print "\n"; | 
|  | #print "Extra: $extra\n"; | 
|  | #exit; | 
|  | #-------------------------------------------------- | 
|  | # print "Account:     $account\n"; | 
|  | # print "Password:    $password\n"; | 
|  | # print "Description: $description\n"; | 
|  | #-------------------------------------------------- | 
|  |  | 
|  | } | 
|  |  | 
|  | return 1; | 
| } | } | 
|  |  | 
| sub Write | sub _calc_keys { | 
| { | my $pass = shift; | 
| my $self = shift; | if (! defined $pass) { croak('No password defined!'); }; | 
| $self->Encrypt() || return undef; |  | 
| return $self->SUPER::Load(@_); | my $digest = md5($pass); | 
|  |  | 
|  | my ( $key1, $key2 ) = unpack 'a8a8', $digest; | 
|  |  | 
|  | #-------------------------------------------------- | 
|  | # print "key1: $key1: ", length $key1, "\n"; | 
|  | # print "key2: $key2: ", length $key2, "\n"; | 
|  | #-------------------------------------------------- | 
|  |  | 
|  | $digest = unpack 'H*', $key1 . $key2 . $key1; | 
|  |  | 
|  | #-------------------------------------------------- | 
|  | # print "Digest: ", $digest, "\n"; | 
|  | # print length $digest, "\n"; | 
|  | #-------------------------------------------------- | 
|  |  | 
|  | return $digest; | 
| } | } | 
|  |  | 
| sub Encrypt | sub _keyring_verify { | 
| { | my $self = shift; | 
| my $self = shift; | my $pass = shift; | 
| my $pass = shift; |  | 
|  |  | 
|  | if (! $pass) { croak('No password specified!'); }; | 
|  |  | 
| if ($pass) { | # AFAIK the thing we use to test the password is | 
| unless ($self->_keyring_verify($pass) ) { | #     always in the first entry | 
| # This would encrypt with a new password. | my $data = $self->{'records'}->[0]->{'data'}; | 
| # First decrypting everything with the old password of course. |  | 
| $self->_keyring_update($pass) || return undef; |  | 
| $self->_keyring_verify($pass) || return undef; |  | 
| } |  | 
| } |  | 
|  |  | 
| $self->{digest} ||= _calc_keys($self->{password}); | #die "No encrypted password in file!" unless defined $data; | 
|  | if (! defined $data) { return; }; | 
|  |  | 
| foreach my $record (@{ $self->{records} }) { | $data =~ s/$NULL$//xm; | 
| next unless defined $record->{plaintext}; |  | 
|  |  | 
| my $name        = defined $record->{plaintext}->{name}        ? | my $salt = substr $data, 0, $kSalt_Size; | 
| $record->{plaintext}->{name}        : ''; |  | 
| my $account     = defined $record->{plaintext}->{account}     ? |  | 
| $record->{plaintext}->{account}     : ''; |  | 
| my $password    = defined $record->{plaintext}->{password}    ? |  | 
| $record->{plaintext}->{password}    : ''; |  | 
| my $description = defined $record->{plaintext}->{description} ? |  | 
| $record->{plaintext}->{description} : ''; |  | 
| my $extra       = ''; |  | 
|  |  | 
| my $plaintext = join("\000", $account, $password, $description, $extra); | my $msg = $salt . $pass; | 
|  |  | 
| my $encrypted = _crypt3des($plaintext, $self->{digest}, ENCRYPT); | $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); | 
|  |  | 
| $record->{data} = join("\000", $name, $encrypted); | my $digest = md5($msg); | 
| } |  | 
|  |  | 
| return 1; | if ( $data eq $salt . $digest ) { | 
|  |  | 
|  | # May as well generate the keys we need now, since we know the password is right | 
|  | $self->{'digest'} = _calc_keys($pass); | 
|  | if ( $self->{'digest'} ) { | 
|  | $self->{'password'} = $pass; | 
|  | return 1; | 
|  | } | 
|  | } | 
|  | return; | 
| } | } | 
|  |  | 
| sub Decrypt | sub _keyring_update { | 
| { |  | 
| my $self = shift; |  | 
| my $pass = shift; |  | 
|  |  | 
| if ($pass) { | # It is very important to Encrypt after calling this | 
| $self->_keyring_verify($pass) || return undef; | #     (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; | 
|  |  | 
| $self->{digest} ||= _calc_keys($self->{password}); | if (! $pass) { croak('No password specified!'); }; | 
|  |  | 
| foreach my $record (@{ $self->{records} }) { | # if the database already has a password in it | 
| next unless defined $record->{data}; | if ( $self->{'records'}->[0]->{'data'} ) { | 
|  |  | 
| my ($name, $encrypted) = split /\000/, $record->{data}, 2; | # Make sure everything is decrypted before we update the keyring | 
| next unless $encrypted; | $self->Decrypt() || return; | 
|  | } | 
|  |  | 
| $record->{plaintext}->{name} = $name; | my $salt; | 
|  | for ( 1 .. $kSalt_Size ) { | 
|  | $salt .= chr int rand 255; | 
|  | } | 
|  |  | 
| my $decrypted = _crypt3des($encrypted, $self->{digest}, DECRYPT); | my $msg = $salt . $pass; | 
| my ($account, $password, $description, $extra) |  | 
| = split /\000/, $decrypted, 4; |  | 
|  |  | 
| $record->{plaintext}->{account}     = defined $account     ? | $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); | 
| $account     : ''; |  | 
| $record->{plaintext}->{password}    = defined $password    ? |  | 
| $password    : ''; |  | 
| $record->{plaintext}->{description} = defined $description ? |  | 
| $description : ''; |  | 
|  |  | 
| #print "Name:      '$name'\n"; | my $digest = md5($msg); | 
| #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n"; |  | 
| #print "    Hex:   '" . unpack("H*", $encrypted) . "'\n"; |  | 
| #print "    Binary:'" . unpack("b*", $encrypted) . "'\n"; |  | 
| #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n"; |  | 
| #print "    Hex:   '" . unpack("H*", $decrypted) . "'\n"; |  | 
| #print "    Binary:'" . unpack("b*", $decrypted) . "'\n"; |  | 
| #print "\n"; |  | 
| #print "Extra: $extra\n"; |  | 
| #exit; |  | 
| #-------------------------------------------------- |  | 
| # print "Account:     $account\n"; |  | 
| # print "Password:    $password\n"; |  | 
| # print "Description: $description\n"; |  | 
| #-------------------------------------------------- |  | 
|  |  | 
| } | my $data = $salt . $digest;    # . "\0"; | 
|  |  | 
| return 1; | # 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; | 
| } | } | 
|  |  | 
| sub _calc_keys | sub _crypt3des { | 
| { | my ( $plaintext, $passphrase, $flag ) = @_; | 
| my $pass = shift; |  | 
| die "No password defined!" unless defined $pass; |  | 
|  |  | 
| my $digest = md5($pass); | $passphrase   .= $SPACE x ( 16 * 3 ); | 
|  | my $cyphertext = $EMPTY; | 
|  |  | 
| my ($key1, $key2) = unpack('a8a8', $digest); | my $size = length $plaintext; | 
| #-------------------------------------------------- |  | 
| # print "key1: $key1: ", length $key1, "\n"; |  | 
| # print "key2: $key2: ", length $key2, "\n"; |  | 
| #-------------------------------------------------- |  | 
|  |  | 
| $digest = unpack('H*', $key1 . $key2 . $key1); | #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n"; | 
| #-------------------------------------------------- |  | 
| # print "Digest: ", $digest, "\n"; |  | 
| # print length $digest, "\n"; |  | 
| #-------------------------------------------------- |  | 
|  |  | 
| return $digest; | my @C; | 
|  | for ( 0 .. 2 ) { | 
|  | $C[$_] = | 
|  | new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 )); | 
|  | } | 
|  |  | 
|  | for ( 0 .. ( ($size) / 8 ) ) { | 
|  | my $pt = substr $plaintext, $_ * 8, 8; | 
|  |  | 
|  | #print "PT: '$pt' - Length: " . length($pt) . "\n"; | 
|  | if (! length $pt) { next; }; | 
|  | if ( (length $pt) < 8 ) { | 
|  | if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; | 
|  | my $len = 8 - (length $pt); | 
|  |  | 
|  | #print "LENGTH: $len\n"; | 
|  | #print "Binary:    '" . unpack("b*", $pt) . "'\n"; | 
|  | $pt .= ($NULL x $len); | 
|  |  | 
|  | #print "PT: '$pt' - Length: " . length($pt) . "\n"; | 
|  | #print "Binary:    '" . unpack("b*", $pt) . "'\n"; | 
|  | } | 
|  | if ( $flag == $ENCRYPT ) { | 
|  | $pt = $C[0]->encrypt($pt); | 
|  | $pt = $C[1]->decrypt($pt); | 
|  | $pt = $C[2]->encrypt($pt); | 
|  | } | 
|  | else { | 
|  | $pt = $C[0]->decrypt($pt); | 
|  | $pt = $C[1]->encrypt($pt); | 
|  | $pt = $C[2]->decrypt($pt); | 
|  | } | 
|  |  | 
|  | #print "PT: '$pt' - Length: " . length($pt) . "\n"; | 
|  | $cyphertext .= $pt; | 
|  | } | 
|  |  | 
|  | $cyphertext =~ s/$NULL+$//xm; | 
|  |  | 
|  | #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n"; | 
|  |  | 
|  | return $cyphertext; | 
| } | } | 
|  |  | 
| sub _keyring_verify | 1; | 
| { | __END__ | 
| my $self = shift; |  | 
| my $pass = shift; |  | 
|  |  | 
| die "No password specified!" unless $pass; | =head1 NAME | 
| $self->{password} = $pass; |  | 
|  |  | 
| # AFAIK the thing we use to test the password is | Palm::Keyring - Handler for Palm Keyring databases. | 
| #     always in the first entry |  | 
| my $data = $self->{records}->[1]->{data}; |  | 
| #die "No encrypted password in file!" unless defined $data; |  | 
| return undef unless defined $data; |  | 
|  |  | 
| $data =~ s/\0$//; | =head1 DESCRIPTION | 
|  |  | 
| my $salt = substr($data, 0, $kSaltSize); | The Keyring PDB handler is a helper class for the Palm::PDB package. It | 
|  | parses Keyring for Palm OS databases.  See | 
|  | L<http://gnukeyring.sourceforge.net/>. | 
|  |  | 
| my $msg = $salt . $pass; | It has the standard Palm::PDB methods with 2 additional public methods. | 
|  | Decrypt and Encrypt. | 
|  |  | 
| $msg .= "\0" x (MD5_CBLOCK - length($msg)); | It currently supports the v4 Keyring databases.  The v5 databases from the pre-release keyring-2.0 are not supported. | 
|  |  | 
| my $digest = md5($msg); | =head1 SYNOPSIS | 
|  |  | 
| if ($data eq $salt . $digest) { | use Palm::PDB; | 
| # May as well generate the keys we need now, since we know the password is right | use Palm::Keyring; | 
| $self->{digest} = _calc_keys($self->{password}); | my $pdb = new Palm::PDB; | 
| if ($self->{digest}) { | $pdb->Load($file); | 
| return 1; | foreach my $rec (@{ $pdb->{'records'} }) { | 
| } else { | print "$rec->{'plaintext'}->{'name'}\n"; | 
| return undef; |  | 
| } |  | 
| } else { |  | 
| return undef; |  | 
| } | } | 
| } | $pdb->Decrypt($password); | 
|  | # do something with the decrypted parts | 
|  |  | 
| sub _keyring_update | =head1 SUBROUTINES/METHODS | 
| { |  | 
| # 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; |  | 
|  |  | 
| die "No password specified!" unless $pass; | =head2 new | 
|  |  | 
| # if the database already has a password in it | $pdb = new Palm::Keyring([$password]); | 
| if ($self->{records}->[1]->{data}) { |  | 
| # Make sure everything is decrypted before we update the keyring |  | 
| $self->Decrypt() || return undef; |  | 
| } |  | 
|  |  | 
| my $salt; | Create a new PDB, initialized with the various Palm::Keyring fields | 
| for (1..$kSaltSize) { | and an empty record list. | 
| $salt .= chr(int(rand(255))); |  | 
| } |  | 
|  |  | 
| my $msg = $salt . $pass; | Use this method if you're creating a Keyring PDB from scratch otherwise you | 
|  | can just use Palm::PDB::new(). | 
|  |  | 
| $msg .= "\0" x (MD5_CBLOCK - length($msg)); | =head2 Load | 
|  |  | 
| my $digest = md5($msg); | $pdb->Load($filename[, $password]); | 
|  |  | 
| my $data = $salt . $digest;# . "\0"; | Overrides the standard Palm::Raw Load() to add | 
|  | $rec->{'plaintext'}->{'name'} and | 
|  | $rec->{'encrypted'} fields. | 
|  | $rec->{'plaintext'}->{'name'} holds the name of the record, | 
|  | $rec->{'encrypted'} is the encrypted information in the PDB. | 
|  |  | 
| # AFAIK the thing we use to test the password is | It also takes an additional optional parameter, which is the password to use to | 
| #     always in the first entry | decrypt the database. | 
| $self->{records}->[1]->{data} = $data; |  | 
|  |  | 
| $self->{password} = $pass; | See Decrypt() for the additional fields that are available after decryption. | 
| $self->{digest}   = _calc_keys($self->{password}); |  | 
|  |  | 
| return 1; | =head2 Write | 
| } |  | 
|  |  | 
|  | $pdb->Write($filename[, $password]); | 
|  |  | 
| # XXX Have to make this encrypt as well as decrypting, but w00 h00! | Just like the Palm::Raw::Write() but encrypts everything before saving. | 
| # do null padding on the end of a cleartext if we are going to encrypt it |  | 
| sub _crypt3des { |  | 
| my ( $plaintext, $passphrase, $flag ) = @_; |  | 
|  |  | 
| $passphrase .= ' ' x (16*3); | Also takes an optional password to encrypt with a new password, not needed | 
| my $cyphertext = ""; | unless you are changing the password. | 
|  |  | 
|  | =head2 Encrypt | 
|  |  | 
| my $size = length ( $plaintext ); | $pdb->Encrypt([$password]); | 
| #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n"; |  | 
|  |  | 
| # This check should see if it is plaintext first, if it is, | Encrypts the PDB, either with the password used to decrypt or create it, or | 
| #   pad it with \000 | optionally with a password that is passed. | 
| # if not, then die |  | 
| die "record not 8 byte padded" if (length($plaintext) % 8) && ! $flag; |  | 
|  |  | 
| my @C; | See Decrypt() for an what plaintext fields are available to be encrypted. | 
| for ( 0..2 ) { |  | 
| $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 ))); |  | 
| } |  | 
|  |  | 
| for ( 0 .. (($size)/8) - 1) { | =head2 Decrypt | 
| my $pt = substr( $plaintext, $_*8, 8 ); |  | 
| #print "PT: '$pt' - Length: " . length($pt) . "\n"; |  | 
| if (length($pt) < 8) { |  | 
| my $len = 8 - length($pt); |  | 
| print "LENGTH: $len\n"; |  | 
| print "Binary:    '" . unpack("b*", $pt) . "'\n"; |  | 
| $pt .= (chr(0) x $len);# . $pt; |  | 
| print "Binary:    '" . unpack("b*", $pt) . "'\n"; |  | 
| #print "PT: '$pt' - Length: " . length($pt) . "\n"; |  | 
| } |  | 
| $pt = $C[0]->decrypt( $pt ); |  | 
| $pt = $C[1]->encrypt( $pt ); |  | 
| $pt = $C[2]->decrypt( $pt ); |  | 
| #print "PT: '$pt' - Length: " . length($pt) . "\n"; |  | 
| $cyphertext .= $pt; |  | 
| } |  | 
|  |  | 
| return substr ( $cyphertext, 0, $size ); | $pdb->Decrypt([$password]); | 
| } |  | 
|  |  | 
| 1; | Decrypts the PDB and fills out the rest of the fields available in | 
| __END__ | $rec->{'plaintext'}. | 
|  |  | 
|  | The plaintext should now be this, before encryption or after decryption: | 
|  |  | 
|  | $rec->{'plaintext'} = { | 
|  | name        => $name, | 
|  | account     => $account, | 
|  | password    => $account_password, | 
|  | description => $description, | 
|  | }; | 
|  |  | 
|  | =head1 DEPENDENCIES | 
|  |  | 
|  | Palm::StdAppInfo | 
|  |  | 
|  | Digest::MD5 | 
|  |  | 
|  | Crypt::DES | 
|  |  | 
|  | Readonly | 
|  |  | 
|  | =head1 BUGS AND LIMITATIONS | 
|  |  | 
|  | Once this module is uploaded, you can | 
|  | Please report any bugs or feature requests to | 
|  | C<bug-palm-keyring at rt.cpan.org>, or through the web interface at | 
|  | L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be | 
|  | notified of progress on your bug as I make changes. | 
|  |  | 
| =head1 AUTHOR | =head1 AUTHOR | 
|  |  | 
| Andrew Fresh E<lt>andrew@mad-techies.org<gt> | Andrew Fresh E<lt>andrew@mad-techies.orgE<gt> | 
|  |  | 
|  | =head1 LICENSE AND COPYRIGHT | 
|  |  | 
|  | Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved. | 
|  |  | 
|  | This program is free software; you can redistribute it and/or | 
|  | modify it under the same terms as Perl itself. | 
|  |  | 
| =head1 SEE ALSO | =head1 SEE ALSO | 
|  |  | 
| Palm::PDB(3) | Palm::PDB(3) | 
|  |  | 
| Palm::StdAppInfo(3) | Palm::StdAppInfo(3) | 
|  |  | 
| =cut | The Keyring for Palm OS website: | 
|  | L<http://gnukeyring.sourceforge.net/> |