| version 1.4, 2006/11/10 04:21:17 | version 1.14, 2007/01/28 22:24:17 | 
|  |  | 
| # Palm::Keyring.pm | package Palm::Keyring; | 
|  |  | 
|  | # $RedRiver: Keyring.pm,v 1.13 2007/01/28 18:13:28 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.3 2006/02/02 00:59:08 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; |  | 
|  |  | 
| my $self        = $classname->SUPER::new(@_); | $self->{'appinfo'} = {}; | 
| # Create a generic PDB. No need to rebless it, | $self->{'records'} = []; | 
| # though. | $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; | 
| $self->{attributes}{resource} = 0; | if ( ! $encrypted ) { next }; | 
| # The PDB is not a resource database by | $rec->{'plaintext'}->{'name'} = $name; | 
| # default, but it's worth emphasizing, | $rec->{'encrypted'} = $encrypted; | 
| # since MemoDB is explicitly not a PRC. | } | 
|  |  | 
| # 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) { |  | 
| $self->Encrypt($pass); |  | 
| } |  | 
|  |  | 
| return $self; |  | 
| } | } | 
|  |  | 
| sub import | sub Encrypt { | 
| { | my $self = shift; | 
| &Palm::PDB::RegisterPDBHandlers(__PACKAGE__, | my $pass = shift; | 
| [ "Gtkr", "Gkyr" ], |  | 
| ); |  | 
| } |  | 
|  |  | 
| sub Load | if ($pass) { | 
| { | if ( | 
| my $self = shift; | !( exists $self->{'records'}->[0]->{'data'} | 
| $self->SUPER::Load(@_); | && $self->_keyring_verify($pass) ) | 
|  | ) | 
|  | { | 
|  |  | 
| # Skip the first 2 records because they are special | # This would encrypt with a new password. | 
| # and don't have any plaintext | # First decrypting everything with the old password of course. | 
| my $skip = 0; | $self->_keyring_update($pass) || return; | 
| foreach my $record (@{ $self->{records} }) { | $self->_keyring_verify($pass) || return; | 
| if ($skip < 2) { | } | 
| $skip++; | } | 
| next; |  | 
| } |  | 
| my ($name, $encrypted) = split /\000/, $record->{data}, 2; |  | 
| $record->{plaintext}->{name} = $name; |  | 
| $record->{encrypted} = $encrypted; |  | 
| } |  | 
| 1; |  | 
| } |  | 
|  |  | 
| sub Encrypt | $self->{'digest'} ||= _calc_keys( $self->{'password'} ); | 
| { |  | 
| my $self = shift; |  | 
| my $pass = shift; |  | 
|  |  | 
| if ($pass) { | foreach my $rec ( @{ $self->{'records'} } ) { | 
| unless ($self->_keyring_verify($pass) ) { | if (!defined $rec->{'plaintext'}) { next; }; | 
| # This would encrypt with a new password. |  | 
| # First decrypting everything with the old password of course. |  | 
| $self->_keyring_update($pass) || return undef; |  | 
| $self->_keyring_verify($pass) || return undef; |  | 
| } |  | 
| } |  | 
|  |  | 
| my $seen_enc_pass = 0; | my $name = | 
| foreach my $record (@{ $self->{records} }) { | defined $rec->{'plaintext'}->{'name'} | 
| unless ($seen_enc_pass) { | ? $rec->{'plaintext'}->{'name'} | 
| $seen_enc_pass = 1; | : $EMPTY; | 
| next; | 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; | 
|  |  | 
| next unless defined $record->{plaintext}; | my $plaintext = join "$NULL", $account, $password, $description, $extra; | 
|  |  | 
| my $name        = defined $record->{plaintext}->{name}        ? $record->{plaintext}->{name}        : ''; | my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT ); | 
| 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); | $rec->{'data'} = join "$NULL", $name, $encrypted; | 
|  | } | 
|  |  | 
| my $encrypted = $self->_crypt3des($plaintext, ENCRYPT); | return 1; | 
|  | } | 
|  |  | 
| $record->{data} = join("\000", $name, $encrypted); | sub Decrypt { | 
| } | my $self = shift; | 
|  | my $pass = shift; | 
|  |  | 
| return 1; | if ($pass) { | 
| } | $self->_keyring_verify($pass) || return; | 
|  | } | 
|  |  | 
| sub Decrypt | $self->{'digest'} ||= _calc_keys( $self->{'password'} ); | 
| { |  | 
| my $self = shift; |  | 
| my $pass = shift; |  | 
|  |  | 
| if ($pass) { | my $reccount = 0; | 
| $self->_keyring_verify($pass) || return undef; | foreach my $rec ( @{ $self->{'records'} } ) { | 
| } | $reccount++; | 
|  |  | 
| my $seen_enc_pass = 0; | # always skip the first record that has the password in it. | 
| foreach my $record (@{ $self->{records} }) { | next if $reccount <= 1; | 
| unless ($seen_enc_pass) { | if ( ! defined $rec->{'data'} ) { | 
| # need to skip the first record because it is the encrypted password | warn 'Invalid record ' . ( $reccount - 1 ) . "\n"; | 
| $seen_enc_pass = 1; | next; | 
| next; | } | 
| } |  | 
|  |  | 
| next unless defined $record->{data}; | my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2; | 
|  | if (! $encrypted) { next; }; | 
|  |  | 
| my ($name, $encrypted) = split /\000/, $record->{data}, 2; | $rec->{'plaintext'}->{'name'} = $name; | 
| $record->{plaintext}->{name} = $name; |  | 
|  |  | 
| my $decrypted = $self->_crypt3des($encrypted, DECRYPT); | my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT ); | 
| my ($account, $password, $description, $extra) | my ( $account, $password, $description, $extra ) = split /$NULL/xm, | 
| = split /\000/, $decrypted, 4; | $decrypted, 4; | 
|  |  | 
| $record->{plaintext}->{account}     = defined $account     ? $account     : ''; | $rec->{'plaintext'}->{'account'} = defined $account ? $account : $EMPTY; | 
| $record->{plaintext}->{password}    = defined $password    ? $password    : ''; | $rec->{'plaintext'}->{'password'} = | 
| $record->{plaintext}->{description} = defined $description ? $description : ''; | defined $password ? $password : $EMPTY; | 
|  | $rec->{'plaintext'}->{'description'} = | 
|  | defined $description ? $description : $EMPTY; | 
|  |  | 
| #print "Name:      '$name'\n"; | #print "Name:      '$name'\n"; | 
| #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n"; | #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n"; | 
| #print "Hex:       '" . unpack("H*", $encrypted) . "'\n"; | #print "    Hex:   '" . unpack("H*", $encrypted) . "'\n"; | 
| #print "Binary:    '" . unpack("b*", $encrypted) . "'\n"; | #print "    Binary:'" . unpack("b*", $encrypted) . "'\n"; | 
| #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n"; | #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n"; | 
| #print "Hex:       '" . unpack("H*", $decrypted) . "'\n"; | #print "    Hex:   '" . unpack("H*", $decrypted) . "'\n"; | 
| #print "Binary:    '" . unpack("b*", $decrypted) . "'\n"; | #print "    Binary:'" . unpack("b*", $decrypted) . "'\n"; | 
| #print "\n"; | #print "\n"; | 
| #print "Extra: $extra\n"; | #print "Extra: $extra\n"; | 
| #-------------------------------------------------- | #exit; | 
| # print "Account:     $account\n"; | #-------------------------------------------------- | 
| # print "Password:    $password\n"; | # print "Account:     $account\n"; | 
| # print "Description: $description\n"; | # print "Password:    $password\n"; | 
| #-------------------------------------------------- | # print "Description: $description\n"; | 
|  | #-------------------------------------------------- | 
|  |  | 
| } | } | 
|  |  | 
| return 1; | return 1; | 
| } | } | 
|  |  | 
| sub _calc_keys | sub _calc_keys { | 
| { | my $pass = shift; | 
| my $self = shift; | if (! defined $pass) { croak('No password defined!'); }; | 
|  |  | 
| my $pass = $self->{'password'}; | my $digest = md5($pass); | 
| die "No password defined!" unless defined $pass; |  | 
|  |  | 
| my $digest = md5($pass); | my ( $key1, $key2 ) = unpack 'a8a8', $digest; | 
|  |  | 
| my ($key1, $key2) = unpack('a8a8', $digest); | #-------------------------------------------------- | 
| #-------------------------------------------------- | # print "key1: $key1: ", length $key1, "\n"; | 
| # print "key1: $key1: ", length $key1, "\n"; | # print "key2: $key2: ", length $key2, "\n"; | 
| # print "key2: $key2: ", length $key2, "\n"; | #-------------------------------------------------- | 
| #-------------------------------------------------- |  | 
|  |  | 
| $digest = unpack('H*', $key1 . $key2 . $key1); | $digest = unpack 'H*', $key1 . $key2 . $key1; | 
| #-------------------------------------------------- |  | 
| # print "Digest: ", $digest, "\n"; |  | 
| # print length $digest, "\n"; |  | 
| #-------------------------------------------------- |  | 
|  |  | 
| $self->{digest} = $digest; | #-------------------------------------------------- | 
| return $digest; | # print "Digest: ", $digest, "\n"; | 
|  | # print length $digest, "\n"; | 
|  | #-------------------------------------------------- | 
|  |  | 
|  | return $digest; | 
| } | } | 
|  |  | 
| sub _keyring_verify | sub _keyring_verify { | 
| { | my $self = shift; | 
| my $self = shift; | my $pass = shift; | 
| my $pass = shift; |  | 
|  |  | 
| die "No password specified!" unless $pass; | if (! $pass) { croak('No password specified!'); }; | 
| $self->{password} = $pass; |  | 
|  |  | 
| # 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 | 
| my $data = $self->{records}->[0]->{data}; | my $data = $self->{'records'}->[0]->{'data'}; | 
| #die "No encrypted password in file!" unless defined $data; |  | 
| return undef unless defined $data; |  | 
|  |  | 
| $data =~ s/\0$//; | #die "No encrypted password in file!" unless defined $data; | 
|  | if (! defined $data) { return; }; | 
|  |  | 
| my $salt = substr($data, 0, $kSaltSize); | $data =~ s/$NULL$//xm; | 
|  |  | 
| my $msg = $salt . $pass; | my $salt = substr $data, 0, $kSalt_Size; | 
|  |  | 
| $msg .= "\0" x (MD5_CBLOCK - length($msg)); | my $msg = $salt . $pass; | 
|  |  | 
| my $digest = md5($msg); | $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); | 
|  |  | 
| if ($data eq $salt . $digest) { | my $digest = md5($msg); | 
| # May as well generate the keys we need now, since we know the password is right |  | 
| if ($self->_calc_keys()) { | if ( $data eq $salt . $digest ) { | 
| return 1; |  | 
| } else { | # May as well generate the keys we need now, since we know the password is right | 
| return undef; | $self->{'digest'} = _calc_keys($pass); | 
| } | if ( $self->{'digest'} ) { | 
| } else { | $self->{'password'} = $pass; | 
| return undef; | return 1; | 
| } | } | 
|  | } | 
|  | return; | 
| } | } | 
|  |  | 
| sub _keyring_update | sub _keyring_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; |  | 
|  |  | 
| die "No password specified!" unless $pass; | # 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 the database already has a password in it | if (! $pass) { croak('No password specified!'); }; | 
| if ($self->{records}->[0]->{data}) { |  | 
| # Make sure everything is decrypted before we update the keyring |  | 
| $self->Decrypt() || return undef; |  | 
| } |  | 
|  |  | 
| my $salt; | # if the database already has a password in it | 
| for (1..$kSaltSize) { | if ( $self->{'records'}->[0]->{'data'} ) { | 
| $salt .= chr(int(rand(255))); |  | 
| } |  | 
|  |  | 
| my $msg = $salt . $pass; | # Make sure everything is decrypted before we update the keyring | 
|  | $self->Decrypt() || return; | 
|  | } | 
|  |  | 
| $msg .= "\0" x (MD5_CBLOCK - length($msg)); | my $salt; | 
|  | for ( 1 .. $kSalt_Size ) { | 
|  | $salt .= chr int rand 255; | 
|  | } | 
|  |  | 
| my $digest = md5($msg); | my $msg = $salt . $pass; | 
|  |  | 
| my $data = $salt . $digest;# . "\0"; | $msg .= "\0" x ( $MD5_CBLOCK - length $msg ); | 
|  |  | 
| # AFAIK the thing we use to test the password is | my $digest = md5($msg); | 
| #     always in the first entry |  | 
| $self->{records}->[0]->{data} = $data; |  | 
|  |  | 
| $self->{password} = $pass; | my $data = $salt . $digest;    # . "\0"; | 
| $self->_calc_keys(); |  | 
|  |  | 
| 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 _crypt3des { | 
|  | my ( $plaintext, $passphrase, $flag ) = @_; | 
|  |  | 
| # XXX Have to make this encrypt as well as decrypting, but w00 h00! | $passphrase   .= $SPACE x ( 16 * 3 ); | 
| # do null padding on the end of a cleartext if we are going to encrypt it | my $cyphertext = $EMPTY; | 
| sub _crypt3des { |  | 
| my ( $self, $plaintext, $flag ) = @_; |  | 
|  |  | 
| my $passphrase = $self->{digest} || $self->_calc_keys(); | my $size = length $plaintext; | 
| $passphrase .= ' ' x (16*3); |  | 
| my $cyphertext = ""; |  | 
|  |  | 
|  | #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n"; | 
|  |  | 
| my $size = length ( $plaintext ); | my @C; | 
| #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n"; | for ( 0 .. 2 ) { | 
|  | $C[$_] = | 
|  | new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 )); | 
|  | } | 
|  |  | 
| # This check should see if it is plaintext first, if it is, | for ( 0 .. ( ($size) / 8 ) ) { | 
| #   pad it with \000 | my $pt = substr $plaintext, $_ * 8, 8; | 
| # if not, then die |  | 
| die "record not 8 byte padded" if (length($plaintext) % 8) && ! $flag; |  | 
|  |  | 
| my %C; | #print "PT: '$pt' - Length: " . length($pt) . "\n"; | 
| for ( 0..2 ) { | if (! length $pt) { next; }; | 
| $C{$_} = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 ))); | if ( (length $pt) < 8 ) { | 
| } | if ($flag == $DECRYPT) { croak('record not 8 byte padded'); }; | 
|  | my $len = 8 - (length $pt); | 
|  |  | 
| for ( 0 .. (($size)/8) - 1) { | #print "LENGTH: $len\n"; | 
| my $pt = substr( $plaintext, $_*8, 8 ); | #print "Binary:    '" . unpack("b*", $pt) . "'\n"; | 
| #print "PT: '$pt' - Length: " . length($pt) . "\n"; | $pt .= ($NULL x $len); | 
| 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 ); | #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; | 
| } | } | 
|  |  | 
| 1; | 1; | 
| __END__ | __END__ | 
|  |  | 
|  | =head1 NAME | 
|  |  | 
|  | Palm::Keyring - Handler for Palm Keyring databases. | 
|  |  | 
|  | =head1 DESCRIPTION | 
|  |  | 
|  | 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/>. | 
|  |  | 
|  | 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 the pre-release keyring-2.0 are not supported. | 
|  |  | 
|  | =head1 SYNOPSIS | 
|  |  | 
|  | use Palm::PDB; | 
|  | use Palm::Keyring; | 
|  | my $pdb = new Palm::PDB; | 
|  | $pdb->Load($file); | 
|  | foreach my $rec (@{ $pdb->{'records'} }) { | 
|  | print "$rec->{'plaintext'}->{'name'}\n"; | 
|  | } | 
|  | $pdb->Decrypt($password); | 
|  | # do something with the decrypted parts | 
|  |  | 
|  | =head1 SUBROUTINES/METHODS | 
|  |  | 
|  | =head2 new | 
|  |  | 
|  | $pdb = new Palm::Keyring([$password]); | 
|  |  | 
|  | Create a new PDB, initialized with the various Palm::Keyring fields | 
|  | and an empty record list. | 
|  |  | 
|  | Use this method if you're creating a Keyring PDB from scratch otherwise you | 
|  | can just use Palm::PDB::new(). | 
|  |  | 
|  | =head2 Load | 
|  |  | 
|  | $pdb->Load($filename[, $password]); | 
|  |  | 
|  | 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. | 
|  |  | 
|  | It also takes an additional optional parameter, which is the password to use to | 
|  | decrypt the database. | 
|  |  | 
|  | See Decrypt() for the additional fields that are available after decryption. | 
|  |  | 
|  | =head2 Write | 
|  |  | 
|  | $pdb->Write($filename[, $password]); | 
|  |  | 
|  | Just like the Palm::Raw::Write() but encrypts everything before saving. | 
|  |  | 
|  | Also takes an optional password to encrypt with a new password, not needed | 
|  | unless you are changing the password. | 
|  |  | 
|  | =head2 Encrypt | 
|  |  | 
|  | $pdb->Encrypt([$password]); | 
|  |  | 
|  | Encrypts the PDB, either with the password used to decrypt or create it, or | 
|  | optionally with a password that is passed. | 
|  |  | 
|  | See Decrypt() for an what plaintext fields are available to be encrypted. | 
|  |  | 
|  | =head2 Decrypt | 
|  |  | 
|  | $pdb->Decrypt([$password]); | 
|  |  | 
|  | Decrypts the PDB and fills out the rest of the fields available in | 
|  | $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 | 
|  |  | 
|  | You may distribute this file under the terms of perl itself | 
|  | as specified in the LICENSE file. | 
|  |  | 
|  | 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/> |