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