Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.12
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.12 ! andrew 11: # $RedRiver: Keyring.pm,v 1.11 2007/01/27 23:59:29 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.12 ! andrew 29: $VERSION = do { my @r = (q$Revision: 1.11 $ =~ /\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.1 andrew 263: foreach my $record (@{ $self->{records} }) {
264: next unless defined $record->{data};
265:
1.2 andrew 266: my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7 andrew 267: next unless $encrypted;
268:
1.1 andrew 269: $record->{plaintext}->{name} = $name;
270:
1.7 andrew 271: my $decrypted = _crypt3des($encrypted, $self->{digest}, DECRYPT);
1.1 andrew 272: my ($account, $password, $description, $extra)
1.2 andrew 273: = split /\000/, $decrypted, 4;
1.1 andrew 274:
1.7 andrew 275: $record->{plaintext}->{account} = defined $account ?
276: $account : '';
277: $record->{plaintext}->{password} = defined $password ?
278: $password : '';
279: $record->{plaintext}->{description} = defined $description ?
280: $description : '';
281:
282: #print "Name: '$name'\n";
283: #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
284: #print " Hex: '" . unpack("H*", $encrypted) . "'\n";
285: #print " Binary:'" . unpack("b*", $encrypted) . "'\n";
286: #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
287: #print " Hex: '" . unpack("H*", $decrypted) . "'\n";
288: #print " Binary:'" . unpack("b*", $decrypted) . "'\n";
289: #print "\n";
1.1 andrew 290: #print "Extra: $extra\n";
1.7 andrew 291: #exit;
1.1 andrew 292: #--------------------------------------------------
293: # print "Account: $account\n";
294: # print "Password: $password\n";
295: # print "Description: $description\n";
296: #--------------------------------------------------
297:
298: }
299:
1.11 andrew 300: 1;
1.1 andrew 301: }
302:
303: sub _calc_keys
304: {
1.7 andrew 305: my $pass = shift;
1.1 andrew 306: die "No password defined!" unless defined $pass;
307:
308: my $digest = md5($pass);
309:
310: my ($key1, $key2) = unpack('a8a8', $digest);
311: #--------------------------------------------------
312: # print "key1: $key1: ", length $key1, "\n";
313: # print "key2: $key2: ", length $key2, "\n";
314: #--------------------------------------------------
315:
316: $digest = unpack('H*', $key1 . $key2 . $key1);
317: #--------------------------------------------------
318: # print "Digest: ", $digest, "\n";
319: # print length $digest, "\n";
320: #--------------------------------------------------
321:
322: return $digest;
323: }
324:
325: sub _keyring_verify
326: {
327: my $self = shift;
328: my $pass = shift;
329:
1.4 andrew 330: die "No password specified!" unless $pass;
1.1 andrew 331:
332: # AFAIK the thing we use to test the password is
333: # always in the first entry
1.10 andrew 334: my $data = $self->{records}->[0]->{data};
1.1 andrew 335: #die "No encrypted password in file!" unless defined $data;
336: return undef unless defined $data;
337:
338: $data =~ s/\0$//;
339:
340: my $salt = substr($data, 0, $kSaltSize);
341:
342: my $msg = $salt . $pass;
343:
344: $msg .= "\0" x (MD5_CBLOCK - length($msg));
345:
346: my $digest = md5($msg);
347:
348: if ($data eq $salt . $digest) {
349: # May as well generate the keys we need now, since we know the password is right
1.11 andrew 350: $self->{digest} = _calc_keys($pass);
1.7 andrew 351: if ($self->{digest}) {
1.11 andrew 352: $self->{password} = $pass;
1.1 andrew 353: return 1;
354: } else {
355: return undef;
356: }
357: } else {
358: return undef;
359: }
360: }
361:
362: sub _keyring_update
363: {
364: # It is very important to Encrypt after calling this
365: # (Although it is generally only called by Encrypt)
366: # because otherwise the data will be out of sync with the
367: # password, and that would suck!
368: my $self = shift;
369: my $pass = shift;
370:
1.4 andrew 371: die "No password specified!" unless $pass;
1.1 andrew 372:
373: # if the database already has a password in it
1.10 andrew 374: if ($self->{records}->[0]->{data}) {
1.1 andrew 375: # Make sure everything is decrypted before we update the keyring
376: $self->Decrypt() || return undef;
377: }
378:
379: my $salt;
380: for (1..$kSaltSize) {
381: $salt .= chr(int(rand(255)));
382: }
383:
384: my $msg = $salt . $pass;
385:
386: $msg .= "\0" x (MD5_CBLOCK - length($msg));
387:
388: my $digest = md5($msg);
389:
390: my $data = $salt . $digest;# . "\0";
391:
392: # AFAIK the thing we use to test the password is
393: # always in the first entry
1.10 andrew 394: $self->{records}->[0]->{data} = $data;
1.1 andrew 395:
396: $self->{password} = $pass;
1.7 andrew 397: $self->{digest} = _calc_keys($self->{password});
1.1 andrew 398:
399: return 1;
400: }
401:
1.2 andrew 402: sub _crypt3des {
1.7 andrew 403: my ( $plaintext, $passphrase, $flag ) = @_;
1.10 andrew 404: my $NULL = chr(0);
1.2 andrew 405:
1.4 andrew 406: $passphrase .= ' ' x (16*3);
407: my $cyphertext = "";
1.2 andrew 408:
1.4 andrew 409: my $size = length ( $plaintext );
410: #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
1.2 andrew 411:
1.5 andrew 412: my @C;
1.4 andrew 413: for ( 0..2 ) {
1.5 andrew 414: $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
1.4 andrew 415: }
1.9 andrew 416:
1.10 andrew 417: for ( 0 .. (($size)/8)) {
1.4 andrew 418: my $pt = substr( $plaintext, $_*8, 8 );
419: #print "PT: '$pt' - Length: " . length($pt) . "\n";
1.10 andrew 420: next unless length($pt);
1.4 andrew 421: if (length($pt) < 8) {
1.8 andrew 422: die "record not 8 byte padded" if $flag == DECRYPT;
1.4 andrew 423: my $len = 8 - length($pt);
1.8 andrew 424: #print "LENGTH: $len\n";
425: #print "Binary: '" . unpack("b*", $pt) . "'\n";
1.10 andrew 426: $pt .= ($NULL x $len);
427: #print "PT: '$pt' - Length: " . length($pt) . "\n";
1.8 andrew 428: #print "Binary: '" . unpack("b*", $pt) . "'\n";
1.4 andrew 429: }
1.10 andrew 430: if ($flag == ENCRYPT) {
431: $pt = $C[0]->encrypt( $pt );
432: $pt = $C[1]->decrypt( $pt );
433: $pt = $C[2]->encrypt( $pt );
434: } else {
435: $pt = $C[0]->decrypt( $pt );
436: $pt = $C[1]->encrypt( $pt );
437: $pt = $C[2]->decrypt( $pt );
438: }
1.4 andrew 439: #print "PT: '$pt' - Length: " . length($pt) . "\n";
440: $cyphertext .= $pt;
441: }
442:
1.10 andrew 443: $cyphertext =~ s/$NULL+$//;
444: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
445:
446: return $cyphertext;
1.2 andrew 447: }
1.1 andrew 448:
449: 1;
450: __END__
451:
452: =head1 AUTHOR
453:
1.12 ! andrew 454: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1 andrew 455:
456: =head1 SEE ALSO
457:
458: Palm::PDB(3)
459:
460: Palm::StdAppInfo(3)
1.11 andrew 461:
462: The Keyring for Palm OS website:
463: L<http://gnukeyring.sourceforge.net/>
1.1 andrew 464:
465: =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