Annotation of palm/Palm-Keyring/t/keyring.t, Revision 1.23
1.12 andrew 1: #!/usr/bin/perl -T
1.23 ! andrew 2: # $RedRiver: keyring.t,v 1.22 2008/09/19 02:51:44 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.23 ! andrew 209: eval{ $pdb->Encrypt( $record, $password, $acct ) };
! 210: like(
! 211: $@,
! 212: qr/^Unsupported \s version \s 999/xms,
! 213: 'Couldn\'t Encrypt with unsupported version'
! 214: );
! 215:
1.22 andrew 216: eval { $pdb->Write($file) };
217: like(
218: $@,
219: qr/^Unsupported \s Version \s 999/xms,
220: 'Couldn\'t Write file with unsupported version'
221: );
1.20 andrew 222:
223: eval{ $pdb->PackRecord($record) };
224: like( $@,
225: qr/^Unsupported \s Version \s 999/xms,
226: 'Couldn\'t PackRecord with Invalid Version'
227: );
228:
1.22 andrew 229: $record2->{data} = q{nothing};
1.20 andrew 230: eval{ $pdb->ParseRecord(%{ $record2 }) };
231: like( $@,
232: qr/^Unsupported \s Version \s 999/xms,
233: 'Couldn\'t ParseRecord with Invalid Version'
1.21 andrew 234: );
235:
236:
1.23 ! andrew 237: $pdb = undef;
! 238: $record = undef;
! 239: $record2 = undef;
! 240: %{ $acct->{3}->{data} } = %unchanging_date;
1.20 andrew 241:
242: unlink $file;
243:
1.18 andrew 244: foreach my $options (@o) {
1.20 andrew 245: foreach my $config_type ( 'hashref', 'cgi-style', 'list' ) {
246:
247: my $pdb;
248: my $record;
249: my $decrypted;
250:
251: my $Num_Tests_Left = 25;
252: SKIP: {
253: if ( defined $options->{cipher} && $options->{cipher} > 0 ) {
254: my $crypt = Palm::Keyring::crypts( $options->{cipher} );
255: skip 'Crypt::CBC not installed', $Num_Tests_Left
256: unless eval "require Crypt::CBC";
257: if ($crypt) {
258: skip 'Crypt::' . $crypt->{name} . ' not installed',
259: $Num_Tests_Left
260: unless eval "require Crypt::$crypt->{name}";
261: }
262: else {
263: skip 'Unknown Crypt: ' . $options->{cipher},
264: $Num_Tests_Left;
265: }
266: }
267:
268: if ( $options->{version} == 4 ) {
269: skip 'Crypt::DES not installed', $Num_Tests_Left
270: unless eval "require Crypt::DES ";
271: skip 'Digest::MD5 not installed', $Num_Tests_Left
272: unless eval "require Digest::MD5 ";
273: }
274: elsif ( $options->{version} == 5 ) {
275: skip 'Digest::HMAC_SHA1 not installed', $Num_Tests_Left
276: unless eval "require Digest::HMAC_SHA1 ";
277: }
278:
279: my @options = ($options);
280: if ( $config_type eq 'cgi-style' ) {
281: @options = (
282: '-version' => $options->{version},
283: '-password' => $options->{password},
284: );
285: if ( $options->{cipher} ) {
286: push @options, '-cipher', $options->{cipher};
287: }
288: }
289: elsif ( $config_type eq 'list' ) {
290: @options = ( $options->{password}, $options->{version} );
291: if ( $options->{cipher} ) {
292: push @options, $options->{cipher};
293: }
294: }
295:
296: ok( $pdb = new Palm::Keyring(@options),
297: 'new Palm::Keyring v' . $options->{version}
298: );
299:
300: ok( $pdb->Write($file), 'Write "empty" file' );
1.23 ! andrew 301: #exit if $pdb->{version} == 5;
1.7 andrew 302:
1.20 andrew 303: ok( $record = $pdb->append_Record(), 'Append Record' );
1.7 andrew 304:
1.20 andrew 305: ok( $pdb->Encrypt( $record, $password, $acct ),
306: 'Encrypt account into record' );
1.7 andrew 307:
1.20 andrew 308: ok( $pdb->Write($file), 'Write file' );
1.7 andrew 309:
1.20 andrew 310: $pdb = undef;
1.7 andrew 311:
1.20 andrew 312: ok( $pdb = new Palm::Keyring(), 'new Palm::Keyring' );
1.9 andrew 313:
1.20 andrew 314: ok( $pdb->Load($file), 'Load File' );
1.11 andrew 315:
1.20 andrew 316: ok( $pdb->Password($password), 'Verify Password' );
1.7 andrew 317:
1.20 andrew 318: my $rec_num = 0;
319: ok( $decrypted = $pdb->Decrypt( $pdb->{records}->[$rec_num] ),
320: 'Decrypt record' );
1.7 andrew 321:
1.20 andrew 322: is( $decrypted->{2}->{data}, $password, 'Got password' );
1.7 andrew 323:
1.20 andrew 324: is_deeply( $decrypted, $acct, 'Account Matches' );
1.7 andrew 325:
1.20 andrew 326: my $old_date = $decrypted->{3}->{data};
1.7 andrew 327:
1.20 andrew 328: ok( $pdb->Password( $password, $new_password ),
329: 'Change PDB Password' );
1.1 andrew 330:
1.20 andrew 331: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
332: 'Decrypt with new password' );
1.7 andrew 333:
1.20 andrew 334: my $new_date = $decrypted->{3}->{data};
1.7 andrew 335:
1.20 andrew 336: is_deeply( $old_date, $new_date, 'Date didn\'t change' );
1.7 andrew 337:
1.20 andrew 338: $decrypted->{2}->{data} = $new_password;
1.7 andrew 339:
1.20 andrew 340: $pdb->{records}->[$rec_num]->{plaintext} = $decrypted;
1.4 andrew 341:
1.20 andrew 342: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num] ),
343: 'Change record' );
1.4 andrew 344:
1.20 andrew 345: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
346: 'Decrypt new record' );
1.15 andrew 347:
1.20 andrew 348: $new_date = $decrypted->{3}->{data};
1.7 andrew 349:
1.20 andrew 350: my $od = join '/', map { $old_date->{$_} } sort keys %{$old_date};
351: my $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
1.7 andrew 352:
1.20 andrew 353: isnt( $od, $nd, 'Date changed' );
1.4 andrew 354:
1.20 andrew 355: is( $decrypted->{2}->{data}, $new_password, 'Got new password' );
1.7 andrew 356:
1.20 andrew 357: my $last_decrypted = $decrypted;
1.7 andrew 358:
1.20 andrew 359: $decrypted = {};
360: ok( $pdb->Password(), 'Forget password' );
1.7 andrew 361:
1.20 andrew 362: eval {
363: $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] );
364: };
365: ok( $@, 'Don\'t decrypt' );
1.15 andrew 366:
1.20 andrew 367: isnt( $decrypted->{password},
368: $new_password, 'Didn\'t get new password' );
1.7 andrew 369:
1.20 andrew 370: ok( $pdb->Unlock($new_password), 'Unlock' );
1.7 andrew 371:
1.20 andrew 372: my @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.4 andrew 373:
1.20 andrew 374: is_deeply( $plaintext[0], $last_decrypted, 'Account Matches' );
1.15 andrew 375:
1.20 andrew 376: ok( $pdb->Lock(), 'Lock' );
1.15 andrew 377:
1.20 andrew 378: my $cleared_decrypted = {};
379: $cleared_decrypted->{0} = $last_decrypted->{0};
380: @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.15 andrew 381:
1.20 andrew 382: is_deeply( $plaintext[0], $cleared_decrypted, 'Cleared records' );
1.15 andrew 383:
1.20 andrew 384: $pdb->{records}->[0]->{data} = undef;
1.21 andrew 385: ok( $pdb->Write($file), 'Write file without data' );
386: ok( $pdb->Load($file), 'Load File without data' );
1.15 andrew 387:
1.20 andrew 388: ok( unlink($file), 'Remove test pdb v' . $options->{version} );
1.15 andrew 389:
1.20 andrew 390: }
1.11 andrew 391: }
1.8 andrew 392: }
1.1 andrew 393:
394: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>