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