Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.22
1.14 andrew 1: package Palm::Keyring;
2:
1.22 ! andrew 3: # $RedRiver: Keyring.pm,v 1.21 2007/01/31 05:32:20 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.19 andrew 28: our $VERSION = 0.92;
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: return $rec if ! exists $rec->{'data'};
1.14 andrew 75:
1.16 andrew 76: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
1.1 andrew 77:
1.16 andrew 78: return $rec if ! $encrypted;
1.19 andrew 79: delete $rec->{'data'};
80: $rec->{'name'} = $name;
1.16 andrew 81: $rec->{'encrypted'} = $encrypted;
1.12 andrew 82:
1.16 andrew 83: return $rec;
1.14 andrew 84: }
1.11 andrew 85:
1.16 andrew 86: sub PackRecord {
87: my $self = shift;
88: my $rec = shift;
89:
90: my $rec0_id = $self->{'records'}->[0]->{'id'};
91:
92: if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) {
1.22 ! andrew 93: if (! defined $rec->{'name'}) {
! 94: $rec->{'name'} = $EMPTY;
! 95: }
1.19 andrew 96: $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'};
97: delete $rec->{'name'};
1.16 andrew 98: delete $rec->{'encrypted'};
99: }
1.1 andrew 100:
1.16 andrew 101: return $self->SUPER::PackRecord($rec, @_);
1.14 andrew 102: }
1.1 andrew 103:
1.14 andrew 104: sub Encrypt {
105: my $self = shift;
1.16 andrew 106: my $rec = shift;
107: my $data = shift;
108: my $pass = shift || $self->{'password'};
109:
110: if ( ! $pass) {
111: croak("'password' not set!\n");
112: }
113:
114: if ( ! $rec) {
115: croak("Needed parameter 'record' not passed!\n");
116: }
1.14 andrew 117:
1.16 andrew 118: if ( ! $data) {
119: croak("Needed parameter 'data' not passed!\n");
1.14 andrew 120: }
121:
1.16 andrew 122: if ( ! $self->Password($pass)) {
123: croak("Incorrect Password!\n");
124: }
1.14 andrew 125:
1.22 ! andrew 126: $self->{'digest'} ||= _calc_keys( $pass );
1.14 andrew 127:
1.16 andrew 128: $data->{'account'} ||= $EMPTY;
129: $data->{'password'} ||= $EMPTY;
130: $data->{'notes'} ||= $EMPTY;
1.1 andrew 131:
1.22 ! andrew 132: my $changed = 0;
! 133: my $need_newdate = 0;
! 134: my $acct = {};
! 135: if ($rec->{'encrypted'}) {
! 136: $acct = $self->Decrypt($rec, $pass);
! 137: foreach my $key (keys %{ $data }) {
! 138: next if $key eq 'lastchange';
! 139: if ($data->{$key} ne $acct->{$key}) {
! 140: $changed = 1;
! 141: last;
! 142: }
! 143: }
! 144: if ( exists $data->{'lastchange'} && exists $acct->{'lastchange'} && (
! 145: $data->{'lastchange'}->{day} != $acct->{'lastchange'}->{day} ||
! 146: $data->{'lastchange'}->{month} != $acct->{'lastchange'}->{month} ||
! 147: $data->{'lastchange'}->{year} != $acct->{'lastchange'}->{year}
! 148: )) {
! 149: $changed = 1;
! 150: $need_newdate = 0;
! 151: } else {
! 152: $need_newdate = 1;
! 153: }
! 154:
! 155: } else {
! 156: $changed = 1;
! 157: }
! 158:
! 159: # no need to re-encrypt if it has not changed.
! 160: return 1 if ! $changed;
! 161:
1.21 andrew 162: my ($day, $month, $year);
163:
1.22 ! andrew 164: if ($data->{'lastchange'} && ! $need_newdate ) {
! 165: $day = $data->{'lastchange'}->{'day'} || 1;
! 166: $month = $data->{'lastchange'}->{'month'} || 0;
! 167: $year = $data->{'lastchange'}->{'year'} || 0;
! 168:
! 169: # XXX Need to actually validate the above information somehow
! 170: if ($year >= 1900) {
! 171: $year -= 1900;
! 172: }
! 173: } else {
! 174: $need_newdate = 1;
! 175: }
! 176:
! 177: if ($need_newdate) {
1.21 andrew 178: ($day, $month, $year) = (localtime)[3,4,5];
179: }
1.22 ! andrew 180: $year -= 4;
! 181: $month++;
! 182:
1.19 andrew 183:
184: my $p = $day | ($month << 5) | ($year << 9);
185: my $packeddate = pack 'n', $p;
186:
1.16 andrew 187: my $plaintext = join $NULL,
1.19 andrew 188: $data->{'account'}, $data->{'password'}, $data->{'notes'}, $packeddate;
1.1 andrew 189:
1.16 andrew 190: my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );
1.11 andrew 191:
1.16 andrew 192: return if ! $encrypted;
1.1 andrew 193:
1.19 andrew 194: $rec->{'attributes'}{'Dirty'} = 1;
195: $rec->{'attributes'}{'dirty'} = 1;
196: $rec->{'name'} ||= $data->{'name'};
1.16 andrew 197: $rec->{'encrypted'} = $encrypted;
1.19 andrew 198:
1.14 andrew 199: return 1;
200: }
1.1 andrew 201:
1.14 andrew 202: sub Decrypt {
203: my $self = shift;
1.16 andrew 204: my $rec = shift;
205: my $pass = shift || $self->{'password'};
206:
207: if ( ! $pass) {
208: croak("'password' not set!\n");
209: }
210:
211: if ( ! $rec) {
1.19 andrew 212: croak("Needed parameter 'record' not passed!\n");
1.16 andrew 213: }
1.14 andrew 214:
1.16 andrew 215: if ( ! $self->Password($pass)) {
216: croak("Invalid Password!\n");
1.14 andrew 217: }
218:
1.16 andrew 219: if ( ! $rec->{'encrypted'} ) {
220: croak("No encrypted content!");
221: }
1.14 andrew 222:
1.16 andrew 223: $self->{'digest'} ||= _calc_keys( $pass );
1.14 andrew 224:
1.16 andrew 225: my $decrypted =
226: _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );
1.19 andrew 227: my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm,
1.16 andrew 228: $decrypted, 4;
1.14 andrew 229:
1.19 andrew 230: my %Modified;
231: if ($packeddate) {
232: my $u = unpack 'n', $packeddate;
233: my $year = (($u & 0xFE00) >> 9) + 4; # since 1900
234: my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
235: my $day = (($u & 0x001F) >> 0); # 1-31
236:
237: %Modified = (
238: year => $year,
239: month => $month || 0,
240: day => $day || 1,
241: );
242: }
243:
1.16 andrew 244: return {
1.20 andrew 245: name => $rec->{'name'},
246: account => $account,
247: password => $password,
248: notes => $notes,
249: lastchange => \%Modified,
1.16 andrew 250: };
251: }
1.14 andrew 252:
1.16 andrew 253: sub Password {
254: my $self = shift;
255: my $pass = shift || $self->{'password'};
256: my $new_pass = shift;
1.14 andrew 257:
1.16 andrew 258: if (! exists $self->{'records'}) {
259: # Give the PDB the first record that will hold the encrypted password
260: $self->{'records'} = [ $self->new_Record ];
261:
262: return $self->_password_update($pass);
263: }
264:
265: if ($new_pass) {
266: my @accts = ();
267: foreach my $i (0..$#{ $self->{'records'} }) {
268: if ($i == 0) {
269: push @accts, undef;
270: next;
271: }
272: my $acct = $self->Decrypt($self->{'records'}->[$i], $pass);
273: if ( ! $acct ) {
1.19 andrew 274: croak("Couldn't decrypt $self->{'records'}->[$i]->{'name'}");
1.16 andrew 275: }
276: push @accts, $acct;
277: }
1.14 andrew 278:
1.16 andrew 279: if ( ! $self->_password_update($new_pass)) {
280: croak("Couldn't set new password!");
281: }
282: $pass = $new_pass;
1.1 andrew 283:
1.16 andrew 284: foreach my $i (0..$#accts) {
285: next if $i == 0;
1.22 ! andrew 286: delete $self->{'records'}->[$i]->{'encrypted'};
1.16 andrew 287: $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);
288: }
1.14 andrew 289: }
1.1 andrew 290:
1.16 andrew 291: return $self->_password_verify($pass);
1.1 andrew 292: }
293:
1.14 andrew 294: sub _calc_keys {
295: my $pass = shift;
296: if (! defined $pass) { croak('No password defined!'); };
297:
298: my $digest = md5($pass);
299:
300: my ( $key1, $key2 ) = unpack 'a8a8', $digest;
301:
302: #--------------------------------------------------
303: # print "key1: $key1: ", length $key1, "\n";
304: # print "key2: $key2: ", length $key2, "\n";
305: #--------------------------------------------------
306:
307: $digest = unpack 'H*', $key1 . $key2 . $key1;
308:
309: #--------------------------------------------------
310: # print "Digest: ", $digest, "\n";
311: # print length $digest, "\n";
312: #--------------------------------------------------
313:
314: return $digest;
1.3 andrew 315: }
316:
1.16 andrew 317: sub _password_verify {
1.14 andrew 318: my $self = shift;
319: my $pass = shift;
320:
321: if (! $pass) { croak('No password specified!'); };
1.11 andrew 322:
1.16 andrew 323: if (defined $self->{'password'} && $pass eq $self->{'password'}) {
324: # already verified this password
325: return 1;
326: }
327:
1.14 andrew 328: # AFAIK the thing we use to test the password is
329: # always in the first entry
330: my $data = $self->{'records'}->[0]->{'data'};
1.11 andrew 331:
1.14 andrew 332: #die "No encrypted password in file!" unless defined $data;
1.16 andrew 333: if ( ! defined $data) { return; };
1.11 andrew 334:
1.14 andrew 335: $data =~ s/$NULL$//xm;
1.11 andrew 336:
1.14 andrew 337: my $salt = substr $data, 0, $kSalt_Size;
1.11 andrew 338:
1.14 andrew 339: my $msg = $salt . $pass;
1.11 andrew 340:
1.14 andrew 341: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11 andrew 342:
1.14 andrew 343: my $digest = md5($msg);
1.11 andrew 344:
1.14 andrew 345: if ( $data eq $salt . $digest ) {
1.11 andrew 346:
1.14 andrew 347: # May as well generate the keys we need now, since we know the password is right
348: $self->{'digest'} = _calc_keys($pass);
349: if ( $self->{'digest'} ) {
350: $self->{'password'} = $pass;
351: return 1;
352: }
353: }
354: return;
1.6 andrew 355: }
356:
1.16 andrew 357: sub _password_update {
1.14 andrew 358:
359: # It is very important to Encrypt after calling this
360: # (Although it is generally only called by Encrypt)
361: # because otherwise the data will be out of sync with the
362: # password, and that would suck!
363: my $self = shift;
364: my $pass = shift;
365:
1.16 andrew 366: if (! defined $pass) { croak('No password specified!'); };
1.14 andrew 367:
368: my $salt;
369: for ( 1 .. $kSalt_Size ) {
370: $salt .= chr int rand 255;
371: }
372:
373: my $msg = $salt . $pass;
1.11 andrew 374:
1.14 andrew 375: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11 andrew 376:
1.14 andrew 377: my $digest = md5($msg);
1.11 andrew 378:
1.14 andrew 379: my $data = $salt . $digest; # . "\0";
1.11 andrew 380:
1.14 andrew 381: # AFAIK the thing we use to test the password is
382: # always in the first entry
383: $self->{'records'}->[0]->{'data'} = $data;
1.11 andrew 384:
1.14 andrew 385: $self->{'password'} = $pass;
386: $self->{'digest'} = _calc_keys( $self->{'password'} );
1.11 andrew 387:
1.14 andrew 388: return 1;
1.1 andrew 389: }
390:
1.14 andrew 391: sub _crypt3des {
392: my ( $plaintext, $passphrase, $flag ) = @_;
393:
394: $passphrase .= $SPACE x ( 16 * 3 );
395: my $cyphertext = $EMPTY;
396:
397: my $size = length $plaintext;
1.11 andrew 398:
1.14 andrew 399: #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
400:
401: my @C;
402: for ( 0 .. 2 ) {
403: $C[$_] =
404: new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
405: }
406:
407: for ( 0 .. ( ($size) / 8 ) ) {
408: my $pt = substr $plaintext, $_ * 8, 8;
409:
410: #print "PT: '$pt' - Length: " . length($pt) . "\n";
411: if (! length $pt) { next; };
412: if ( (length $pt) < 8 ) {
1.16 andrew 413: if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
1.14 andrew 414: my $len = 8 - (length $pt);
415:
416: #print "LENGTH: $len\n";
417: #print "Binary: '" . unpack("b*", $pt) . "'\n";
418: $pt .= ($NULL x $len);
419:
420: #print "PT: '$pt' - Length: " . length($pt) . "\n";
421: #print "Binary: '" . unpack("b*", $pt) . "'\n";
422: }
423: if ( $flag == $ENCRYPT ) {
424: $pt = $C[0]->encrypt($pt);
425: $pt = $C[1]->decrypt($pt);
426: $pt = $C[2]->encrypt($pt);
427: }
428: else {
429: $pt = $C[0]->decrypt($pt);
430: $pt = $C[1]->encrypt($pt);
431: $pt = $C[2]->decrypt($pt);
432: }
433:
434: #print "PT: '$pt' - Length: " . length($pt) . "\n";
435: $cyphertext .= $pt;
436: }
437:
438: $cyphertext =~ s/$NULL+$//xm;
1.11 andrew 439:
1.14 andrew 440: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11 andrew 441:
1.14 andrew 442: return $cyphertext;
443: }
1.11 andrew 444:
1.14 andrew 445: 1;
446: __END__
1.11 andrew 447:
1.14 andrew 448: =head1 NAME
1.11 andrew 449:
1.14 andrew 450: Palm::Keyring - Handler for Palm Keyring databases.
1.1 andrew 451:
1.14 andrew 452: =head1 DESCRIPTION
1.7 andrew 453:
1.14 andrew 454: The Keyring PDB handler is a helper class for the Palm::PDB package. It
455: parses Keyring for Palm OS databases. See
456: L<http://gnukeyring.sourceforge.net/>.
1.1 andrew 457:
1.14 andrew 458: It has the standard Palm::PDB methods with 2 additional public methods.
459: Decrypt and Encrypt.
1.1 andrew 460:
1.16 andrew 461: It currently supports the v4 Keyring databases. The v5 databases from
462: the pre-release keyring-2.0 are not supported.
463:
464: This module doesn't store the decrypted content. It only keeps it until it
465: returns it to you or encrypts it.
1.1 andrew 466:
1.14 andrew 467: =head1 SYNOPSIS
1.1 andrew 468:
1.16 andrew 469: use Palm::PDB;
470: use Palm::Keyring;
1.17 andrew 471:
472: my $pass = 'password';
1.18 andrew 473: my $file = 'Keys-Gtkr.pdb';
474: my $pdb = new Palm::PDB;
1.16 andrew 475: $pdb->Load($file);
1.17 andrew 476:
477: foreach (0..$#{ $pdb->{'records'} }) {
478: next if $_ = 0; # skip the password record
479: my $rec = $pdb->{'records'}->[$_];
480: my $acct = $pdb->Decrypt($rec, $pass);
1.19 andrew 481: print $rec->{'name'}, ' - ', $acct->{'account'}, "\n";
1.16 andrew 482: }
1.1 andrew 483:
1.14 andrew 484: =head1 SUBROUTINES/METHODS
1.1 andrew 485:
1.14 andrew 486: =head2 new
1.11 andrew 487:
1.16 andrew 488: $pdb = new Palm::Keyring([$password]);
1.11 andrew 489:
1.14 andrew 490: Create a new PDB, initialized with the various Palm::Keyring fields
491: and an empty record list.
1.11 andrew 492:
1.14 andrew 493: Use this method if you're creating a Keyring PDB from scratch otherwise you
1.16 andrew 494: can just use Palm::PDB::new() before calling Load().
1.11 andrew 495:
1.16 andrew 496: =head2 Encrypt
1.11 andrew 497:
1.16 andrew 498: $pdb->Encrypt($rec, $acct, [$password]);
1.11 andrew 499:
1.16 andrew 500: Encrypts an account into a record, either with the password previously
501: used, or with a password that is passed.
1.1 andrew 502:
1.16 andrew 503: $rec is a record from $pdb->{'records'} or a newly generated record.
504: $acct is a hashref in the format below.
1.1 andrew 505:
1.16 andrew 506: my $acct = {
1.20 andrew 507: name => $rec->{'name'},
508: account => $account,
509: password => $password,
510: notes => $notes,
511: lastchange => {
512: year => 107, # years since 1900
513: month => 0, # 0-11, 0 = January, 11 = December
1.21 andrew 514: day => 30, # 1-31, same as localtime
1.20 andrew 515: },
1.16 andrew 516: };
1.7 andrew 517:
1.22 ! andrew 518: If you have changed anything other than the lastchange, or don't pass in a
! 519: lastchange record, Encrypt() will generate a new lastchange for you.
! 520:
! 521: If you pass in a lastchange field that is different than the one in the
! 522: record, it will honor what you passed in.
! 523:
! 524: It also only uses the $acct->{'name'} if there is not already a $rec->{'name'}.
! 525:
1.16 andrew 526: =head2 Decrypt
1.1 andrew 527:
1.16 andrew 528: my $acct = $pdb->Decrypt($rec[, $password]);
1.1 andrew 529:
1.16 andrew 530: Decrypts the record and returns a hashref for the account as described
1.20 andrew 531: under Encrypt().
1.1 andrew 532:
1.16 andrew 533: foreach (0..$#{ $pdb->{'records'}) {
534: next if $_ == 0;
535: my $rec = $pdb->{'records'}->[$_];
536: my $acct = $pdb->Decrypt($rec[, $password]);
537: # do something with $acct
538: }
1.1 andrew 539:
1.16 andrew 540: =head2 Password
1.1 andrew 541:
1.16 andrew 542: $pdb->Password([$password[, $new_password]]);
1.1 andrew 543:
1.16 andrew 544: Either sets the password to be used to crypt, or if you pass $new_password,
545: changes the password on the database.
1.1 andrew 546:
1.16 andrew 547: If you have created a new $pdb, and you didn't set a password when you
548: called new(), you only need to pass one password and it will set that as
549: the password.
1.1 andrew 550:
1.16 andrew 551: If nothing is passed, and there has been a password used before,
552: it just verifies that the password was correct.
1.1 andrew 553:
1.14 andrew 554: =head1 DEPENDENCIES
1.1 andrew 555:
1.14 andrew 556: Palm::StdAppInfo
1.1 andrew 557:
1.14 andrew 558: Digest::MD5
1.9 andrew 559:
1.14 andrew 560: Crypt::DES
1.4 andrew 561:
1.14 andrew 562: Readonly
1.10 andrew 563:
1.14 andrew 564: =head1 BUGS AND LIMITATIONS
1.1 andrew 565:
1.14 andrew 566: Once this module is uploaded, you can
567: Please report any bugs or feature requests to
568: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
569: L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
570: notified of progress on your bug as I make changes.
1.1 andrew 571:
572: =head1 AUTHOR
573:
1.12 andrew 574: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1 andrew 575:
1.14 andrew 576: =head1 LICENSE AND COPYRIGHT
577:
578: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
579:
1.15 andrew 580: This program is free software; you can redistribute it and/or
581: modify it under the same terms as Perl itself.
1.14 andrew 582:
1.1 andrew 583: =head1 SEE ALSO
584:
585: Palm::PDB(3)
586:
587: Palm::StdAppInfo(3)
1.11 andrew 588:
589: The Keyring for Palm OS website:
590: 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