| version 1.6, 2006/11/10 16:18:59 |
version 1.11, 2007/01/27 23:59:29 |
|
|
| # 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$ |
# $Id$ |
| # $RedRiver: Keyring.pm,v 1.5 2006/11/10 04:52:27 andrew Exp $ |
# $RedRiver: Keyring.pm,v 1.10 2006/12/06 18:45:42 andrew Exp $ |
| |
|
| use strict; |
use strict; |
| package Palm::Keyring; |
package Palm::Keyring; |
|
|
| |
|
| =head1 SYNOPSIS |
=head1 SYNOPSIS |
| |
|
| use Palm::Keyring; |
use Palm::Keyring; |
| $pdb->Decrypt('mypassword'); |
$pdb->Load($file); |
| |
$pdb->Decrypt($assword); |
| |
|
| =head1 DESCRIPTION |
=head1 DESCRIPTION |
| |
|
| The Keyring PDB handler is a helper class for the Palm::PDB package. It |
The Keyring PDB handler is a helper class for the Palm::PDB package. It |
| parses Keyring databases. See |
parses Keyring for Palm OS databases. See |
| L<http://gnukeyring.sourceforge.net/>. |
L<http://gnukeyring.sourceforge.net/>. |
| |
|
| It is just the standard Palm::Raw with 2 additional public methods. Decrypt and Encrypt. |
It has the standard Palm::Raw with 2 additional public methods. |
| |
Decrypt and Encrypt. |
| |
|
| =cut |
=cut |
| |
|
| =head2 new |
=head2 new |
| |
|
| $pdb = new Palm::Keyring ('password'); |
$pdb = new Palm::Keyring($password); |
| |
|
| Create a new PDB, initialized with the various Palm::Keyring fields |
Create a new PDB, initialized with the various Palm::Keyring fields |
| and an empty record list. |
and an empty record list. |
|
|
| Use this method if you're creating a Keyring PDB from scratch. |
Use this method if you're creating a Keyring PDB from scratch. |
| |
|
| =cut |
=cut |
| #' |
|
| sub new |
sub new |
| { |
{ |
| my $classname = shift; |
my $classname = shift; |
|
|
| $self->{version} = 4; |
$self->{version} = 4; |
| |
|
| # Give the PDB the first record that will hold the encrypted password |
# Give the PDB the first record that will hold the encrypted password |
| $self->{records} = [ { |
$self->{records} = [ $self->new_Record ]; |
| 'category' => 0, |
|
| 'attributes' => { |
|
| 'private' => 1, |
|
| 'Secret' => 1, |
|
| 'Dirty' => 1, |
|
| 'dirty' => 1 |
|
| }, |
|
| }, ]; |
|
| |
|
| if ($pass) { |
if (defined $pass) { |
| $self->Encrypt($pass); |
$self->Encrypt($pass); |
| } |
} |
| |
|
|
|
| ); |
); |
| } |
} |
| |
|
| |
=pod |
| |
|
| |
=head2 Load |
| |
|
| |
$pdb->Load($filename[, $password]); |
| |
|
| |
Overrides the standard Palm::Raw Load() to add |
| |
$record->{'plaintext'}->{'name'} and |
| |
$record->{'encrypted'} fields. |
| |
$record->{'plaintext'}->{'name'} holds the name of the record, |
| |
$record->{'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. |
| |
|
| |
=cut |
| |
|
| sub Load |
sub Load |
| { |
{ |
| my $self = shift; |
my $self = shift; |
| $self->SUPER::Load(@_); |
my $filename = shift; |
| |
my $password = shift; |
| |
|
| # Skip the first 2 records because they are special |
$self->{'appinfo'} = {}; |
| # and don't have any plaintext |
$self->{'records'} = []; |
| my $skip = 0; |
$self->SUPER::Load($filename); |
| |
|
| foreach my $record (@{ $self->{records} }) { |
foreach my $record (@{ $self->{records} }) { |
| if ($skip < 2) { |
next unless exists $record->{data}; |
| $skip++; |
|
| next; |
|
| } |
|
| my ($name, $encrypted) = split /\000/, $record->{data}, 2; |
my ($name, $encrypted) = split /\000/, $record->{data}, 2; |
| |
next unless $encrypted; |
| $record->{plaintext}->{name} = $name; |
$record->{plaintext}->{name} = $name; |
| $record->{encrypted} = $encrypted; |
$record->{encrypted} = $encrypted; |
| } |
} |
| |
|
| |
return $self->Decrypt($password) if defined $password; |
| |
|
| 1; |
1; |
| } |
} |
| |
|
| |
=pod |
| |
|
| |
=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. |
| |
|
| |
=cut |
| |
|
| sub Write |
sub Write |
| { |
{ |
| my $self = shift; |
my $self = shift; |
| $self->Encrypt() || return undef; |
my $filename = shift; |
| return $self->SUPER::Load(@_); |
my $password = shift; |
| |
|
| |
$self->Encrypt($password) || return undef; |
| |
return $self->SUPER::Write($filename); |
| } |
} |
| |
|
| |
=pod |
| |
|
| |
=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. |
| |
|
| |
=cut |
| |
|
| sub Encrypt |
sub Encrypt |
| { |
{ |
| my $self = shift; |
my $self = shift; |
| my $pass = shift; |
my $pass = shift; |
| |
|
| if ($pass) { |
if ($pass) { |
| unless ($self->_keyring_verify($pass) ) { |
unless (exists $self->{'records'}->[0]->{'data'} && |
| |
$self->_keyring_verify($pass) ) { |
| # This would encrypt with a new password. |
# This would encrypt with a new password. |
| # First decrypting everything with the old password of course. |
# First decrypting everything with the old password of course. |
| $self->_keyring_update($pass) || return undef; |
$self->_keyring_update($pass) || return undef; |
|
|
| } |
} |
| } |
} |
| |
|
| my $seen_enc_pass = 0; |
$self->{digest} ||= _calc_keys($self->{password}); |
| foreach my $record (@{ $self->{records} }) { |
|
| unless ($seen_enc_pass) { |
|
| $seen_enc_pass = 1; |
|
| next; |
|
| } |
|
| |
|
| |
foreach my $record (@{ $self->{records} }) { |
| next unless defined $record->{plaintext}; |
next unless defined $record->{plaintext}; |
| |
|
| my $name = defined $record->{plaintext}->{name} ? $record->{plaintext}->{name} : ''; |
my $name = defined $record->{plaintext}->{name} ? |
| my $account = defined $record->{plaintext}->{account} ? $record->{plaintext}->{account} : ''; |
$record->{plaintext}->{name} : ''; |
| my $password = defined $record->{plaintext}->{password} ? $record->{plaintext}->{password} : ''; |
my $account = defined $record->{plaintext}->{account} ? |
| my $description = defined $record->{plaintext}->{description} ? $record->{plaintext}->{description} : ''; |
$record->{plaintext}->{account} : ''; |
| |
my $password = defined $record->{plaintext}->{password} ? |
| |
$record->{plaintext}->{password} : ''; |
| |
my $description = defined $record->{plaintext}->{description} ? |
| |
$record->{plaintext}->{description} : ''; |
| my $extra = ''; |
my $extra = ''; |
| |
|
| my $plaintext = join("\000", $account, $password, $description, $extra); |
my $plaintext = join("\000", $account, $password, $description, $extra); |
| |
|
| my $encrypted = $self->_crypt3des($plaintext, ENCRYPT); |
my $encrypted = _crypt3des($plaintext, $self->{digest}, ENCRYPT); |
| |
|
| $record->{data} = join("\000", $name, $encrypted); |
$record->{data} = join("\000", $name, $encrypted); |
| } |
} |
| |
|
| return 1; |
1; |
| } |
} |
| |
|
| |
=head2 Decrypt |
| |
|
| |
$pdb->Decrypt([$password]); |
| |
|
| |
Decrypts the PDB and fills out the rest of the fields available in |
| |
$record->{'plaintext'}. |
| |
|
| |
The plaintext should now be this, before encryption or after decryption: |
| |
|
| |
$record->{'plaintext'} = { |
| |
name => $name, |
| |
account => $account, |
| |
password => $account_password, |
| |
description => $description, |
| |
}; |
| |
|
| |
=cut |
| |
|
| sub Decrypt |
sub Decrypt |
| { |
{ |
| my $self = shift; |
my $self = shift; |
|
|
| $self->_keyring_verify($pass) || return undef; |
$self->_keyring_verify($pass) || return undef; |
| } |
} |
| |
|
| my $seen_enc_pass = 0; |
$self->{digest} ||= _calc_keys($self->{password}); |
| foreach my $record (@{ $self->{records} }) { |
|
| unless ($seen_enc_pass) { |
|
| # need to skip the first record because it is the encrypted password |
|
| $seen_enc_pass = 1; |
|
| next; |
|
| } |
|
| |
|
| |
foreach my $record (@{ $self->{records} }) { |
| next unless defined $record->{data}; |
next unless defined $record->{data}; |
| |
|
| my ($name, $encrypted) = split /\000/, $record->{data}, 2; |
my ($name, $encrypted) = split /\000/, $record->{data}, 2; |
| |
next unless $encrypted; |
| |
|
| $record->{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 /\000/, $decrypted, 4; |
= split /\000/, $decrypted, 4; |
| |
|
| $record->{plaintext}->{account} = defined $account ? $account : ''; |
$record->{plaintext}->{account} = defined $account ? |
| $record->{plaintext}->{password} = defined $password ? $password : ''; |
$account : ''; |
| $record->{plaintext}->{description} = defined $description ? $description : ''; |
$record->{plaintext}->{password} = defined $password ? |
| |
$password : ''; |
| |
$record->{plaintext}->{description} = defined $description ? |
| |
$description : ''; |
| |
|
| #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 "Account: $account\n"; |
| # print "Password: $password\n"; |
# print "Password: $password\n"; |
|
|
| |
|
| } |
} |
| |
|
| return 1; |
1; |
| } |
} |
| |
|
| sub _calc_keys |
sub _calc_keys |
| { |
{ |
| my $self = shift; |
my $pass = shift; |
| |
|
| my $pass = $self->{'password'}; |
|
| die "No password defined!" unless defined $pass; |
die "No password defined!" unless defined $pass; |
| |
|
| my $digest = md5($pass); |
my $digest = md5($pass); |
|
|
| # print length $digest, "\n"; |
# print length $digest, "\n"; |
| #-------------------------------------------------- |
#-------------------------------------------------- |
| |
|
| $self->{digest} = $digest; |
|
| return $digest; |
return $digest; |
| } |
} |
| |
|
|
|
| my $pass = shift; |
my $pass = shift; |
| |
|
| die "No password specified!" unless $pass; |
die "No password specified!" unless $pass; |
| $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 |
|
|
| |
|
| if ($data eq $salt . $digest) { |
if ($data eq $salt . $digest) { |
| # May as well generate the keys we need now, since we know the password is right |
# May as well generate the keys we need now, since we know the password is right |
| if ($self->_calc_keys()) { |
$self->{digest} = _calc_keys($pass); |
| |
if ($self->{digest}) { |
| |
$self->{password} = $pass; |
| return 1; |
return 1; |
| } else { |
} else { |
| return undef; |
return undef; |
|
|
| $self->{records}->[0]->{data} = $data; |
$self->{records}->[0]->{data} = $data; |
| |
|
| $self->{password} = $pass; |
$self->{password} = $pass; |
| $self->_calc_keys(); |
$self->{digest} = _calc_keys($self->{password}); |
| |
|
| return 1; |
return 1; |
| } |
} |
| |
|
| |
|
| # XXX Have to make this encrypt as well as decrypting, but w00 h00! |
|
| # do null padding on the end of a cleartext if we are going to encrypt it |
|
| sub _crypt3des { |
sub _crypt3des { |
| my ( $self, $plaintext, $flag ) = @_; |
my ( $plaintext, $passphrase, $flag ) = @_; |
| |
my $NULL = chr(0); |
| |
|
| my $passphrase = $self->{digest} || $self->_calc_keys(); |
|
| $passphrase .= ' ' x (16*3); |
$passphrase .= ' ' x (16*3); |
| my $cyphertext = ""; |
my $cyphertext = ""; |
| |
|
| |
|
| my $size = length ( $plaintext ); |
my $size = length ( $plaintext ); |
| #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n"; |
#print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n"; |
| |
|
| # This check should see if it is plaintext first, if it is, |
|
| # pad it with \000 |
|
| # if not, then die |
|
| die "record not 8 byte padded" if (length($plaintext) % 8) && ! $flag; |
|
| |
|
| my @C; |
my @C; |
| for ( 0..2 ) { |
for ( 0..2 ) { |
| $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 ))); |
$C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 ))); |
| } |
} |
| |
|
| for ( 0 .. (($size)/8) - 1) { |
for ( 0 .. (($size)/8)) { |
| my $pt = substr( $plaintext, $_*8, 8 ); |
my $pt = substr( $plaintext, $_*8, 8 ); |
| #print "PT: '$pt' - Length: " . length($pt) . "\n"; |
#print "PT: '$pt' - Length: " . length($pt) . "\n"; |
| |
next unless length($pt); |
| if (length($pt) < 8) { |
if (length($pt) < 8) { |
| |
die "record not 8 byte padded" if $flag == DECRYPT; |
| my $len = 8 - length($pt); |
my $len = 8 - length($pt); |
| print "LENGTH: $len\n"; |
#print "LENGTH: $len\n"; |
| print "Binary: '" . unpack("b*", $pt) . "'\n"; |
#print "Binary: '" . unpack("b*", $pt) . "'\n"; |
| $pt .= (chr(0) x $len);# . $pt; |
$pt .= ($NULL x $len); |
| print "Binary: '" . unpack("b*", $pt) . "'\n"; |
|
| #print "PT: '$pt' - Length: " . length($pt) . "\n"; |
#print "PT: '$pt' - Length: " . length($pt) . "\n"; |
| |
#print "Binary: '" . unpack("b*", $pt) . "'\n"; |
| } |
} |
| $pt = $C[0]->decrypt( $pt ); |
if ($flag == ENCRYPT) { |
| $pt = $C[1]->encrypt( $pt ); |
$pt = $C[0]->encrypt( $pt ); |
| $pt = $C[2]->decrypt( $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"; |
#print "PT: '$pt' - Length: " . length($pt) . "\n"; |
| $cyphertext .= $pt; |
$cyphertext .= $pt; |
| } |
} |
| |
|
| return substr ( $cyphertext, 0, $size ); |
$cyphertext =~ s/$NULL+$//; |
| |
#print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n"; |
| |
|
| |
return $cyphertext; |
| } |
} |
| |
|
| 1; |
1; |
|
|
| Palm::PDB(3) |
Palm::PDB(3) |
| |
|
| Palm::StdAppInfo(3) |
Palm::StdAppInfo(3) |
| |
|
| |
The Keyring for Palm OS website: |
| |
L<http://gnukeyring.sourceforge.net/> |
| |
|
| =cut |
=cut |