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