Annotation of palm/Palm-Keyring/t/keyring.t, Revision 1.27
1.12 andrew 1: #!/usr/bin/perl -T
1.25 andrew 2: # $RedRiver: keyring.t,v 1.24 2008/09/19 05:53:08 andrew Exp $
1.7 andrew 3: use strict;
4: use warnings;
1.1 andrew 5:
1.27 ! andrew 6: use Test::More tests => 333;
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.25 andrew 67: my $bad_version = 999;
68:
1.20 andrew 69: my $bad_cipher = 999;
70: my %crypt_1_details = (
71: 'default_iter' => 1000,
72: 'keylen' => 24,
73: 'blocksize' => 8,
74: 'name' => 'DES_EDE3',
75: 'alias' => 'DES-EDE3',
76: 'DES_odd_parity' => 1
77: );
78:
79: my $bad_label = 999;
80: my $bad_label_name = 'not_a_label_name';
81: my %label_1_details = (
82: id => 1,
83: name => 'account',
84: );
85: my %label_not_found_details = (
86: id => $bad_label,
87: name => undef,
88: );
89:
90: # Crypts
91: is_deeply( Palm::Keyring::crypts(1), \%crypt_1_details, 'Got crypt 1' );
92: is_deeply( Palm::Keyring::crypts('DES-EDE3'),
93: \%crypt_1_details, 'Got crypt DES-EDE3' );
94: is( Palm::Keyring::crypts(), undef, "Didn't get crypt empty cipher" );
95: is( Palm::Keyring::crypts($bad_cipher),
96: undef, "Didn't get crypt $bad_cipher" );
97:
98: # Bad Cipher
99: eval { Palm::Keyring->new( { version => 5, cipher => $bad_cipher } ) };
100: like(
101: $@,
102: qr/^Unknown \s cipher \s $bad_cipher/xms,
103: "Failed to create keyring with cipher $bad_cipher"
104: );
105:
106: # Labels
107: is_deeply( Palm::Keyring::labels(1), \%label_1_details, 'Got label 1' );
108: is_deeply( Palm::Keyring::labels('account'),
109: \%label_1_details, 'Got label account' );
110: is( Palm::Keyring::labels(), undef, "Didn't get label empty label" );
111: is_deeply( Palm::Keyring::labels($bad_label),
112: \%label_not_found_details, "Got default label for $bad_label" );
1.21 andrew 113: is( Palm::Keyring::labels($bad_label_name), undef, "Didn't get label for $bad_label_name"
1.20 andrew 114: );
115:
1.25 andrew 116: # encrypt/decrypt (v4)
117: my %acctv4 = (
118: account => 'account name',
119: password => $password,
120: notes => 'these are notes',
121: lastchange => undef,
122: );
123:
124: my $digestv4;
125: ok( $digestv4 = Palm::Keyring::_calc_keys( $password ), '_calc_keys' );
126:
127: my $encryptedv4;
128: ok( $encryptedv4 = Palm::Keyring::_encrypt_v4( \%acctv4, {}, $digestv4 ),
129: '_encrypt_v4');
130:
131: my $plaintextv4;
132: ok( $plaintextv4 = Palm::Keyring::_decrypt_v4( $encryptedv4, $digestv4 ),
133: '_decrypt_v4');
134:
135: $plaintextv4->{lastchange} = undef;
136: is_deeply( $plaintextv4, \%acctv4, 'Is what we got back, what we sent in?' );
137:
138: my $NULL = chr(0);
139: $plaintextv4 = join $NULL, $acctv4{account}, $acctv4{password}, $acctv4{notes};
140:
141: ok( $encryptedv4 = Palm::Keyring::_crypt3des( $plaintextv4, $digestv4, 1 ),
142: 'encrypt without date' ); # 1 is encrypt
143:
144: ok( $plaintextv4 = Palm::Keyring::_decrypt_v4( $encryptedv4, $digestv4 ),
145: '_decrypt_v4');
146:
147: $plaintextv4->{'lastchange'} = undef;
148: is_deeply( $plaintextv4, \%acctv4, 'Is what we got back, what we sent in?' );
149:
150: # Password
151:
152: eval{ Palm::Keyring::_password_verify_v4() };
153: like(
154: $@,
155: qr/^No \s password \s specified!/xms,
156: '_password_verify_v4 with no password'
157: );
158:
159: eval{ Palm::Keyring::_password_verify_v4($password) };
160: like(
161: $@,
1.26 andrew 162: qr/^No \s encrypted \s password \s in \s file!/xms,
1.25 andrew 163: '_password_verify_v4 with no password'
164: );
1.21 andrew 165:
1.20 andrew 166: my $pdb;
1.21 andrew 167:
1.20 andrew 168: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_version.pdb' ) };
169: like(
170: $@,
1.25 andrew 171: qr/^Unsupported \s Version \s $bad_version/xms,
1.20 andrew 172: 'Couldn\'t load pdb with invalid version'
173: );
174:
175: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_cipher.pdb' ) };
176: like(
177: $@,
1.25 andrew 178: qr/^Unknown \s cipher \s $bad_version/xms,
1.20 andrew 179: 'Couldn\'t load pdb with Unknown Cipher'
180: );
181:
1.23 andrew 182: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_appinfo.pdb' ) };
183: like(
184: $@,
185: qr/^Corrupt \s appinfo\? \s no \s {other}/xms,
186: 'Couldn\'t load pdb with invalid appinfo'
187: );
188:
1.25 andrew 189: eval{ $pdb = new Palm::Keyring( -file => 't/Keys-no_data.pdb', -password =>
190: $new_password ) };
191: like(
192: $@,
1.27 ! andrew 193: qr/^Incorrect \s Password/xms,
1.25 andrew 194: 'Couldn\'t load Palm::Keyring file with no data and wrong password'
195: );
196:
1.20 andrew 197: ok( $pdb = new Palm::Keyring( -file => 't/Keys-no_data.pdb' ),
198: 'Loaded Palm::Keyring file with no data' );
199:
200: my $record;
201: ok( $record = $pdb->append_Record(), 'Append Record' );
1.23 andrew 202: my $ivec = pack("C*", 1..8);
203: ok( $pdb->Encrypt( $record, $password, $acct, $ivec),
204: 'Encrypt account into record (with custom ivec)' );
1.25 andrew 205:
206: $acct->{254} = {
207: label => 'misc',
208: label_id => 254,
1.27 ! andrew 209: data => 'This doesn\'t even really existx',
1.25 andrew 210: font => 0,
211: };
212: ok( $pdb->Encrypt( $record, $password, $acct ),
213: 'Encrypt account into record (with custom field)' );
214:
215: delete $acct->{254};
216:
1.23 andrew 217:
218: delete $record->{plaintext};
219:
1.21 andrew 220: ok( $pdb->PackRecord($record), 'Pack Proper Record');
221: ok( $record = $pdb->ParseRecord(%{ $record }), 'Parse Proper Packed');
222:
1.20 andrew 223: my $record2;
224: ok( $record2 = $pdb->append_Record(), 'Append Record' );
1.22 andrew 225: eval{ $pdb->PackRecord($record2) };
226: like(
227: $@,
228: qr/^No \s encrypted \s data \s in \s record/xms,
229: 'Pack Empty Record'
230: );
231:
1.25 andrew 232: $pdb->{appinfo}->{cipher} = 'TESTING';
233:
234: eval{ $pdb->Decrypt( $record ) };
235: like(
236: $@,
1.27 ! andrew 237: qr/^Unsupported \s Crypt \s Testing/xms,
1.25 andrew 238: 'Couldn\'t Decrypt with unsupported Crypt'
239: );
240:
241: my $encrypted = delete $record->{encrypted};
242: eval{ $pdb->Encrypt( $record ) };
243: like(
244: $@,
1.27 ! andrew 245: qr/^Unsupported \s Crypt \s Testing/xms,
1.25 andrew 246: 'Couldn\'t Encrypt with unsupported Crypt'
247: );
248: $record->{encrypted} = $encrypted;
249:
250: $pdb->{appinfo}->{cipher} = $bad_cipher;
251: eval{ $pdb->Decrypt( $record ) };
252: like(
253: $@,
1.27 ! andrew 254: qr/^Unknown \s cipher \s $bad_cipher/xms,
1.25 andrew 255: 'Couldn\'t Decrypt with unsupported cipher'
256: );
257:
258: $encrypted = delete $record->{encrypted};
259: eval{ $pdb->Encrypt( $record ) };
260: like(
261: $@,
1.27 ! andrew 262: qr/^Unknown \s cipher \s $bad_cipher/xms,
1.25 andrew 263: 'Couldn\'t Encrypt with unsupported cipher'
264: );
265: $record->{encrypted} = $encrypted;
266:
267:
268: $record2->{encrypted} = {};
269: delete $record2->{ivec};
1.22 andrew 270: eval{ $pdb->PackRecord($record2) };
271: like(
272: $@,
273: qr/^No \s ivec/xms,
274: 'Pack Empty Record with encrypted, but no ivec'
275: );
276:
1.25 andrew 277:
278:
1.22 andrew 279: $pdb->{version} = 4;
1.25 andrew 280: delete $record2->{encrypted};
281: delete $record2->{data};
282: eval{ $pdb->PackRecord($record2) };
283: like(
284: $@,
1.27 ! andrew 285: qr/^No \s data \s in \s record \s to \s pack/xms,
1.25 andrew 286: 'Pack Empty Record with no data'
287: );
288:
289:
290: $pdb->{version} = $bad_version;
291: eval{ $pdb->Decrypt( $record ) };
292: like(
293: $@,
1.27 ! andrew 294: qr/^Unsupported \s Version \s $bad_version/xms,
1.25 andrew 295: 'Couldn\'t Decrypt with unsupported version'
1.22 andrew 296: );
1.20 andrew 297:
1.24 andrew 298: delete $record->{encrypted};
299: eval{ $pdb->Encrypt( $record, undef, $acct ) };
1.23 andrew 300: like(
301: $@,
1.27 ! andrew 302: qr/^Unsupported \s Version \s $bad_version/xms,
1.23 andrew 303: 'Couldn\'t Encrypt with unsupported version'
304: );
305:
1.25 andrew 306:
1.22 andrew 307: eval { $pdb->Write($file) };
308: like(
309: $@,
1.25 andrew 310: qr/^Unsupported \s Version \s $bad_version/xms,
1.22 andrew 311: 'Couldn\'t Write file with unsupported version'
312: );
1.20 andrew 313:
314: eval{ $pdb->PackRecord($record) };
315: like( $@,
1.25 andrew 316: qr/^Unsupported \s Version \s $bad_version/xms,
1.20 andrew 317: 'Couldn\'t PackRecord with Invalid Version'
318: );
319:
1.22 andrew 320: $record2->{data} = q{nothing};
1.20 andrew 321: eval{ $pdb->ParseRecord(%{ $record2 }) };
322: like( $@,
1.25 andrew 323: qr/^Unsupported \s Version \s $bad_version/xms,
1.20 andrew 324: 'Couldn\'t ParseRecord with Invalid Version'
1.21 andrew 325: );
326:
1.27 ! andrew 327: eval{ $pdb->Password( $new_password ) };
1.25 andrew 328: like( $@,
329: qr/^Unsupported \s Version \s $bad_version/xms,
330: 'Couldn\'t Password with Invalid Version'
331: );
332:
1.23 andrew 333: $pdb = undef;
334: $record = undef;
335: $record2 = undef;
1.20 andrew 336:
337: unlink $file;
338:
1.18 andrew 339: foreach my $options (@o) {
1.20 andrew 340: foreach my $config_type ( 'hashref', 'cgi-style', 'list' ) {
341:
342: my $pdb;
343: my $record;
344: my $decrypted;
1.25 andrew 345: %{ $acct->{3}->{data} } = %unchanging_date;
1.27 ! andrew 346: my $rec_num = 0;
! 347:
1.20 andrew 348:
349: my $Num_Tests_Left = 25;
350: SKIP: {
351: if ( defined $options->{cipher} && $options->{cipher} > 0 ) {
352: my $crypt = Palm::Keyring::crypts( $options->{cipher} );
353: skip 'Crypt::CBC not installed', $Num_Tests_Left
354: unless eval "require Crypt::CBC";
355: if ($crypt) {
356: skip 'Crypt::' . $crypt->{name} . ' not installed',
357: $Num_Tests_Left
358: unless eval "require Crypt::$crypt->{name}";
359: }
360: else {
361: skip 'Unknown Crypt: ' . $options->{cipher},
362: $Num_Tests_Left;
363: }
364: }
365:
366: if ( $options->{version} == 4 ) {
367: skip 'Crypt::DES not installed', $Num_Tests_Left
368: unless eval "require Crypt::DES ";
369: skip 'Digest::MD5 not installed', $Num_Tests_Left
370: unless eval "require Digest::MD5 ";
371: }
372: elsif ( $options->{version} == 5 ) {
373: skip 'Digest::HMAC_SHA1 not installed', $Num_Tests_Left
374: unless eval "require Digest::HMAC_SHA1 ";
375: }
376:
377: my @options = ($options);
378: if ( $config_type eq 'cgi-style' ) {
379: @options = (
380: '-version' => $options->{version},
381: '-password' => $options->{password},
382: );
383: if ( $options->{cipher} ) {
384: push @options, '-cipher', $options->{cipher};
385: }
386: }
387: elsif ( $config_type eq 'list' ) {
388: @options = ( $options->{password}, $options->{version} );
389: if ( $options->{cipher} ) {
390: push @options, $options->{cipher};
391: }
392: }
393:
394: ok( $pdb = new Palm::Keyring(@options),
395: 'new Palm::Keyring v' . $options->{version}
396: );
397:
398: ok( $pdb->Write($file), 'Write "empty" file' );
1.23 andrew 399: #exit if $pdb->{version} == 5;
1.7 andrew 400:
1.20 andrew 401: ok( $record = $pdb->append_Record(), 'Append Record' );
1.25 andrew 402:
403: ok( $pdb->Password(), 'Clear Password' );
404: eval{ $pdb->Encrypt() };
405: like(
406: $@,
407: qr/^Needed \s parameter \s \[record\] \s not \s passed!/xms,
408: 'Encrypt account into record without record'
409: );
410: eval{ $pdb->Encrypt( $record ) };
411: like(
412: $@,
413: qr/^Password \s not \s set!/xms,
414: 'Encrypt account into record without password'
415: );
416: eval{ $pdb->Encrypt( $record, $password ) };
417: like(
418: $@,
419: qr/^Needed \s parameter \s \[plaintext\] \s not \s passed!/xms,
420: 'Encrypt account into record without account'
421: );
422: eval{ $pdb->Encrypt( $record, $new_password, $acct ) };
423: like(
424: $@,
1.27 ! andrew 425: qr/^Incorrect \s Password/xms,
1.25 andrew 426: 'Encrypt account into record with wrong password'
427: );
1.7 andrew 428:
1.20 andrew 429: ok( $pdb->Encrypt( $record, $password, $acct ),
430: 'Encrypt account into record' );
1.7 andrew 431:
1.25 andrew 432: ok( $pdb->Encrypt( $record, $password, $acct ),
433: 'Encrypt account into record (with no changes)');
434:
1.27 ! andrew 435: ok( $decrypted = $pdb->Decrypt( $pdb->{records}->[$rec_num] ),
! 436: 'Decrypt record' );
! 437:
! 438:
! 439: is( $decrypted->{2}->{data}, $password, 'Got password' );
! 440:
1.20 andrew 441: ok( $pdb->Write($file), 'Write file' );
1.7 andrew 442:
1.20 andrew 443: $pdb = undef;
1.7 andrew 444:
1.20 andrew 445: ok( $pdb = new Palm::Keyring(), 'new Palm::Keyring' );
1.9 andrew 446:
1.20 andrew 447: ok( $pdb->Load($file), 'Load File' );
1.11 andrew 448:
1.25 andrew 449: eval{ $pdb->Decrypt( ) };
450: like(
451: $@,
452: qr/^Needed \s parameter \s \[record\] \s not \s passed!/xms,
453: 'Decrypt with no record'
454: );
455:
456: eval{ $pdb->Decrypt( $pdb->{records}->[$rec_num] ) };
457: like(
458: $@,
459: qr/^Password \s not \s set!/xms,
460: 'Decrypt with no password set'
461: );
462:
463: eval{ $pdb->Decrypt( $pdb->{records}->[$rec_num], $new_password ) };
464: like(
465: $@,
1.27 ! andrew 466: qr/^Incorrect \s Password/xms,
1.25 andrew 467: 'Decypt with invalid password'
468: );
469:
470: eval{ $pdb->Password($new_password) };
471: like(
472: $@,
1.27 ! andrew 473: qr/^Incorrect \s Password/xms,
1.25 andrew 474: 'Verify Incorrect Password'
475: );
476:
477: eval{ $pdb->Decrypt( {} ) };
478: like(
479: $@,
480: qr/^No \s encrypted \s content!/xms,
481: 'Decrypt with empty record'
482: );
1.27 ! andrew 483:
! 484: ok( $pdb->Password($password), 'Verify Password' );
1.25 andrew 485:
1.20 andrew 486: ok( $decrypted = $pdb->Decrypt( $pdb->{records}->[$rec_num] ),
487: 'Decrypt record' );
1.7 andrew 488:
1.20 andrew 489: is( $decrypted->{2}->{data}, $password, 'Got password' );
1.7 andrew 490:
1.20 andrew 491: is_deeply( $decrypted, $acct, 'Account Matches' );
1.7 andrew 492:
1.20 andrew 493: my $old_date = $decrypted->{3}->{data};
1.7 andrew 494:
1.20 andrew 495: ok( $pdb->Password( $password, $new_password ),
496: 'Change PDB Password' );
1.1 andrew 497:
1.20 andrew 498: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
499: 'Decrypt with new password' );
1.7 andrew 500:
1.20 andrew 501: my $new_date = $decrypted->{3}->{data};
1.7 andrew 502:
1.20 andrew 503: is_deeply( $old_date, $new_date, 'Date didn\'t change' );
1.7 andrew 504:
1.20 andrew 505: $decrypted->{2}->{data} = $new_password;
1.7 andrew 506:
1.20 andrew 507: $pdb->{records}->[$rec_num]->{plaintext} = $decrypted;
1.4 andrew 508:
1.20 andrew 509: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num] ),
1.25 andrew 510: 'Encrypt record (new password)' );
1.4 andrew 511:
1.20 andrew 512: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
513: 'Decrypt new record' );
1.15 andrew 514:
1.25 andrew 515: is( $decrypted->{2}->{data}, $new_password, 'Got new password' );
516:
1.20 andrew 517: $new_date = $decrypted->{3}->{data};
1.7 andrew 518:
1.20 andrew 519: my $od = join '/', map { $old_date->{$_} } sort keys %{$old_date};
520: my $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
1.7 andrew 521:
1.20 andrew 522: isnt( $od, $nd, 'Date changed' );
1.4 andrew 523:
1.25 andrew 524: %{ $new_date } = %unchanging_date;
525: $new_date->{year} = 1999;
526: $decrypted->{3}->{data} = $new_date;
527:
528: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num], undef, $decrypted ),
529: 'Encrypt record (new date)' );
530:
531: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
532: 'Decrypt new record' );
533:
534: $new_date = $decrypted->{3}->{data};
535:
536: $od = $nd;
537: $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
538: my $ud = join '/', map { $unchanging_date{$_} } sort keys %unchanging_date;
539:
540: isnt( $od, $nd, 'Date changed (from what it used to be)' );
541: is( $ud, $nd, 'Date changed (to what we set)' );
542:
543: delete $decrypted->{3};
544: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num], undef, $decrypted ),
545: 'Encrypt record (no date)' );
546:
547: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
548: 'Decrypt new record' );
549:
550: $new_date = $decrypted->{3}->{data};
551:
552: is( ref $new_date, 'HASH', 'Got a hashref date' );
1.7 andrew 553:
1.20 andrew 554: my $last_decrypted = $decrypted;
1.7 andrew 555:
1.20 andrew 556: $decrypted = {};
557: ok( $pdb->Password(), 'Forget password' );
1.7 andrew 558:
1.20 andrew 559: eval {
560: $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] );
561: };
562: ok( $@, 'Don\'t decrypt' );
1.15 andrew 563:
1.20 andrew 564: isnt( $decrypted->{password},
565: $new_password, 'Didn\'t get new password' );
1.7 andrew 566:
1.20 andrew 567: ok( $pdb->Unlock($new_password), 'Unlock' );
1.7 andrew 568:
1.20 andrew 569: my @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.4 andrew 570:
1.20 andrew 571: is_deeply( $plaintext[0], $last_decrypted, 'Account Matches' );
1.15 andrew 572:
1.20 andrew 573: ok( $pdb->Lock(), 'Lock' );
1.15 andrew 574:
1.20 andrew 575: my $cleared_decrypted = {};
576: $cleared_decrypted->{0} = $last_decrypted->{0};
577: @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.15 andrew 578:
1.20 andrew 579: is_deeply( $plaintext[0], $cleared_decrypted, 'Cleared records' );
1.15 andrew 580:
1.20 andrew 581: $pdb->{records}->[0]->{data} = undef;
1.21 andrew 582: ok( $pdb->Write($file), 'Write file without data' );
583: ok( $pdb->Load($file), 'Load File without data' );
1.15 andrew 584:
1.20 andrew 585: ok( unlink($file), 'Remove test pdb v' . $options->{version} );
1.15 andrew 586:
1.20 andrew 587: }
1.11 andrew 588: }
1.8 andrew 589: }
1.1 andrew 590:
591: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>