Annotation of palm/Palm-Keyring/t/keyring.t, Revision 1.24
1.12 andrew 1: #!/usr/bin/perl -T
1.24 ! andrew 2: # $RedRiver: keyring.t,v 1.23 2008/09/19 05:39:58 andrew Exp $
1.7 andrew 3: use strict;
4: use warnings;
1.1 andrew 5:
1.23 andrew 6: use Test::More tests => 202;
1.15 andrew 7: use Data::Dumper;
1.1 andrew 8:
1.18 andrew 9: BEGIN {
10: use_ok('Palm::PDB');
11: use_ok('Palm::Keyring');
1.9 andrew 12: }
1.1 andrew 13:
1.18 andrew 14: my $file = 'Keys-test.pdb';
15: my $password = '12345';
1.3 andrew 16: my $new_password = '54321';
17:
1.8 andrew 18: my @o = (
1.18 andrew 19: { version => 4,
1.8 andrew 20: password => $password,
21: },
1.18 andrew 22: { version => 5,
23: password => $password,
24: cipher => 1,
1.8 andrew 25: },
26: );
27:
1.19 andrew 28: my $acct = {
29: 0 => {
30: label => 'name',
31: label_id => 0,
32: data => 'test3',
33: font => 0,
34: },
35: 1 => {
36: label => 'account',
37: label_id => 1,
38: data => 'atestaccount',
39: font => 0,
40: },
41: 2 => {
42: label => 'password',
43: label_id => 2,
44: data => $password,
45: font => 0,
46: },
47: 3 => {
48: label => 'lastchange',
49: label_id => 3,
50: data => {
51: day => 2,
52: month => 2,
53: year => 99,
1.14 andrew 54: },
1.19 andrew 55: font => 0,
56: },
57: 255 => {
58: label => 'notes',
59: label_id => 255,
60: data => 'now that really roxorZ!',
61: font => 0,
62: },
63: };
1.9 andrew 64:
1.23 andrew 65: my %unchanging_date = %{ $acct->{3}->{data} };
66:
1.20 andrew 67: my $bad_cipher = 999;
68: my %crypt_1_details = (
69: 'default_iter' => 1000,
70: 'keylen' => 24,
71: 'blocksize' => 8,
72: 'name' => 'DES_EDE3',
73: 'alias' => 'DES-EDE3',
74: 'DES_odd_parity' => 1
75: );
76:
77: my $bad_label = 999;
78: my $bad_label_name = 'not_a_label_name';
79: my %label_1_details = (
80: id => 1,
81: name => 'account',
82: );
83: my %label_not_found_details = (
84: id => $bad_label,
85: name => undef,
86: );
87:
88: # Crypts
89: is_deeply( Palm::Keyring::crypts(1), \%crypt_1_details, 'Got crypt 1' );
90: is_deeply( Palm::Keyring::crypts('DES-EDE3'),
91: \%crypt_1_details, 'Got crypt DES-EDE3' );
92: is( Palm::Keyring::crypts(), undef, "Didn't get crypt empty cipher" );
93: is( Palm::Keyring::crypts($bad_cipher),
94: undef, "Didn't get crypt $bad_cipher" );
95:
96: # Bad Cipher
97: eval { Palm::Keyring->new( { version => 5, cipher => $bad_cipher } ) };
98: like(
99: $@,
100: qr/^Unknown \s cipher \s $bad_cipher/xms,
101: "Failed to create keyring with cipher $bad_cipher"
102: );
103:
104: # Labels
105: is_deeply( Palm::Keyring::labels(1), \%label_1_details, 'Got label 1' );
106: is_deeply( Palm::Keyring::labels('account'),
107: \%label_1_details, 'Got label account' );
108: is( Palm::Keyring::labels(), undef, "Didn't get label empty label" );
109: is_deeply( Palm::Keyring::labels($bad_label),
110: \%label_not_found_details, "Got default label for $bad_label" );
1.21 andrew 111: is( Palm::Keyring::labels($bad_label_name), undef, "Didn't get label for $bad_label_name"
1.20 andrew 112: );
113:
1.21 andrew 114:
1.20 andrew 115: my $pdb;
1.21 andrew 116:
1.20 andrew 117: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_version.pdb' ) };
118: like(
119: $@,
120: qr/^Unsupported \s Version \s 999/xms,
121: 'Couldn\'t load pdb with invalid version'
122: );
123:
124: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_cipher.pdb' ) };
125: like(
126: $@,
127: qr/^Unknown \s cipher \s 999/xms,
128: 'Couldn\'t load pdb with Unknown Cipher'
129: );
130:
1.23 andrew 131: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_appinfo.pdb' ) };
132: like(
133: $@,
134: qr/^Corrupt \s appinfo\? \s no \s {other}/xms,
135: 'Couldn\'t load pdb with invalid appinfo'
136: );
137:
138: ok( $pdb = new Palm::Keyring( -file => 't/Keys-no_data.pdb', -password =>
139: $new_password ),
140: 'Loaded Palm::Keyring file with no data' );
1.20 andrew 141: ok( $pdb = new Palm::Keyring( -file => 't/Keys-no_data.pdb' ),
142: 'Loaded Palm::Keyring file with no data' );
143:
144: my $record;
145: ok( $record = $pdb->append_Record(), 'Append Record' );
1.23 andrew 146: eval{ $pdb->Encrypt() };
147: like(
148: $@,
149: qr/^Needed \s parameter \s \[record\] \s not \s passed!/xms,
150: 'Encrypt account into record without record'
151: );
152: eval{ $pdb->Encrypt( $record ) };
153: like(
154: $@,
155: qr/^password \s not \s set!/xms,
156: 'Encrypt account into record without password'
157: );
158: eval{ $pdb->Encrypt( $record, $password ) };
159: like(
160: $@,
161: qr/^Needed \s parameter \s \[plaintext\] \s not \s passed!/xms,
162: 'Encrypt account into record without account'
163: );
164: eval{ $pdb->Encrypt( $record, $new_password, $acct ) };
165: like(
166: $@,
167: qr/^Incorrect \s Password!/xms,
168: 'Encrypt account into record with wrong password'
169: );
170:
171: my $ivec = pack("C*", 1..8);
172: ok( $pdb->Encrypt( $record, $password, $acct, $ivec),
173: 'Encrypt account into record (with custom ivec)' );
174: ok( $pdb->Encrypt( $record, $password, $acct),
175: 'Encrypt account into record (with no changes)');
176:
177: delete $record->{plaintext};
178:
1.21 andrew 179: ok( $pdb->PackRecord($record), 'Pack Proper Record');
180: ok( $record = $pdb->ParseRecord(%{ $record }), 'Parse Proper Packed');
181:
1.20 andrew 182: my $record2;
183: ok( $record2 = $pdb->append_Record(), 'Append Record' );
1.22 andrew 184: eval{ $pdb->PackRecord($record2) };
185: like(
186: $@,
187: qr/^No \s encrypted \s data \s in \s record/xms,
188: 'Pack Empty Record'
189: );
190:
191: $record2->{encrypted} = q{};
192: eval{ $pdb->PackRecord($record2) };
193: like(
194: $@,
195: qr/^No \s ivec/xms,
196: 'Pack Empty Record with encrypted, but no ivec'
197: );
198:
199: $pdb->{version} = 4;
200: delete $record->{encrypted};
201: delete $record->{data};
202: eval{ $pdb->PackRecord($record) };
203: like( $@,
204: qr/^No \s data \s in \s record \s to \s pack/xms,
205: 'Couldn\'t PackRecord without data'
206: );
1.20 andrew 207:
1.22 andrew 208: $pdb->{version} = 999;
1.24 ! andrew 209: delete $record->{encrypted};
! 210: eval{ $pdb->Encrypt( $record, undef, $acct ) };
1.23 andrew 211: like(
212: $@,
213: qr/^Unsupported \s version \s 999/xms,
214: 'Couldn\'t Encrypt with unsupported version'
215: );
216:
1.22 andrew 217: eval { $pdb->Write($file) };
218: like(
219: $@,
220: qr/^Unsupported \s Version \s 999/xms,
221: 'Couldn\'t Write file with unsupported version'
222: );
1.20 andrew 223:
224: eval{ $pdb->PackRecord($record) };
225: like( $@,
226: qr/^Unsupported \s Version \s 999/xms,
227: 'Couldn\'t PackRecord with Invalid Version'
228: );
229:
1.22 andrew 230: $record2->{data} = q{nothing};
1.20 andrew 231: eval{ $pdb->ParseRecord(%{ $record2 }) };
232: like( $@,
233: qr/^Unsupported \s Version \s 999/xms,
234: 'Couldn\'t ParseRecord with Invalid Version'
1.21 andrew 235: );
236:
237:
1.23 andrew 238: $pdb = undef;
239: $record = undef;
240: $record2 = undef;
241: %{ $acct->{3}->{data} } = %unchanging_date;
1.20 andrew 242:
243: unlink $file;
244:
1.18 andrew 245: foreach my $options (@o) {
1.20 andrew 246: foreach my $config_type ( 'hashref', 'cgi-style', 'list' ) {
247:
248: my $pdb;
249: my $record;
250: my $decrypted;
251:
252: my $Num_Tests_Left = 25;
253: SKIP: {
254: if ( defined $options->{cipher} && $options->{cipher} > 0 ) {
255: my $crypt = Palm::Keyring::crypts( $options->{cipher} );
256: skip 'Crypt::CBC not installed', $Num_Tests_Left
257: unless eval "require Crypt::CBC";
258: if ($crypt) {
259: skip 'Crypt::' . $crypt->{name} . ' not installed',
260: $Num_Tests_Left
261: unless eval "require Crypt::$crypt->{name}";
262: }
263: else {
264: skip 'Unknown Crypt: ' . $options->{cipher},
265: $Num_Tests_Left;
266: }
267: }
268:
269: if ( $options->{version} == 4 ) {
270: skip 'Crypt::DES not installed', $Num_Tests_Left
271: unless eval "require Crypt::DES ";
272: skip 'Digest::MD5 not installed', $Num_Tests_Left
273: unless eval "require Digest::MD5 ";
274: }
275: elsif ( $options->{version} == 5 ) {
276: skip 'Digest::HMAC_SHA1 not installed', $Num_Tests_Left
277: unless eval "require Digest::HMAC_SHA1 ";
278: }
279:
280: my @options = ($options);
281: if ( $config_type eq 'cgi-style' ) {
282: @options = (
283: '-version' => $options->{version},
284: '-password' => $options->{password},
285: );
286: if ( $options->{cipher} ) {
287: push @options, '-cipher', $options->{cipher};
288: }
289: }
290: elsif ( $config_type eq 'list' ) {
291: @options = ( $options->{password}, $options->{version} );
292: if ( $options->{cipher} ) {
293: push @options, $options->{cipher};
294: }
295: }
296:
297: ok( $pdb = new Palm::Keyring(@options),
298: 'new Palm::Keyring v' . $options->{version}
299: );
300:
301: ok( $pdb->Write($file), 'Write "empty" file' );
1.23 andrew 302: #exit if $pdb->{version} == 5;
1.7 andrew 303:
1.20 andrew 304: ok( $record = $pdb->append_Record(), 'Append Record' );
1.7 andrew 305:
1.20 andrew 306: ok( $pdb->Encrypt( $record, $password, $acct ),
307: 'Encrypt account into record' );
1.7 andrew 308:
1.20 andrew 309: ok( $pdb->Write($file), 'Write file' );
1.7 andrew 310:
1.20 andrew 311: $pdb = undef;
1.7 andrew 312:
1.20 andrew 313: ok( $pdb = new Palm::Keyring(), 'new Palm::Keyring' );
1.9 andrew 314:
1.20 andrew 315: ok( $pdb->Load($file), 'Load File' );
1.11 andrew 316:
1.20 andrew 317: ok( $pdb->Password($password), 'Verify Password' );
1.7 andrew 318:
1.20 andrew 319: my $rec_num = 0;
320: ok( $decrypted = $pdb->Decrypt( $pdb->{records}->[$rec_num] ),
321: 'Decrypt record' );
1.7 andrew 322:
1.20 andrew 323: is( $decrypted->{2}->{data}, $password, 'Got password' );
1.7 andrew 324:
1.20 andrew 325: is_deeply( $decrypted, $acct, 'Account Matches' );
1.7 andrew 326:
1.20 andrew 327: my $old_date = $decrypted->{3}->{data};
1.7 andrew 328:
1.20 andrew 329: ok( $pdb->Password( $password, $new_password ),
330: 'Change PDB Password' );
1.1 andrew 331:
1.20 andrew 332: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
333: 'Decrypt with new password' );
1.7 andrew 334:
1.20 andrew 335: my $new_date = $decrypted->{3}->{data};
1.7 andrew 336:
1.20 andrew 337: is_deeply( $old_date, $new_date, 'Date didn\'t change' );
1.7 andrew 338:
1.20 andrew 339: $decrypted->{2}->{data} = $new_password;
1.7 andrew 340:
1.20 andrew 341: $pdb->{records}->[$rec_num]->{plaintext} = $decrypted;
1.4 andrew 342:
1.20 andrew 343: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num] ),
344: 'Change record' );
1.4 andrew 345:
1.20 andrew 346: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
347: 'Decrypt new record' );
1.15 andrew 348:
1.20 andrew 349: $new_date = $decrypted->{3}->{data};
1.7 andrew 350:
1.20 andrew 351: my $od = join '/', map { $old_date->{$_} } sort keys %{$old_date};
352: my $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
1.7 andrew 353:
1.20 andrew 354: isnt( $od, $nd, 'Date changed' );
1.4 andrew 355:
1.20 andrew 356: is( $decrypted->{2}->{data}, $new_password, 'Got new password' );
1.7 andrew 357:
1.20 andrew 358: my $last_decrypted = $decrypted;
1.7 andrew 359:
1.20 andrew 360: $decrypted = {};
361: ok( $pdb->Password(), 'Forget password' );
1.7 andrew 362:
1.20 andrew 363: eval {
364: $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] );
365: };
366: ok( $@, 'Don\'t decrypt' );
1.15 andrew 367:
1.20 andrew 368: isnt( $decrypted->{password},
369: $new_password, 'Didn\'t get new password' );
1.7 andrew 370:
1.20 andrew 371: ok( $pdb->Unlock($new_password), 'Unlock' );
1.7 andrew 372:
1.20 andrew 373: my @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.4 andrew 374:
1.20 andrew 375: is_deeply( $plaintext[0], $last_decrypted, 'Account Matches' );
1.15 andrew 376:
1.20 andrew 377: ok( $pdb->Lock(), 'Lock' );
1.15 andrew 378:
1.20 andrew 379: my $cleared_decrypted = {};
380: $cleared_decrypted->{0} = $last_decrypted->{0};
381: @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.15 andrew 382:
1.20 andrew 383: is_deeply( $plaintext[0], $cleared_decrypted, 'Cleared records' );
1.15 andrew 384:
1.20 andrew 385: $pdb->{records}->[0]->{data} = undef;
1.21 andrew 386: ok( $pdb->Write($file), 'Write file without data' );
387: ok( $pdb->Load($file), 'Load File without data' );
1.15 andrew 388:
1.20 andrew 389: ok( unlink($file), 'Remove test pdb v' . $options->{version} );
1.15 andrew 390:
1.20 andrew 391: }
1.11 andrew 392: }
1.8 andrew 393: }
1.1 andrew 394:
395: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>