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