Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.15
1.14 andrew 1: package Palm::Keyring;
2:
1.15 ! andrew 3: # $RedRiver: Keyring.pm,v 1.14 2007/01/28 22:24:17 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.15 ! andrew 28: our ($VERSION) = q$Revision: 1.14 $ =~ m{ Revision: \s+ (\S+) }xm;
1.14 andrew 29:
30: #@ISA = qw( Palm::StdAppInfo Palm::Raw );
1.1 andrew 31:
1.14 andrew 32: sub new {
33: my $classname = shift;
34: my $pass = shift;
1.1 andrew 35:
1.14 andrew 36: # Create a generic PDB. No need to rebless it, though.
37: my $self = $classname->SUPER::new(@_);
1.1 andrew 38:
1.14 andrew 39: $self->{'name'} = 'Keys-Gtkr'; # Default
40: $self->{'creator'} = 'Gtkr';
41: $self->{'type'} = 'Gkyr';
42:
43: # The PDB is not a resource database by
44: # default, but it's worth emphasizing,
45: # since MemoDB is explicitly not a PRC.
46: $self->{'attributes'}{'resource'} = 0;
1.1 andrew 47:
1.14 andrew 48: # Initialize the AppInfo block
49: $self->{'appinfo'} = {};
1.1 andrew 50:
1.14 andrew 51: # Add the standard AppInfo block stuff
52: Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} );
1.1 andrew 53:
1.14 andrew 54: # Set the version
55: $self->{'version'} = 4;
1.1 andrew 56:
1.14 andrew 57: # Give the PDB the first record that will hold the encrypted password
58: $self->{'records'} = [ $self->new_Record ];
1.1 andrew 59:
1.14 andrew 60: if ( defined $pass ) {
61: $self->Encrypt($pass);
62: }
1.1 andrew 63:
1.14 andrew 64: return $self;
65: }
1.1 andrew 66:
1.14 andrew 67: sub import {
68: Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
69: return 1;
70: }
1.1 andrew 71:
1.14 andrew 72: sub Load {
73: my $self = shift;
74: my $filename = shift;
75: my $password = shift;
76:
77: $self->{'appinfo'} = {};
78: $self->{'records'} = [];
79: $self->SUPER::Load($filename);
80:
81: foreach my $rec ( @{ $self->{'records'} } ) {
82: if ( ! exists $rec->{'data'}) { next; };
83: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
84: if ( ! $encrypted ) { next };
85: $rec->{'plaintext'}->{'name'} = $name;
86: $rec->{'encrypted'} = $encrypted;
87: }
1.1 andrew 88:
1.14 andrew 89: return $self->Decrypt($password) if defined $password;
1.12 andrew 90:
1.14 andrew 91: return 1;
92: }
1.11 andrew 93:
1.14 andrew 94: sub Write {
95: my $self = shift;
96: my $filename = shift;
97: my $password = shift;
1.1 andrew 98:
1.14 andrew 99: $self->Encrypt($password) || return;
100: return $self->SUPER::Write($filename);
101: }
1.1 andrew 102:
1.14 andrew 103: sub Encrypt {
104: my $self = shift;
105: my $pass = shift;
106:
107: if ($pass) {
108: if (
109: !( exists $self->{'records'}->[0]->{'data'}
110: && $self->_keyring_verify($pass) )
111: )
112: {
113:
114: # This would encrypt with a new password.
115: # First decrypting everything with the old password of course.
116: $self->_keyring_update($pass) || return;
117: $self->_keyring_verify($pass) || return;
118: }
119: }
120:
121: $self->{'digest'} ||= _calc_keys( $self->{'password'} );
122:
123: foreach my $rec ( @{ $self->{'records'} } ) {
124: if (!defined $rec->{'plaintext'}) { next; };
125:
126: my $name =
127: defined $rec->{'plaintext'}->{'name'}
128: ? $rec->{'plaintext'}->{'name'}
129: : $EMPTY;
130: my $account =
131: defined $rec->{'plaintext'}->{'account'}
132: ? $rec->{'plaintext'}->{'account'}
133: : $EMPTY;
134: my $password =
135: defined $rec->{'plaintext'}->{'password'}
136: ? $rec->{'plaintext'}->{'password'}
137: : $EMPTY;
138: my $description =
139: defined $rec->{'plaintext'}->{'description'}
140: ? $rec->{'plaintext'}->{'description'}
141: : $EMPTY;
142: my $extra = $EMPTY;
1.1 andrew 143:
1.14 andrew 144: my $plaintext = join "$NULL", $account, $password, $description, $extra;
1.1 andrew 145:
1.14 andrew 146: my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );
1.11 andrew 147:
1.14 andrew 148: $rec->{'data'} = join "$NULL", $name, $encrypted;
149: }
1.1 andrew 150:
1.14 andrew 151: return 1;
152: }
1.1 andrew 153:
1.14 andrew 154: sub Decrypt {
155: my $self = shift;
156: my $pass = shift;
157:
158: if ($pass) {
159: $self->_keyring_verify($pass) || return;
160: }
161:
162: $self->{'digest'} ||= _calc_keys( $self->{'password'} );
163:
164: my $reccount = 0;
165: foreach my $rec ( @{ $self->{'records'} } ) {
166: $reccount++;
167:
168: # always skip the first record that has the password in it.
169: next if $reccount <= 1;
170: if ( ! defined $rec->{'data'} ) {
171: warn 'Invalid record ' . ( $reccount - 1 ) . "\n";
172: next;
173: }
174:
175: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
176: if (! $encrypted) { next; };
177:
178: $rec->{'plaintext'}->{'name'} = $name;
179:
180: my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT );
181: my ( $account, $password, $description, $extra ) = split /$NULL/xm,
182: $decrypted, 4;
183:
184: $rec->{'plaintext'}->{'account'} = defined $account ? $account : $EMPTY;
185: $rec->{'plaintext'}->{'password'} =
186: defined $password ? $password : $EMPTY;
187: $rec->{'plaintext'}->{'description'} =
188: defined $description ? $description : $EMPTY;
189:
190: #print "Name: '$name'\n";
191: #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
192: #print " Hex: '" . unpack("H*", $encrypted) . "'\n";
193: #print " Binary:'" . unpack("b*", $encrypted) . "'\n";
194: #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
195: #print " Hex: '" . unpack("H*", $decrypted) . "'\n";
196: #print " Binary:'" . unpack("b*", $decrypted) . "'\n";
197: #print "\n";
198: #print "Extra: $extra\n";
199: #exit;
200: #--------------------------------------------------
201: # print "Account: $account\n";
202: # print "Password: $password\n";
203: # print "Description: $description\n";
204: #--------------------------------------------------
1.1 andrew 205:
1.14 andrew 206: }
1.1 andrew 207:
1.14 andrew 208: return 1;
1.1 andrew 209: }
210:
1.14 andrew 211: sub _calc_keys {
212: my $pass = shift;
213: if (! defined $pass) { croak('No password defined!'); };
214:
215: my $digest = md5($pass);
216:
217: my ( $key1, $key2 ) = unpack 'a8a8', $digest;
218:
219: #--------------------------------------------------
220: # print "key1: $key1: ", length $key1, "\n";
221: # print "key2: $key2: ", length $key2, "\n";
222: #--------------------------------------------------
223:
224: $digest = unpack 'H*', $key1 . $key2 . $key1;
225:
226: #--------------------------------------------------
227: # print "Digest: ", $digest, "\n";
228: # print length $digest, "\n";
229: #--------------------------------------------------
230:
231: return $digest;
1.3 andrew 232: }
233:
1.14 andrew 234: sub _keyring_verify {
235: my $self = shift;
236: my $pass = shift;
237:
238: if (! $pass) { croak('No password specified!'); };
1.11 andrew 239:
1.14 andrew 240: # AFAIK the thing we use to test the password is
241: # always in the first entry
242: my $data = $self->{'records'}->[0]->{'data'};
1.11 andrew 243:
1.14 andrew 244: #die "No encrypted password in file!" unless defined $data;
245: if (! defined $data) { return; };
1.11 andrew 246:
1.14 andrew 247: $data =~ s/$NULL$//xm;
1.11 andrew 248:
1.14 andrew 249: my $salt = substr $data, 0, $kSalt_Size;
1.11 andrew 250:
1.14 andrew 251: my $msg = $salt . $pass;
1.11 andrew 252:
1.14 andrew 253: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11 andrew 254:
1.14 andrew 255: my $digest = md5($msg);
1.11 andrew 256:
1.14 andrew 257: if ( $data eq $salt . $digest ) {
1.11 andrew 258:
1.14 andrew 259: # May as well generate the keys we need now, since we know the password is right
260: $self->{'digest'} = _calc_keys($pass);
261: if ( $self->{'digest'} ) {
262: $self->{'password'} = $pass;
263: return 1;
264: }
265: }
266: return;
1.6 andrew 267: }
268:
1.14 andrew 269: sub _keyring_update {
270:
271: # It is very important to Encrypt after calling this
272: # (Although it is generally only called by Encrypt)
273: # because otherwise the data will be out of sync with the
274: # password, and that would suck!
275: my $self = shift;
276: my $pass = shift;
277:
278: if (! $pass) { croak('No password specified!'); };
1.11 andrew 279:
1.14 andrew 280: # if the database already has a password in it
281: if ( $self->{'records'}->[0]->{'data'} ) {
282:
283: # Make sure everything is decrypted before we update the keyring
284: $self->Decrypt() || return;
285: }
286:
287: my $salt;
288: for ( 1 .. $kSalt_Size ) {
289: $salt .= chr int rand 255;
290: }
291:
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: my $data = $salt . $digest; # . "\0";
1.11 andrew 299:
1.14 andrew 300: # AFAIK the thing we use to test the password is
301: # always in the first entry
302: $self->{'records'}->[0]->{'data'} = $data;
1.11 andrew 303:
1.14 andrew 304: $self->{'password'} = $pass;
305: $self->{'digest'} = _calc_keys( $self->{'password'} );
1.11 andrew 306:
1.14 andrew 307: return 1;
1.1 andrew 308: }
309:
1.14 andrew 310: sub _crypt3des {
311: my ( $plaintext, $passphrase, $flag ) = @_;
312:
313: $passphrase .= $SPACE x ( 16 * 3 );
314: my $cyphertext = $EMPTY;
315:
316: my $size = length $plaintext;
1.11 andrew 317:
1.14 andrew 318: #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
319:
320: my @C;
321: for ( 0 .. 2 ) {
322: $C[$_] =
323: new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
324: }
325:
326: for ( 0 .. ( ($size) / 8 ) ) {
327: my $pt = substr $plaintext, $_ * 8, 8;
328:
329: #print "PT: '$pt' - Length: " . length($pt) . "\n";
330: if (! length $pt) { next; };
331: if ( (length $pt) < 8 ) {
332: if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
333: my $len = 8 - (length $pt);
334:
335: #print "LENGTH: $len\n";
336: #print "Binary: '" . unpack("b*", $pt) . "'\n";
337: $pt .= ($NULL x $len);
338:
339: #print "PT: '$pt' - Length: " . length($pt) . "\n";
340: #print "Binary: '" . unpack("b*", $pt) . "'\n";
341: }
342: if ( $flag == $ENCRYPT ) {
343: $pt = $C[0]->encrypt($pt);
344: $pt = $C[1]->decrypt($pt);
345: $pt = $C[2]->encrypt($pt);
346: }
347: else {
348: $pt = $C[0]->decrypt($pt);
349: $pt = $C[1]->encrypt($pt);
350: $pt = $C[2]->decrypt($pt);
351: }
352:
353: #print "PT: '$pt' - Length: " . length($pt) . "\n";
354: $cyphertext .= $pt;
355: }
356:
357: $cyphertext =~ s/$NULL+$//xm;
1.11 andrew 358:
1.14 andrew 359: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11 andrew 360:
1.14 andrew 361: return $cyphertext;
362: }
1.11 andrew 363:
1.14 andrew 364: 1;
365: __END__
1.11 andrew 366:
1.14 andrew 367: =head1 NAME
1.11 andrew 368:
1.14 andrew 369: Palm::Keyring - Handler for Palm Keyring databases.
1.1 andrew 370:
1.14 andrew 371: =head1 DESCRIPTION
1.7 andrew 372:
1.14 andrew 373: The Keyring PDB handler is a helper class for the Palm::PDB package. It
374: parses Keyring for Palm OS databases. See
375: L<http://gnukeyring.sourceforge.net/>.
1.1 andrew 376:
1.14 andrew 377: It has the standard Palm::PDB methods with 2 additional public methods.
378: Decrypt and Encrypt.
1.1 andrew 379:
1.14 andrew 380: It currently supports the v4 Keyring databases. The v5 databases from the pre-release keyring-2.0 are not supported.
1.1 andrew 381:
1.14 andrew 382: =head1 SYNOPSIS
1.1 andrew 383:
1.14 andrew 384: use Palm::PDB;
385: use Palm::Keyring;
386: my $pdb = new Palm::PDB;
387: $pdb->Load($file);
388: foreach my $rec (@{ $pdb->{'records'} }) {
389: print "$rec->{'plaintext'}->{'name'}\n";
1.1 andrew 390: }
1.14 andrew 391: $pdb->Decrypt($password);
392: # do something with the decrypted parts
1.1 andrew 393:
1.14 andrew 394: =head1 SUBROUTINES/METHODS
1.1 andrew 395:
1.14 andrew 396: =head2 new
1.11 andrew 397:
1.14 andrew 398: $pdb = new Palm::Keyring([$password]);
1.11 andrew 399:
1.14 andrew 400: Create a new PDB, initialized with the various Palm::Keyring fields
401: and an empty record list.
1.11 andrew 402:
1.14 andrew 403: Use this method if you're creating a Keyring PDB from scratch otherwise you
404: can just use Palm::PDB::new().
1.11 andrew 405:
1.14 andrew 406: =head2 Load
1.11 andrew 407:
1.14 andrew 408: $pdb->Load($filename[, $password]);
1.11 andrew 409:
1.14 andrew 410: Overrides the standard Palm::Raw Load() to add
411: $rec->{'plaintext'}->{'name'} and
412: $rec->{'encrypted'} fields.
413: $rec->{'plaintext'}->{'name'} holds the name of the record,
414: $rec->{'encrypted'} is the encrypted information in the PDB.
1.1 andrew 415:
1.14 andrew 416: It also takes an additional optional parameter, which is the password to use to
417: decrypt the database.
1.1 andrew 418:
1.14 andrew 419: See Decrypt() for the additional fields that are available after decryption.
1.7 andrew 420:
1.14 andrew 421: =head2 Write
1.1 andrew 422:
1.14 andrew 423: $pdb->Write($filename[, $password]);
1.1 andrew 424:
1.14 andrew 425: Just like the Palm::Raw::Write() but encrypts everything before saving.
1.1 andrew 426:
1.14 andrew 427: Also takes an optional password to encrypt with a new password, not needed
428: unless you are changing the password.
1.1 andrew 429:
1.14 andrew 430: =head2 Encrypt
1.1 andrew 431:
1.14 andrew 432: $pdb->Encrypt([$password]);
1.1 andrew 433:
1.14 andrew 434: Encrypts the PDB, either with the password used to decrypt or create it, or
435: optionally with a password that is passed.
1.1 andrew 436:
1.14 andrew 437: See Decrypt() for an what plaintext fields are available to be encrypted.
1.1 andrew 438:
1.14 andrew 439: =head2 Decrypt
1.1 andrew 440:
1.14 andrew 441: $pdb->Decrypt([$password]);
1.1 andrew 442:
1.14 andrew 443: Decrypts the PDB and fills out the rest of the fields available in
444: $rec->{'plaintext'}.
1.1 andrew 445:
1.14 andrew 446: The plaintext should now be this, before encryption or after decryption:
1.1 andrew 447:
1.14 andrew 448: $rec->{'plaintext'} = {
449: name => $name,
450: account => $account,
451: password => $account_password,
452: description => $description,
453: };
1.1 andrew 454:
1.14 andrew 455: =head1 DEPENDENCIES
1.1 andrew 456:
1.14 andrew 457: Palm::StdAppInfo
1.1 andrew 458:
1.14 andrew 459: Digest::MD5
1.9 andrew 460:
1.14 andrew 461: Crypt::DES
1.4 andrew 462:
1.14 andrew 463: Readonly
1.10 andrew 464:
1.14 andrew 465: =head1 BUGS AND LIMITATIONS
1.1 andrew 466:
1.14 andrew 467: Once this module is uploaded, you can
468: Please report any bugs or feature requests to
469: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
470: L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
471: notified of progress on your bug as I make changes.
1.1 andrew 472:
473: =head1 AUTHOR
474:
1.12 andrew 475: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1 andrew 476:
1.14 andrew 477: =head1 LICENSE AND COPYRIGHT
478:
479: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
480:
1.15 ! andrew 481: This program is free software; you can redistribute it and/or
! 482: modify it under the same terms as Perl itself.
1.14 andrew 483:
1.1 andrew 484: =head1 SEE ALSO
485:
486: Palm::PDB(3)
487:
488: Palm::StdAppInfo(3)
1.11 andrew 489:
490: The Keyring for Palm OS website:
491: 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