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