Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.7
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.7 ! andrew 11: # $Id: Keyring.pm,v 1.6 2006/11/10 16:18:59 andrew Exp $
! 12: # $RedRiver: Keyring.pm,v 1.6 2006/11/10 16:18:59 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.7 ! andrew 30: $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\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:
40: use Palm::Keyring;
41: $pdb->Decrypt('mypassword');
42:
43: =head1 DESCRIPTION
44:
45: The Keyring PDB handler is a helper class for the Palm::PDB package. It
46: parses Keyring databases. See
47: L<http://gnukeyring.sourceforge.net/>.
48:
49: It is just the standard Palm::Raw with 2 additional public methods. Decrypt and Encrypt.
50:
51: =cut
52: =head2 new
53:
54: $pdb = new Palm::Keyring ('password');
55:
56: Create a new PDB, initialized with the various Palm::Keyring fields
57: and an empty record list.
58:
59: Use this method if you're creating a Keyring PDB from scratch.
60:
61: =cut
62: #'
63: sub new
64: {
65: my $classname = shift;
66: my $pass = shift;
67:
1.5 andrew 68: # Create a generic PDB. No need to rebless it, though.
1.1 andrew 69: my $self = $classname->SUPER::new(@_);
70:
71: $self->{name} = "Keys-Gtkr"; # Default
72: $self->{creator} = "Gtkr";
73: $self->{type} = "Gkyr";
1.5 andrew 74: # The PDB is not a resource database by
75: # default, but it's worth emphasizing,
76: # since MemoDB is explicitly not a PRC.
1.1 andrew 77: $self->{attributes}{resource} = 0;
78:
79: # Initialize the AppInfo block
80: $self->{appinfo} = {};
81:
82: # Add the standard AppInfo block stuff
83: &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo});
84:
85: # Set the version
86: $self->{version} = 4;
87:
88: # Give the PDB the first record that will hold the encrypted password
1.5 andrew 89: $self->{records} = [ {
90: 'category' => 0,
91: 'attributes' => {
92: 'private' => 1,
93: 'Secret' => 1,
94: 'Dirty' => 1,
1.7 ! andrew 95: 'dirty' => 1,
1.1 andrew 96: },
1.5 andrew 97: }, ];
1.1 andrew 98:
99: if ($pass) {
100: $self->Encrypt($pass);
101: }
102:
103: return $self;
104: }
105:
106: sub import
107: {
108: &Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
109: [ "Gtkr", "Gkyr" ],
110: );
1.3 andrew 111: }
112:
113: sub Load
114: {
115: my $self = shift;
116: $self->SUPER::Load(@_);
117:
118: foreach my $record (@{ $self->{records} }) {
1.7 ! andrew 119: next unless exists $record->{data};
1.3 andrew 120: my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7 ! andrew 121: next unless $encrypted;
1.3 andrew 122: $record->{plaintext}->{name} = $name;
123: $record->{encrypted} = $encrypted;
124: }
125: 1;
1.6 andrew 126: }
127:
128: sub Write
129: {
130: my $self = shift;
131: $self->Encrypt() || return undef;
132: return $self->SUPER::Load(@_);
1.1 andrew 133: }
134:
135: sub Encrypt
136: {
137: my $self = shift;
138: my $pass = shift;
139:
1.7 ! andrew 140:
1.1 andrew 141: if ($pass) {
142: unless ($self->_keyring_verify($pass) ) {
143: # This would encrypt with a new password.
144: # First decrypting everything with the old password of course.
145: $self->_keyring_update($pass) || return undef;
146: $self->_keyring_verify($pass) || return undef;
147: }
148: }
149:
1.7 ! andrew 150: $self->{digest} ||= _calc_keys($self->{password});
! 151:
1.1 andrew 152: foreach my $record (@{ $self->{records} }) {
153: next unless defined $record->{plaintext};
154:
1.7 ! andrew 155: my $name = defined $record->{plaintext}->{name} ?
! 156: $record->{plaintext}->{name} : '';
! 157: my $account = defined $record->{plaintext}->{account} ?
! 158: $record->{plaintext}->{account} : '';
! 159: my $password = defined $record->{plaintext}->{password} ?
! 160: $record->{plaintext}->{password} : '';
! 161: my $description = defined $record->{plaintext}->{description} ?
! 162: $record->{plaintext}->{description} : '';
1.1 andrew 163: my $extra = '';
164:
1.2 andrew 165: my $plaintext = join("\000", $account, $password, $description, $extra);
1.1 andrew 166:
1.7 ! andrew 167: my $encrypted = _crypt3des($plaintext, $self->{digest}, ENCRYPT);
1.1 andrew 168:
1.2 andrew 169: $record->{data} = join("\000", $name, $encrypted);
1.1 andrew 170: }
171:
172: return 1;
173: }
174:
175: sub Decrypt
176: {
177: my $self = shift;
178: my $pass = shift;
179:
180: if ($pass) {
181: $self->_keyring_verify($pass) || return undef;
182: }
183:
1.7 ! andrew 184: $self->{digest} ||= _calc_keys($self->{password});
! 185:
1.1 andrew 186: foreach my $record (@{ $self->{records} }) {
187: next unless defined $record->{data};
188:
1.2 andrew 189: my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7 ! andrew 190: next unless $encrypted;
! 191:
1.1 andrew 192: $record->{plaintext}->{name} = $name;
193:
1.7 ! andrew 194: my $decrypted = _crypt3des($encrypted, $self->{digest}, DECRYPT);
1.1 andrew 195: my ($account, $password, $description, $extra)
1.2 andrew 196: = split /\000/, $decrypted, 4;
1.1 andrew 197:
1.7 ! andrew 198: $record->{plaintext}->{account} = defined $account ?
! 199: $account : '';
! 200: $record->{plaintext}->{password} = defined $password ?
! 201: $password : '';
! 202: $record->{plaintext}->{description} = defined $description ?
! 203: $description : '';
! 204:
! 205: #print "Name: '$name'\n";
! 206: #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
! 207: #print " Hex: '" . unpack("H*", $encrypted) . "'\n";
! 208: #print " Binary:'" . unpack("b*", $encrypted) . "'\n";
! 209: #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
! 210: #print " Hex: '" . unpack("H*", $decrypted) . "'\n";
! 211: #print " Binary:'" . unpack("b*", $decrypted) . "'\n";
! 212: #print "\n";
1.1 andrew 213: #print "Extra: $extra\n";
1.7 ! andrew 214: #exit;
1.1 andrew 215: #--------------------------------------------------
216: # print "Account: $account\n";
217: # print "Password: $password\n";
218: # print "Description: $description\n";
219: #--------------------------------------------------
220:
221: }
222:
223: return 1;
224: }
225:
226: sub _calc_keys
227: {
1.7 ! andrew 228: my $pass = shift;
1.1 andrew 229: die "No password defined!" unless defined $pass;
230:
231: my $digest = md5($pass);
232:
233: my ($key1, $key2) = unpack('a8a8', $digest);
234: #--------------------------------------------------
235: # print "key1: $key1: ", length $key1, "\n";
236: # print "key2: $key2: ", length $key2, "\n";
237: #--------------------------------------------------
238:
239: $digest = unpack('H*', $key1 . $key2 . $key1);
240: #--------------------------------------------------
241: # print "Digest: ", $digest, "\n";
242: # print length $digest, "\n";
243: #--------------------------------------------------
244:
245: return $digest;
246: }
247:
248: sub _keyring_verify
249: {
250: my $self = shift;
251: my $pass = shift;
252:
1.4 andrew 253: die "No password specified!" unless $pass;
1.1 andrew 254: $self->{password} = $pass;
255:
256: # AFAIK the thing we use to test the password is
257: # always in the first entry
1.7 ! andrew 258: my $data = $self->{records}->[1]->{data};
1.1 andrew 259: #die "No encrypted password in file!" unless defined $data;
260: return undef unless defined $data;
261:
262: $data =~ s/\0$//;
263:
264: my $salt = substr($data, 0, $kSaltSize);
265:
266: my $msg = $salt . $pass;
267:
268: $msg .= "\0" x (MD5_CBLOCK - length($msg));
269:
270: my $digest = md5($msg);
271:
272: if ($data eq $salt . $digest) {
273: # May as well generate the keys we need now, since we know the password is right
1.7 ! andrew 274: $self->{digest} = _calc_keys($self->{password});
! 275: if ($self->{digest}) {
1.1 andrew 276: return 1;
277: } else {
278: return undef;
279: }
280: } else {
281: return undef;
282: }
283: }
284:
285: sub _keyring_update
286: {
287: # It is very important to Encrypt after calling this
288: # (Although it is generally only called by Encrypt)
289: # because otherwise the data will be out of sync with the
290: # password, and that would suck!
291: my $self = shift;
292: my $pass = shift;
293:
1.4 andrew 294: die "No password specified!" unless $pass;
1.1 andrew 295:
296: # if the database already has a password in it
1.7 ! andrew 297: if ($self->{records}->[1]->{data}) {
1.1 andrew 298: # Make sure everything is decrypted before we update the keyring
299: $self->Decrypt() || return undef;
300: }
301:
302: my $salt;
303: for (1..$kSaltSize) {
304: $salt .= chr(int(rand(255)));
305: }
306:
307: my $msg = $salt . $pass;
308:
309: $msg .= "\0" x (MD5_CBLOCK - length($msg));
310:
311: my $digest = md5($msg);
312:
313: my $data = $salt . $digest;# . "\0";
314:
315: # AFAIK the thing we use to test the password is
316: # always in the first entry
1.7 ! andrew 317: $self->{records}->[1]->{data} = $data;
1.1 andrew 318:
319: $self->{password} = $pass;
1.7 ! andrew 320: $self->{digest} = _calc_keys($self->{password});
1.1 andrew 321:
322: return 1;
323: }
324:
1.2 andrew 325:
326: # XXX Have to make this encrypt as well as decrypting, but w00 h00!
327: # do null padding on the end of a cleartext if we are going to encrypt it
328: sub _crypt3des {
1.7 ! andrew 329: my ( $plaintext, $passphrase, $flag ) = @_;
1.2 andrew 330:
1.4 andrew 331: $passphrase .= ' ' x (16*3);
332: my $cyphertext = "";
1.2 andrew 333:
334:
1.4 andrew 335: my $size = length ( $plaintext );
336: #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
1.2 andrew 337:
1.4 andrew 338: # This check should see if it is plaintext first, if it is,
339: # pad it with \000
340: # if not, then die
341: die "record not 8 byte padded" if (length($plaintext) % 8) && ! $flag;
1.2 andrew 342:
1.5 andrew 343: my @C;
1.4 andrew 344: for ( 0..2 ) {
1.5 andrew 345: $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
1.4 andrew 346: }
347:
348: for ( 0 .. (($size)/8) - 1) {
349: my $pt = substr( $plaintext, $_*8, 8 );
350: #print "PT: '$pt' - Length: " . length($pt) . "\n";
351: if (length($pt) < 8) {
352: my $len = 8 - length($pt);
353: print "LENGTH: $len\n";
354: print "Binary: '" . unpack("b*", $pt) . "'\n";
355: $pt .= (chr(0) x $len);# . $pt;
356: print "Binary: '" . unpack("b*", $pt) . "'\n";
357: #print "PT: '$pt' - Length: " . length($pt) . "\n";
358: }
1.5 andrew 359: $pt = $C[0]->decrypt( $pt );
360: $pt = $C[1]->encrypt( $pt );
361: $pt = $C[2]->decrypt( $pt );
1.4 andrew 362: #print "PT: '$pt' - Length: " . length($pt) . "\n";
363: $cyphertext .= $pt;
364: }
365:
366: return substr ( $cyphertext, 0, $size );
1.2 andrew 367: }
1.1 andrew 368:
369: 1;
370: __END__
371:
372: =head1 AUTHOR
373:
374: Andrew Fresh E<lt>andrew@mad-techies.org<gt>
375:
376: =head1 SEE ALSO
377:
378: Palm::PDB(3)
379:
380: Palm::StdAppInfo(3)
381:
382: =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