Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.14
1.14 ! andrew 1: package Palm::Keyring;
! 2:
! 3: # $RedRiver: Keyring.pm,v 1.13 2007/01/28 18:13:28 andrew Exp $
1.1 andrew 4: #
1.14 ! andrew 5: # Perl class for dealing with Keyring for Palm OS databases.
1.1 andrew 6: #
7: # This started as Memo.pm, I just made it work for Keyring.
8:
9: use strict;
1.14 ! andrew 10: use warnings;
! 11: use Carp;
! 12:
! 13: use base qw/ Palm::StdAppInfo /;
1.1 andrew 14:
15: use Digest::MD5 qw(md5);
1.2 andrew 16: use Crypt::DES;
1.14 ! andrew 17: use Readonly;
! 18:
! 19: Readonly my $ENCRYPT => 1;
! 20: Readonly my $DECRYPT => 0;
! 21: Readonly my $MD5_CBLOCK => 64;
! 22: Readonly my $kSalt_Size => 4;
! 23: Readonly my $EMPTY => q{};
! 24: Readonly my $SPACE => q{ };
! 25: Readonly my $NULL => chr 0;
! 26:
! 27: # One liner, to allow MakeMaker to work.
! 28: our ($VERSION) = q$Revision: 1.13 $ =~ m{ Revision: \s+ (\S+) }xm;
! 29:
! 30: #@ISA = qw( Palm::StdAppInfo Palm::Raw );
1.1 andrew 31:
1.14 ! andrew 32: sub new {
! 33: my $classname = shift;
! 34: my $pass = shift;
1.1 andrew 35:
1.14 ! andrew 36: # Create a generic PDB. No need to rebless it, though.
! 37: my $self = $classname->SUPER::new(@_);
1.1 andrew 38:
1.14 ! andrew 39: $self->{'name'} = 'Keys-Gtkr'; # Default
! 40: $self->{'creator'} = 'Gtkr';
! 41: $self->{'type'} = 'Gkyr';
! 42:
! 43: # The PDB is not a resource database by
! 44: # default, but it's worth emphasizing,
! 45: # since MemoDB is explicitly not a PRC.
! 46: $self->{'attributes'}{'resource'} = 0;
1.1 andrew 47:
1.14 ! andrew 48: # Initialize the AppInfo block
! 49: $self->{'appinfo'} = {};
1.1 andrew 50:
1.14 ! andrew 51: # Add the standard AppInfo block stuff
! 52: Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} );
1.1 andrew 53:
1.14 ! andrew 54: # Set the version
! 55: $self->{'version'} = 4;
1.1 andrew 56:
1.14 ! andrew 57: # Give the PDB the first record that will hold the encrypted password
! 58: $self->{'records'} = [ $self->new_Record ];
1.1 andrew 59:
1.14 ! andrew 60: if ( defined $pass ) {
! 61: $self->Encrypt($pass);
! 62: }
1.1 andrew 63:
1.14 ! andrew 64: return $self;
! 65: }
1.1 andrew 66:
1.14 ! andrew 67: sub import {
! 68: Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
! 69: return 1;
! 70: }
1.1 andrew 71:
1.14 ! andrew 72: sub Load {
! 73: my $self = shift;
! 74: my $filename = shift;
! 75: my $password = shift;
! 76:
! 77: $self->{'appinfo'} = {};
! 78: $self->{'records'} = [];
! 79: $self->SUPER::Load($filename);
! 80:
! 81: foreach my $rec ( @{ $self->{'records'} } ) {
! 82: if ( ! exists $rec->{'data'}) { next; };
! 83: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
! 84: if ( ! $encrypted ) { next };
! 85: $rec->{'plaintext'}->{'name'} = $name;
! 86: $rec->{'encrypted'} = $encrypted;
! 87: }
1.1 andrew 88:
1.14 ! andrew 89: return $self->Decrypt($password) if defined $password;
1.12 andrew 90:
1.14 ! andrew 91: return 1;
! 92: }
1.11 andrew 93:
1.14 ! andrew 94: sub Write {
! 95: my $self = shift;
! 96: my $filename = shift;
! 97: my $password = shift;
1.1 andrew 98:
1.14 ! andrew 99: $self->Encrypt($password) || return;
! 100: return $self->SUPER::Write($filename);
! 101: }
1.1 andrew 102:
1.14 ! andrew 103: sub Encrypt {
! 104: my $self = shift;
! 105: my $pass = shift;
! 106:
! 107: if ($pass) {
! 108: if (
! 109: !( exists $self->{'records'}->[0]->{'data'}
! 110: && $self->_keyring_verify($pass) )
! 111: )
! 112: {
! 113:
! 114: # This would encrypt with a new password.
! 115: # First decrypting everything with the old password of course.
! 116: $self->_keyring_update($pass) || return;
! 117: $self->_keyring_verify($pass) || return;
! 118: }
! 119: }
! 120:
! 121: $self->{'digest'} ||= _calc_keys( $self->{'password'} );
! 122:
! 123: foreach my $rec ( @{ $self->{'records'} } ) {
! 124: if (!defined $rec->{'plaintext'}) { next; };
! 125:
! 126: my $name =
! 127: defined $rec->{'plaintext'}->{'name'}
! 128: ? $rec->{'plaintext'}->{'name'}
! 129: : $EMPTY;
! 130: my $account =
! 131: defined $rec->{'plaintext'}->{'account'}
! 132: ? $rec->{'plaintext'}->{'account'}
! 133: : $EMPTY;
! 134: my $password =
! 135: defined $rec->{'plaintext'}->{'password'}
! 136: ? $rec->{'plaintext'}->{'password'}
! 137: : $EMPTY;
! 138: my $description =
! 139: defined $rec->{'plaintext'}->{'description'}
! 140: ? $rec->{'plaintext'}->{'description'}
! 141: : $EMPTY;
! 142: my $extra = $EMPTY;
1.1 andrew 143:
1.14 ! andrew 144: my $plaintext = join "$NULL", $account, $password, $description, $extra;
1.1 andrew 145:
1.14 ! andrew 146: my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );
1.11 andrew 147:
1.14 ! andrew 148: $rec->{'data'} = join "$NULL", $name, $encrypted;
! 149: }
1.1 andrew 150:
1.14 ! andrew 151: return 1;
! 152: }
1.1 andrew 153:
1.14 ! andrew 154: sub Decrypt {
! 155: my $self = shift;
! 156: my $pass = shift;
! 157:
! 158: if ($pass) {
! 159: $self->_keyring_verify($pass) || return;
! 160: }
! 161:
! 162: $self->{'digest'} ||= _calc_keys( $self->{'password'} );
! 163:
! 164: my $reccount = 0;
! 165: foreach my $rec ( @{ $self->{'records'} } ) {
! 166: $reccount++;
! 167:
! 168: # always skip the first record that has the password in it.
! 169: next if $reccount <= 1;
! 170: if ( ! defined $rec->{'data'} ) {
! 171: warn 'Invalid record ' . ( $reccount - 1 ) . "\n";
! 172: next;
! 173: }
! 174:
! 175: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
! 176: if (! $encrypted) { next; };
! 177:
! 178: $rec->{'plaintext'}->{'name'} = $name;
! 179:
! 180: my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT );
! 181: my ( $account, $password, $description, $extra ) = split /$NULL/xm,
! 182: $decrypted, 4;
! 183:
! 184: $rec->{'plaintext'}->{'account'} = defined $account ? $account : $EMPTY;
! 185: $rec->{'plaintext'}->{'password'} =
! 186: defined $password ? $password : $EMPTY;
! 187: $rec->{'plaintext'}->{'description'} =
! 188: defined $description ? $description : $EMPTY;
! 189:
! 190: #print "Name: '$name'\n";
! 191: #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
! 192: #print " Hex: '" . unpack("H*", $encrypted) . "'\n";
! 193: #print " Binary:'" . unpack("b*", $encrypted) . "'\n";
! 194: #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
! 195: #print " Hex: '" . unpack("H*", $decrypted) . "'\n";
! 196: #print " Binary:'" . unpack("b*", $decrypted) . "'\n";
! 197: #print "\n";
! 198: #print "Extra: $extra\n";
! 199: #exit;
! 200: #--------------------------------------------------
! 201: # print "Account: $account\n";
! 202: # print "Password: $password\n";
! 203: # print "Description: $description\n";
! 204: #--------------------------------------------------
1.1 andrew 205:
1.14 ! andrew 206: }
1.1 andrew 207:
1.14 ! andrew 208: return 1;
1.1 andrew 209: }
210:
1.14 ! andrew 211: sub _calc_keys {
! 212: my $pass = shift;
! 213: if (! defined $pass) { croak('No password defined!'); };
! 214:
! 215: my $digest = md5($pass);
! 216:
! 217: my ( $key1, $key2 ) = unpack 'a8a8', $digest;
! 218:
! 219: #--------------------------------------------------
! 220: # print "key1: $key1: ", length $key1, "\n";
! 221: # print "key2: $key2: ", length $key2, "\n";
! 222: #--------------------------------------------------
! 223:
! 224: $digest = unpack 'H*', $key1 . $key2 . $key1;
! 225:
! 226: #--------------------------------------------------
! 227: # print "Digest: ", $digest, "\n";
! 228: # print length $digest, "\n";
! 229: #--------------------------------------------------
! 230:
! 231: return $digest;
1.3 andrew 232: }
233:
1.14 ! andrew 234: sub _keyring_verify {
! 235: my $self = shift;
! 236: my $pass = shift;
! 237:
! 238: if (! $pass) { croak('No password specified!'); };
1.11 andrew 239:
1.14 ! andrew 240: # AFAIK the thing we use to test the password is
! 241: # always in the first entry
! 242: my $data = $self->{'records'}->[0]->{'data'};
1.11 andrew 243:
1.14 ! andrew 244: #die "No encrypted password in file!" unless defined $data;
! 245: if (! defined $data) { return; };
1.11 andrew 246:
1.14 ! andrew 247: $data =~ s/$NULL$//xm;
1.11 andrew 248:
1.14 ! andrew 249: my $salt = substr $data, 0, $kSalt_Size;
1.11 andrew 250:
1.14 ! andrew 251: my $msg = $salt . $pass;
1.11 andrew 252:
1.14 ! andrew 253: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11 andrew 254:
1.14 ! andrew 255: my $digest = md5($msg);
1.11 andrew 256:
1.14 ! andrew 257: if ( $data eq $salt . $digest ) {
1.11 andrew 258:
1.14 ! andrew 259: # May as well generate the keys we need now, since we know the password is right
! 260: $self->{'digest'} = _calc_keys($pass);
! 261: if ( $self->{'digest'} ) {
! 262: $self->{'password'} = $pass;
! 263: return 1;
! 264: }
! 265: }
! 266: return;
1.6 andrew 267: }
268:
1.14 ! andrew 269: sub _keyring_update {
! 270:
! 271: # It is very important to Encrypt after calling this
! 272: # (Although it is generally only called by Encrypt)
! 273: # because otherwise the data will be out of sync with the
! 274: # password, and that would suck!
! 275: my $self = shift;
! 276: my $pass = shift;
! 277:
! 278: if (! $pass) { croak('No password specified!'); };
1.11 andrew 279:
1.14 ! andrew 280: # if the database already has a password in it
! 281: if ( $self->{'records'}->[0]->{'data'} ) {
! 282:
! 283: # Make sure everything is decrypted before we update the keyring
! 284: $self->Decrypt() || return;
! 285: }
! 286:
! 287: my $salt;
! 288: for ( 1 .. $kSalt_Size ) {
! 289: $salt .= chr int rand 255;
! 290: }
! 291:
! 292: my $msg = $salt . $pass;
1.11 andrew 293:
1.14 ! andrew 294: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11 andrew 295:
1.14 ! andrew 296: my $digest = md5($msg);
1.11 andrew 297:
1.14 ! andrew 298: my $data = $salt . $digest; # . "\0";
1.11 andrew 299:
1.14 ! andrew 300: # AFAIK the thing we use to test the password is
! 301: # always in the first entry
! 302: $self->{'records'}->[0]->{'data'} = $data;
1.11 andrew 303:
1.14 ! andrew 304: $self->{'password'} = $pass;
! 305: $self->{'digest'} = _calc_keys( $self->{'password'} );
1.11 andrew 306:
1.14 ! andrew 307: return 1;
1.1 andrew 308: }
309:
1.14 ! andrew 310: sub _crypt3des {
! 311: my ( $plaintext, $passphrase, $flag ) = @_;
! 312:
! 313: $passphrase .= $SPACE x ( 16 * 3 );
! 314: my $cyphertext = $EMPTY;
! 315:
! 316: my $size = length $plaintext;
1.11 andrew 317:
1.14 ! andrew 318: #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
! 319:
! 320: my @C;
! 321: for ( 0 .. 2 ) {
! 322: $C[$_] =
! 323: new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
! 324: }
! 325:
! 326: for ( 0 .. ( ($size) / 8 ) ) {
! 327: my $pt = substr $plaintext, $_ * 8, 8;
! 328:
! 329: #print "PT: '$pt' - Length: " . length($pt) . "\n";
! 330: if (! length $pt) { next; };
! 331: if ( (length $pt) < 8 ) {
! 332: if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
! 333: my $len = 8 - (length $pt);
! 334:
! 335: #print "LENGTH: $len\n";
! 336: #print "Binary: '" . unpack("b*", $pt) . "'\n";
! 337: $pt .= ($NULL x $len);
! 338:
! 339: #print "PT: '$pt' - Length: " . length($pt) . "\n";
! 340: #print "Binary: '" . unpack("b*", $pt) . "'\n";
! 341: }
! 342: if ( $flag == $ENCRYPT ) {
! 343: $pt = $C[0]->encrypt($pt);
! 344: $pt = $C[1]->decrypt($pt);
! 345: $pt = $C[2]->encrypt($pt);
! 346: }
! 347: else {
! 348: $pt = $C[0]->decrypt($pt);
! 349: $pt = $C[1]->encrypt($pt);
! 350: $pt = $C[2]->decrypt($pt);
! 351: }
! 352:
! 353: #print "PT: '$pt' - Length: " . length($pt) . "\n";
! 354: $cyphertext .= $pt;
! 355: }
! 356:
! 357: $cyphertext =~ s/$NULL+$//xm;
1.11 andrew 358:
1.14 ! andrew 359: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11 andrew 360:
1.14 ! andrew 361: return $cyphertext;
! 362: }
1.11 andrew 363:
1.14 ! andrew 364: 1;
! 365: __END__
1.11 andrew 366:
1.14 ! andrew 367: =head1 NAME
1.11 andrew 368:
1.14 ! andrew 369: Palm::Keyring - Handler for Palm Keyring databases.
1.1 andrew 370:
1.14 ! andrew 371: =head1 DESCRIPTION
1.7 andrew 372:
1.14 ! andrew 373: The Keyring PDB handler is a helper class for the Palm::PDB package. It
! 374: parses Keyring for Palm OS databases. See
! 375: L<http://gnukeyring.sourceforge.net/>.
1.1 andrew 376:
1.14 ! andrew 377: It has the standard Palm::PDB methods with 2 additional public methods.
! 378: Decrypt and Encrypt.
1.1 andrew 379:
1.14 ! andrew 380: It currently supports the v4 Keyring databases. The v5 databases from the pre-release keyring-2.0 are not supported.
1.1 andrew 381:
1.14 ! andrew 382: =head1 SYNOPSIS
1.1 andrew 383:
1.14 ! andrew 384: use Palm::PDB;
! 385: use Palm::Keyring;
! 386: my $pdb = new Palm::PDB;
! 387: $pdb->Load($file);
! 388: foreach my $rec (@{ $pdb->{'records'} }) {
! 389: print "$rec->{'plaintext'}->{'name'}\n";
1.1 andrew 390: }
1.14 ! andrew 391: $pdb->Decrypt($password);
! 392: # do something with the decrypted parts
1.1 andrew 393:
1.14 ! andrew 394: =head1 SUBROUTINES/METHODS
1.1 andrew 395:
1.14 ! andrew 396: =head2 new
1.11 andrew 397:
1.14 ! andrew 398: $pdb = new Palm::Keyring([$password]);
1.11 andrew 399:
1.14 ! andrew 400: Create a new PDB, initialized with the various Palm::Keyring fields
! 401: and an empty record list.
1.11 andrew 402:
1.14 ! andrew 403: Use this method if you're creating a Keyring PDB from scratch otherwise you
! 404: can just use Palm::PDB::new().
1.11 andrew 405:
1.14 ! andrew 406: =head2 Load
1.11 andrew 407:
1.14 ! andrew 408: $pdb->Load($filename[, $password]);
1.11 andrew 409:
1.14 ! andrew 410: Overrides the standard Palm::Raw Load() to add
! 411: $rec->{'plaintext'}->{'name'} and
! 412: $rec->{'encrypted'} fields.
! 413: $rec->{'plaintext'}->{'name'} holds the name of the record,
! 414: $rec->{'encrypted'} is the encrypted information in the PDB.
1.1 andrew 415:
1.14 ! andrew 416: It also takes an additional optional parameter, which is the password to use to
! 417: decrypt the database.
1.1 andrew 418:
1.14 ! andrew 419: See Decrypt() for the additional fields that are available after decryption.
1.7 andrew 420:
1.14 ! andrew 421: =head2 Write
1.1 andrew 422:
1.14 ! andrew 423: $pdb->Write($filename[, $password]);
1.1 andrew 424:
1.14 ! andrew 425: Just like the Palm::Raw::Write() but encrypts everything before saving.
1.1 andrew 426:
1.14 ! andrew 427: Also takes an optional password to encrypt with a new password, not needed
! 428: unless you are changing the password.
1.1 andrew 429:
1.14 ! andrew 430: =head2 Encrypt
1.1 andrew 431:
1.14 ! andrew 432: $pdb->Encrypt([$password]);
1.1 andrew 433:
1.14 ! andrew 434: Encrypts the PDB, either with the password used to decrypt or create it, or
! 435: optionally with a password that is passed.
1.1 andrew 436:
1.14 ! andrew 437: See Decrypt() for an what plaintext fields are available to be encrypted.
1.1 andrew 438:
1.14 ! andrew 439: =head2 Decrypt
1.1 andrew 440:
1.14 ! andrew 441: $pdb->Decrypt([$password]);
1.1 andrew 442:
1.14 ! andrew 443: Decrypts the PDB and fills out the rest of the fields available in
! 444: $rec->{'plaintext'}.
1.1 andrew 445:
1.14 ! andrew 446: The plaintext should now be this, before encryption or after decryption:
1.1 andrew 447:
1.14 ! andrew 448: $rec->{'plaintext'} = {
! 449: name => $name,
! 450: account => $account,
! 451: password => $account_password,
! 452: description => $description,
! 453: };
1.1 andrew 454:
1.14 ! andrew 455: =head1 DEPENDENCIES
1.1 andrew 456:
1.14 ! andrew 457: Palm::StdAppInfo
1.1 andrew 458:
1.14 ! andrew 459: Digest::MD5
1.9 andrew 460:
1.14 ! andrew 461: Crypt::DES
1.4 andrew 462:
1.14 ! andrew 463: Readonly
1.10 andrew 464:
1.14 ! andrew 465: =head1 BUGS AND LIMITATIONS
1.1 andrew 466:
1.14 ! andrew 467: Once this module is uploaded, you can
! 468: Please report any bugs or feature requests to
! 469: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
! 470: L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
! 471: notified of progress on your bug as I make changes.
1.1 andrew 472:
473: =head1 AUTHOR
474:
1.12 andrew 475: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1 andrew 476:
1.14 ! andrew 477: =head1 LICENSE AND COPYRIGHT
! 478:
! 479: You may distribute this file under the terms of perl itself
! 480: as specified in the LICENSE file.
! 481:
! 482: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
! 483:
! 484: This program is free software; you can redistribute it and/or modify it
! 485: under the same terms as Perl itself.
! 486:
1.1 andrew 487: =head1 SEE ALSO
488:
489: Palm::PDB(3)
490:
491: Palm::StdAppInfo(3)
1.11 andrew 492:
493: The Keyring for Palm OS website:
494: L<http://gnukeyring.sourceforge.net/>
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to Keyring.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / palm / Palm-Keyring / lib / Palm