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