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