Annotation of palm/Palm-Keyring/t/keyring.t, Revision 1.25
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.25 ! andrew 6: use Test::More tests => 321;
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: $@,
! 162: qr/^No \s encrypted \s password!/xms,
! 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: $@,
! 193: qr/^Invalid \s Password/xms,
! 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,
! 209: data => 'This doesn\'t even really exist',
! 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: $@,
! 237: qr/^Unsupported \s Crypt \s Testing \s in \s decrypt/xms,
! 238: 'Couldn\'t Decrypt with unsupported Crypt'
! 239: );
! 240:
! 241: my $encrypted = delete $record->{encrypted};
! 242: eval{ $pdb->Encrypt( $record ) };
! 243: like(
! 244: $@,
! 245: qr/^Unsupported \s Crypt \s Testing \s in \s encrypt/xms,
! 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: $@,
! 254: qr/^Unknown \s cipher \s $bad_cipher \s in \s decrypt/xms,
! 255: 'Couldn\'t Decrypt with unsupported cipher'
! 256: );
! 257:
! 258: $encrypted = delete $record->{encrypted};
! 259: eval{ $pdb->Encrypt( $record ) };
! 260: like(
! 261: $@,
! 262: qr/^Unknown \s cipher \s $bad_cipher \s in \s encrypt/xms,
! 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: $@,
! 285: qr/^No \s data \s to \s PackRecord/xms,
! 286: 'Pack Empty Record with no data'
! 287: );
! 288:
! 289:
! 290: $pdb->{version} = $bad_version;
! 291: eval{ $pdb->Decrypt( $record ) };
! 292: like(
! 293: $@,
! 294: qr/^Unsupported \s version \s $bad_version \s in \s Decrypt/xms,
! 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.25 ! andrew 302: qr/^Unsupported \s version \s $bad_version \s in \s Encrypt/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.25 ! andrew 327: eval{ $pdb->Password( $password ) };
! 328: like( $@,
! 329: qr/^Unsupported \s Version \s $bad_version/xms,
! 330: 'Couldn\'t Password with Invalid Version'
! 331: );
! 332:
1.21 andrew 333:
1.23 andrew 334: $pdb = undef;
335: $record = undef;
336: $record2 = undef;
1.20 andrew 337:
338: unlink $file;
339:
1.18 andrew 340: foreach my $options (@o) {
1.20 andrew 341: foreach my $config_type ( 'hashref', 'cgi-style', 'list' ) {
342:
343: my $pdb;
344: my $record;
345: my $decrypted;
1.25 ! andrew 346: %{ $acct->{3}->{data} } = %unchanging_date;
1.20 andrew 347:
348: my $Num_Tests_Left = 25;
349: SKIP: {
350: if ( defined $options->{cipher} && $options->{cipher} > 0 ) {
351: my $crypt = Palm::Keyring::crypts( $options->{cipher} );
352: skip 'Crypt::CBC not installed', $Num_Tests_Left
353: unless eval "require Crypt::CBC";
354: if ($crypt) {
355: skip 'Crypt::' . $crypt->{name} . ' not installed',
356: $Num_Tests_Left
357: unless eval "require Crypt::$crypt->{name}";
358: }
359: else {
360: skip 'Unknown Crypt: ' . $options->{cipher},
361: $Num_Tests_Left;
362: }
363: }
364:
365: if ( $options->{version} == 4 ) {
366: skip 'Crypt::DES not installed', $Num_Tests_Left
367: unless eval "require Crypt::DES ";
368: skip 'Digest::MD5 not installed', $Num_Tests_Left
369: unless eval "require Digest::MD5 ";
370: }
371: elsif ( $options->{version} == 5 ) {
372: skip 'Digest::HMAC_SHA1 not installed', $Num_Tests_Left
373: unless eval "require Digest::HMAC_SHA1 ";
374: }
375:
376: my @options = ($options);
377: if ( $config_type eq 'cgi-style' ) {
378: @options = (
379: '-version' => $options->{version},
380: '-password' => $options->{password},
381: );
382: if ( $options->{cipher} ) {
383: push @options, '-cipher', $options->{cipher};
384: }
385: }
386: elsif ( $config_type eq 'list' ) {
387: @options = ( $options->{password}, $options->{version} );
388: if ( $options->{cipher} ) {
389: push @options, $options->{cipher};
390: }
391: }
392:
393: ok( $pdb = new Palm::Keyring(@options),
394: 'new Palm::Keyring v' . $options->{version}
395: );
396:
397: ok( $pdb->Write($file), 'Write "empty" file' );
1.23 andrew 398: #exit if $pdb->{version} == 5;
1.7 andrew 399:
1.20 andrew 400: ok( $record = $pdb->append_Record(), 'Append Record' );
1.25 ! andrew 401:
! 402: ok( $pdb->Password(), 'Clear Password' );
! 403:
! 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: $@,
! 425: qr/^Invalid \s Password/xms,
! 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.20 andrew 435: ok( $pdb->Write($file), 'Write file' );
1.25 ! andrew 436: #print Dumper $pdb, $acct, $record;
1.7 andrew 437:
1.20 andrew 438: $pdb = undef;
1.7 andrew 439:
1.20 andrew 440: ok( $pdb = new Palm::Keyring(), 'new Palm::Keyring' );
1.9 andrew 441:
1.20 andrew 442: ok( $pdb->Load($file), 'Load File' );
1.11 andrew 443:
1.25 ! andrew 444: my $rec_num = 0;
! 445:
! 446: eval{ $pdb->Decrypt( ) };
! 447: like(
! 448: $@,
! 449: qr/^Needed \s parameter \s \[record\] \s not \s passed!/xms,
! 450: 'Decrypt with no record'
! 451: );
! 452:
! 453: eval{ $pdb->Decrypt( $pdb->{records}->[$rec_num] ) };
! 454: like(
! 455: $@,
! 456: qr/^Password \s not \s set!/xms,
! 457: 'Decrypt with no password set'
! 458: );
! 459:
! 460: eval{ $pdb->Decrypt( $pdb->{records}->[$rec_num], $new_password ) };
! 461: like(
! 462: $@,
! 463: qr/^Invalid \s Password/xms,
! 464: 'Decypt with invalid password'
! 465: );
! 466:
1.20 andrew 467: ok( $pdb->Password($password), 'Verify Password' );
1.7 andrew 468:
1.25 ! andrew 469: eval{ $pdb->Password($new_password) };
! 470: like(
! 471: $@,
! 472: qr/^Invalid \s Password/xms,
! 473: 'Verify Incorrect Password'
! 474: );
! 475:
! 476: eval{ $pdb->Decrypt( {} ) };
! 477: like(
! 478: $@,
! 479: qr/^No \s encrypted \s content!/xms,
! 480: 'Decrypt with empty record'
! 481: );
! 482:
1.20 andrew 483: ok( $decrypted = $pdb->Decrypt( $pdb->{records}->[$rec_num] ),
484: 'Decrypt record' );
1.7 andrew 485:
1.20 andrew 486: is( $decrypted->{2}->{data}, $password, 'Got password' );
1.7 andrew 487:
1.20 andrew 488: is_deeply( $decrypted, $acct, 'Account Matches' );
1.7 andrew 489:
1.20 andrew 490: my $old_date = $decrypted->{3}->{data};
1.7 andrew 491:
1.20 andrew 492: ok( $pdb->Password( $password, $new_password ),
493: 'Change PDB Password' );
1.1 andrew 494:
1.20 andrew 495: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
496: 'Decrypt with new password' );
1.7 andrew 497:
1.20 andrew 498: my $new_date = $decrypted->{3}->{data};
1.7 andrew 499:
1.20 andrew 500: is_deeply( $old_date, $new_date, 'Date didn\'t change' );
1.7 andrew 501:
1.20 andrew 502: $decrypted->{2}->{data} = $new_password;
1.7 andrew 503:
1.20 andrew 504: $pdb->{records}->[$rec_num]->{plaintext} = $decrypted;
1.4 andrew 505:
1.20 andrew 506: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num] ),
1.25 ! andrew 507: 'Encrypt record (new password)' );
1.4 andrew 508:
1.20 andrew 509: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
510: 'Decrypt new record' );
1.15 andrew 511:
1.25 ! andrew 512: is( $decrypted->{2}->{data}, $new_password, 'Got new password' );
! 513:
1.20 andrew 514: $new_date = $decrypted->{3}->{data};
1.7 andrew 515:
1.20 andrew 516: my $od = join '/', map { $old_date->{$_} } sort keys %{$old_date};
517: my $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
1.7 andrew 518:
1.20 andrew 519: isnt( $od, $nd, 'Date changed' );
1.4 andrew 520:
1.25 ! andrew 521: %{ $new_date } = %unchanging_date;
! 522: $new_date->{year} = 1999;
! 523: $decrypted->{3}->{data} = $new_date;
! 524:
! 525: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num], undef, $decrypted ),
! 526: 'Encrypt record (new date)' );
! 527:
! 528: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
! 529: 'Decrypt new record' );
! 530:
! 531: $new_date = $decrypted->{3}->{data};
! 532:
! 533: $od = $nd;
! 534: $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
! 535: my $ud = join '/', map { $unchanging_date{$_} } sort keys %unchanging_date;
! 536:
! 537: isnt( $od, $nd, 'Date changed (from what it used to be)' );
! 538: is( $ud, $nd, 'Date changed (to what we set)' );
! 539:
! 540: delete $decrypted->{3};
! 541: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num], undef, $decrypted ),
! 542: 'Encrypt record (no date)' );
! 543:
! 544: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
! 545: 'Decrypt new record' );
! 546:
! 547: $new_date = $decrypted->{3}->{data};
! 548:
! 549: is( ref $new_date, 'HASH', 'Got a hashref date' );
1.7 andrew 550:
1.20 andrew 551: my $last_decrypted = $decrypted;
1.7 andrew 552:
1.20 andrew 553: $decrypted = {};
554: ok( $pdb->Password(), 'Forget password' );
1.7 andrew 555:
1.20 andrew 556: eval {
557: $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] );
558: };
559: ok( $@, 'Don\'t decrypt' );
1.15 andrew 560:
1.20 andrew 561: isnt( $decrypted->{password},
562: $new_password, 'Didn\'t get new password' );
1.7 andrew 563:
1.20 andrew 564: ok( $pdb->Unlock($new_password), 'Unlock' );
1.7 andrew 565:
1.20 andrew 566: my @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.4 andrew 567:
1.20 andrew 568: is_deeply( $plaintext[0], $last_decrypted, 'Account Matches' );
1.15 andrew 569:
1.20 andrew 570: ok( $pdb->Lock(), 'Lock' );
1.15 andrew 571:
1.20 andrew 572: my $cleared_decrypted = {};
573: $cleared_decrypted->{0} = $last_decrypted->{0};
574: @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.15 andrew 575:
1.20 andrew 576: is_deeply( $plaintext[0], $cleared_decrypted, 'Cleared records' );
1.15 andrew 577:
1.20 andrew 578: $pdb->{records}->[0]->{data} = undef;
1.21 andrew 579: ok( $pdb->Write($file), 'Write file without data' );
580: ok( $pdb->Load($file), 'Load File without data' );
1.15 andrew 581:
1.20 andrew 582: ok( unlink($file), 'Remove test pdb v' . $options->{version} );
1.15 andrew 583:
1.20 andrew 584: }
1.11 andrew 585: }
1.8 andrew 586: }
1.1 andrew 587:
588: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>