Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.10
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.10 ! andrew 11: # $Id: Keyring.pm,v 1.9 2006/11/10 17:49:51 andrew Exp $
! 12: # $RedRiver: Keyring.pm,v 1.9 2006/11/10 17:49:51 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.10 ! andrew 30: $VERSION = do { my @r = (q$Revision: 1.9 $ =~ /\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.10 ! andrew 89: $self->{records} = [ $self->new_Record ];
1.1 andrew 90:
91: if ($pass) {
92: $self->Encrypt($pass);
93: }
94:
95: return $self;
96: }
97:
98: sub import
99: {
100: &Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
101: [ "Gtkr", "Gkyr" ],
102: );
1.3 andrew 103: }
104:
105: sub Load
106: {
107: my $self = shift;
1.10 ! andrew 108: $self->{'appinfo'} = {};
! 109: $self->{'records'} = [];
1.3 andrew 110: $self->SUPER::Load(@_);
111:
112: foreach my $record (@{ $self->{records} }) {
1.7 andrew 113: next unless exists $record->{data};
1.3 andrew 114: my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7 andrew 115: next unless $encrypted;
1.3 andrew 116: $record->{plaintext}->{name} = $name;
117: $record->{encrypted} = $encrypted;
118: }
119: 1;
1.6 andrew 120: }
121:
122: sub Write
123: {
124: my $self = shift;
125: $self->Encrypt() || return undef;
1.10 ! andrew 126: return $self->SUPER::Write(@_);
1.1 andrew 127: }
128:
129: sub Encrypt
130: {
131: my $self = shift;
132: my $pass = shift;
133:
1.7 andrew 134:
1.1 andrew 135: if ($pass) {
136: unless ($self->_keyring_verify($pass) ) {
137: # This would encrypt with a new password.
138: # First decrypting everything with the old password of course.
139: $self->_keyring_update($pass) || return undef;
140: $self->_keyring_verify($pass) || return undef;
141: }
142: }
143:
1.7 andrew 144: $self->{digest} ||= _calc_keys($self->{password});
145:
1.1 andrew 146: foreach my $record (@{ $self->{records} }) {
147: next unless defined $record->{plaintext};
148:
1.7 andrew 149: my $name = defined $record->{plaintext}->{name} ?
150: $record->{plaintext}->{name} : '';
151: my $account = defined $record->{plaintext}->{account} ?
152: $record->{plaintext}->{account} : '';
153: my $password = defined $record->{plaintext}->{password} ?
154: $record->{plaintext}->{password} : '';
155: my $description = defined $record->{plaintext}->{description} ?
156: $record->{plaintext}->{description} : '';
1.1 andrew 157: my $extra = '';
158:
1.2 andrew 159: my $plaintext = join("\000", $account, $password, $description, $extra);
1.1 andrew 160:
1.7 andrew 161: my $encrypted = _crypt3des($plaintext, $self->{digest}, ENCRYPT);
1.1 andrew 162:
1.2 andrew 163: $record->{data} = join("\000", $name, $encrypted);
1.1 andrew 164: }
165:
166: return 1;
167: }
168:
169: sub Decrypt
170: {
171: my $self = shift;
172: my $pass = shift;
173:
174: if ($pass) {
175: $self->_keyring_verify($pass) || return undef;
176: }
177:
1.7 andrew 178: $self->{digest} ||= _calc_keys($self->{password});
179:
1.1 andrew 180: foreach my $record (@{ $self->{records} }) {
181: next unless defined $record->{data};
182:
1.2 andrew 183: my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7 andrew 184: next unless $encrypted;
185:
1.1 andrew 186: $record->{plaintext}->{name} = $name;
187:
1.7 andrew 188: my $decrypted = _crypt3des($encrypted, $self->{digest}, DECRYPT);
1.1 andrew 189: my ($account, $password, $description, $extra)
1.2 andrew 190: = split /\000/, $decrypted, 4;
1.1 andrew 191:
1.7 andrew 192: $record->{plaintext}->{account} = defined $account ?
193: $account : '';
194: $record->{plaintext}->{password} = defined $password ?
195: $password : '';
196: $record->{plaintext}->{description} = defined $description ?
197: $description : '';
198:
199: #print "Name: '$name'\n";
200: #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
201: #print " Hex: '" . unpack("H*", $encrypted) . "'\n";
202: #print " Binary:'" . unpack("b*", $encrypted) . "'\n";
203: #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
204: #print " Hex: '" . unpack("H*", $decrypted) . "'\n";
205: #print " Binary:'" . unpack("b*", $decrypted) . "'\n";
206: #print "\n";
1.1 andrew 207: #print "Extra: $extra\n";
1.7 andrew 208: #exit;
1.1 andrew 209: #--------------------------------------------------
210: # print "Account: $account\n";
211: # print "Password: $password\n";
212: # print "Description: $description\n";
213: #--------------------------------------------------
214:
215: }
216:
217: return 1;
218: }
219:
220: sub _calc_keys
221: {
1.7 andrew 222: my $pass = shift;
1.1 andrew 223: die "No password defined!" unless defined $pass;
224:
225: my $digest = md5($pass);
226:
227: my ($key1, $key2) = unpack('a8a8', $digest);
228: #--------------------------------------------------
229: # print "key1: $key1: ", length $key1, "\n";
230: # print "key2: $key2: ", length $key2, "\n";
231: #--------------------------------------------------
232:
233: $digest = unpack('H*', $key1 . $key2 . $key1);
234: #--------------------------------------------------
235: # print "Digest: ", $digest, "\n";
236: # print length $digest, "\n";
237: #--------------------------------------------------
238:
239: return $digest;
240: }
241:
242: sub _keyring_verify
243: {
244: my $self = shift;
245: my $pass = shift;
246:
1.4 andrew 247: die "No password specified!" unless $pass;
1.1 andrew 248: $self->{password} = $pass;
249:
250: # AFAIK the thing we use to test the password is
251: # always in the first entry
1.10 ! andrew 252: my $data = $self->{records}->[0]->{data};
1.1 andrew 253: #die "No encrypted password in file!" unless defined $data;
254: return undef unless defined $data;
255:
256: $data =~ s/\0$//;
257:
258: my $salt = substr($data, 0, $kSaltSize);
259:
260: my $msg = $salt . $pass;
261:
262: $msg .= "\0" x (MD5_CBLOCK - length($msg));
263:
264: my $digest = md5($msg);
265:
266: if ($data eq $salt . $digest) {
267: # May as well generate the keys we need now, since we know the password is right
1.7 andrew 268: $self->{digest} = _calc_keys($self->{password});
269: if ($self->{digest}) {
1.1 andrew 270: return 1;
271: } else {
272: return undef;
273: }
274: } else {
275: return undef;
276: }
277: }
278:
279: sub _keyring_update
280: {
281: # It is very important to Encrypt after calling this
282: # (Although it is generally only called by Encrypt)
283: # because otherwise the data will be out of sync with the
284: # password, and that would suck!
285: my $self = shift;
286: my $pass = shift;
287:
1.4 andrew 288: die "No password specified!" unless $pass;
1.1 andrew 289:
290: # if the database already has a password in it
1.10 ! andrew 291: if ($self->{records}->[0]->{data}) {
1.1 andrew 292: # Make sure everything is decrypted before we update the keyring
293: $self->Decrypt() || return undef;
294: }
295:
296: my $salt;
297: for (1..$kSaltSize) {
298: $salt .= chr(int(rand(255)));
299: }
300:
301: my $msg = $salt . $pass;
302:
303: $msg .= "\0" x (MD5_CBLOCK - length($msg));
304:
305: my $digest = md5($msg);
306:
307: my $data = $salt . $digest;# . "\0";
308:
309: # AFAIK the thing we use to test the password is
310: # always in the first entry
1.10 ! andrew 311: $self->{records}->[0]->{data} = $data;
1.1 andrew 312:
313: $self->{password} = $pass;
1.7 andrew 314: $self->{digest} = _calc_keys($self->{password});
1.1 andrew 315:
316: return 1;
317: }
318:
1.2 andrew 319:
1.8 andrew 320: # XXX It looks like they are using des_ecb2_encrypt so I dunno if that is different
1.2 andrew 321: sub _crypt3des {
1.7 andrew 322: my ( $plaintext, $passphrase, $flag ) = @_;
1.10 ! andrew 323: my $NULL = chr(0);
1.2 andrew 324:
1.4 andrew 325: $passphrase .= ' ' x (16*3);
326: my $cyphertext = "";
1.2 andrew 327:
1.4 andrew 328: my $size = length ( $plaintext );
329: #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
1.2 andrew 330:
1.5 andrew 331: my @C;
1.4 andrew 332: for ( 0..2 ) {
1.5 andrew 333: $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
1.4 andrew 334: }
1.9 andrew 335:
336:
337: # XXX From Crypt::TripleDES
338: # http://search.cpan.org/src/VIPUL/Crypt-TripleDES-0.24/lib/Crypt/TripleDES.pm
339: #
340: # for ( 0 .. (($size)/8) -1 ) {
341: # my $pt = substr( $plaintext, $_*8, 8 );
342: # $pt = Crypt::PPDES::des_ecb_encrypt( $flag ? $keyvecs{0} : $keyvecs{2}, $flag, $pt );
343: # $pt = Crypt::PPDES::des_ecb_encrypt( $keyvecs{1}, (not $flag), $pt );
344: # $pt = Crypt::PPDES::des_ecb_encrypt( $flag ? $keyvecs{2} : $keyvecs{0}, $flag, $pt );
345: # $cyphertext .= $pt;
346: # }
1.4 andrew 347:
1.10 ! andrew 348: for ( 0 .. (($size)/8)) {
1.4 andrew 349: my $pt = substr( $plaintext, $_*8, 8 );
350: #print "PT: '$pt' - Length: " . length($pt) . "\n";
1.10 ! andrew 351: next unless length($pt);
1.4 andrew 352: if (length($pt) < 8) {
1.8 andrew 353: die "record not 8 byte padded" if $flag == DECRYPT;
1.4 andrew 354: my $len = 8 - length($pt);
1.8 andrew 355: #print "LENGTH: $len\n";
356: #print "Binary: '" . unpack("b*", $pt) . "'\n";
1.10 ! andrew 357: $pt .= ($NULL x $len);
! 358: #print "PT: '$pt' - Length: " . length($pt) . "\n";
1.8 andrew 359: #print "Binary: '" . unpack("b*", $pt) . "'\n";
1.4 andrew 360: }
1.10 ! andrew 361: if ($flag == ENCRYPT) {
! 362: $pt = $C[0]->encrypt( $pt );
! 363: $pt = $C[1]->decrypt( $pt );
! 364: $pt = $C[2]->encrypt( $pt );
! 365: } else {
! 366: $pt = $C[0]->decrypt( $pt );
! 367: $pt = $C[1]->encrypt( $pt );
! 368: $pt = $C[2]->decrypt( $pt );
! 369: }
1.4 andrew 370: #print "PT: '$pt' - Length: " . length($pt) . "\n";
371: $cyphertext .= $pt;
372: }
373:
1.10 ! andrew 374: $cyphertext =~ s/$NULL+$//;
! 375: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
! 376:
! 377: return $cyphertext;
1.2 andrew 378: }
1.1 andrew 379:
380: 1;
381: __END__
382:
383: =head1 AUTHOR
384:
385: Andrew Fresh E<lt>andrew@mad-techies.org<gt>
386:
387: =head1 SEE ALSO
388:
389: Palm::PDB(3)
390:
391: Palm::StdAppInfo(3)
392:
393: =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