Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.18
1.14 andrew 1: package Palm::Keyring;
2:
1.18 ! andrew 3: # $RedRiver: Keyring.pm,v 1.17 2007/01/30 05:16:16 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;
1.17 andrew 394:
395: my $pass = 'password';
1.18 ! andrew 396: my $file = 'Keys-Gtkr.pdb';
! 397: my $pdb = new Palm::PDB;
1.16 andrew 398: $pdb->Load($file);
1.17 andrew 399:
400: foreach (0..$#{ $pdb->{'records'} }) {
401: next if $_ = 0; # skip the password record
402: my $rec = $pdb->{'records'}->[$_];
403: my $acct = $pdb->Decrypt($rec, $pass);
404: print $rec->{'data'}, ' - ', $acct->{'account'}, "\n";
1.16 andrew 405: }
1.1 andrew 406:
1.14 andrew 407: =head1 SUBROUTINES/METHODS
1.1 andrew 408:
1.14 andrew 409: =head2 new
1.11 andrew 410:
1.16 andrew 411: $pdb = new Palm::Keyring([$password]);
1.11 andrew 412:
1.14 andrew 413: Create a new PDB, initialized with the various Palm::Keyring fields
414: and an empty record list.
1.11 andrew 415:
1.14 andrew 416: Use this method if you're creating a Keyring PDB from scratch otherwise you
1.16 andrew 417: can just use Palm::PDB::new() before calling Load().
1.11 andrew 418:
1.16 andrew 419: =head2 Encrypt
1.11 andrew 420:
1.16 andrew 421: $pdb->Encrypt($rec, $acct, [$password]);
1.11 andrew 422:
1.16 andrew 423: Encrypts an account into a record, either with the password previously
424: used, or with a password that is passed.
1.1 andrew 425:
1.16 andrew 426: $rec is a record from $pdb->{'records'} or a newly generated record.
427: $acct is a hashref in the format below.
1.1 andrew 428:
1.16 andrew 429: my $acct = {
430: account => $account,
431: password => $password,
432: notes => $notes,
433: };
1.7 andrew 434:
1.16 andrew 435: =head2 Decrypt
1.1 andrew 436:
1.16 andrew 437: my $acct = $pdb->Decrypt($rec[, $password]);
1.1 andrew 438:
1.16 andrew 439: Decrypts the record and returns a hashref for the account as described
440: under Encrypt();
1.1 andrew 441:
1.16 andrew 442: foreach (0..$#{ $pdb->{'records'}) {
443: next if $_ == 0;
444: my $rec = $pdb->{'records'}->[$_];
445: my $acct = $pdb->Decrypt($rec[, $password]);
446: # do something with $acct
447: }
1.1 andrew 448:
1.16 andrew 449: =head2 Password
1.1 andrew 450:
1.16 andrew 451: $pdb->Password([$password[, $new_password]]);
1.1 andrew 452:
1.16 andrew 453: Either sets the password to be used to crypt, or if you pass $new_password,
454: changes the password on the database.
1.1 andrew 455:
1.16 andrew 456: If you have created a new $pdb, and you didn't set a password when you
457: called new(), you only need to pass one password and it will set that as
458: the password.
1.1 andrew 459:
1.16 andrew 460: If nothing is passed, and there has been a password used before,
461: it just verifies that the password was correct.
1.1 andrew 462:
1.14 andrew 463: =head1 DEPENDENCIES
1.1 andrew 464:
1.14 andrew 465: Palm::StdAppInfo
1.1 andrew 466:
1.14 andrew 467: Digest::MD5
1.9 andrew 468:
1.14 andrew 469: Crypt::DES
1.4 andrew 470:
1.14 andrew 471: Readonly
1.10 andrew 472:
1.14 andrew 473: =head1 BUGS AND LIMITATIONS
1.1 andrew 474:
1.14 andrew 475: Once this module is uploaded, you can
476: Please report any bugs or feature requests to
477: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
478: L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
479: notified of progress on your bug as I make changes.
1.1 andrew 480:
481: =head1 AUTHOR
482:
1.12 andrew 483: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1 andrew 484:
1.14 andrew 485: =head1 LICENSE AND COPYRIGHT
486:
487: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
488:
1.15 andrew 489: This program is free software; you can redistribute it and/or
490: modify it under the same terms as Perl itself.
1.14 andrew 491:
1.1 andrew 492: =head1 SEE ALSO
493:
494: Palm::PDB(3)
495:
496: Palm::StdAppInfo(3)
1.11 andrew 497:
498: The Keyring for Palm OS website:
499: 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