Annotation of palm/Palm-Keyring/t/keyring.t, Revision 1.20
1.12 andrew 1: #!/usr/bin/perl -T
1.20 ! andrew 2: # $RedRiver: keyring.t,v 1.19 2008/09/18 02:02:50 andrew Exp $
1.7 andrew 3: use strict;
4: use warnings;
1.1 andrew 5:
1.20 ! andrew 6: use Test::More tests => 198;
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.20 ! andrew 65: my $bad_cipher = 999;
! 66: my %crypt_1_details = (
! 67: 'default_iter' => 1000,
! 68: 'keylen' => 24,
! 69: 'blocksize' => 8,
! 70: 'name' => 'DES_EDE3',
! 71: 'alias' => 'DES-EDE3',
! 72: 'DES_odd_parity' => 1
! 73: );
! 74:
! 75: my $bad_label = 999;
! 76: my $bad_label_name = 'not_a_label_name';
! 77: my %label_1_details = (
! 78: id => 1,
! 79: name => 'account',
! 80: );
! 81: my %label_not_found_details = (
! 82: id => $bad_label,
! 83: name => undef,
! 84: );
! 85:
! 86: # Crypts
! 87: is_deeply( Palm::Keyring::crypts(1), \%crypt_1_details, 'Got crypt 1' );
! 88: is_deeply( Palm::Keyring::crypts('DES-EDE3'),
! 89: \%crypt_1_details, 'Got crypt DES-EDE3' );
! 90: is( Palm::Keyring::crypts(), undef, "Didn't get crypt empty cipher" );
! 91: is( Palm::Keyring::crypts($bad_cipher),
! 92: undef, "Didn't get crypt $bad_cipher" );
! 93:
! 94: # Bad Cipher
! 95: eval { Palm::Keyring->new( { version => 5, cipher => $bad_cipher } ) };
! 96: like(
! 97: $@,
! 98: qr/^Unknown \s cipher \s $bad_cipher/xms,
! 99: "Failed to create keyring with cipher $bad_cipher"
! 100: );
! 101:
! 102: # Labels
! 103: is_deeply( Palm::Keyring::labels(1), \%label_1_details, 'Got label 1' );
! 104: is_deeply( Palm::Keyring::labels('account'),
! 105: \%label_1_details, 'Got label account' );
! 106: is( Palm::Keyring::labels(), undef, "Didn't get label empty label" );
! 107: is_deeply( Palm::Keyring::labels($bad_label),
! 108: \%label_not_found_details, "Got default label for $bad_label" );
! 109: is( Palm::Keyring::labels($bad_label_name), undef, "Didn't get label for
! 110: $bad_label_name"
! 111: );
! 112:
! 113: my $pdb;
! 114: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_version.pdb' ) };
! 115: like(
! 116: $@,
! 117: qr/^Unsupported \s Version \s 999/xms,
! 118: 'Couldn\'t load pdb with invalid version'
! 119: );
! 120:
! 121: eval { $pdb = new Palm::Keyring( -file => 't/Keys-invalid_cipher.pdb' ) };
! 122: like(
! 123: $@,
! 124: qr/^Unknown \s cipher \s 999/xms,
! 125: 'Couldn\'t load pdb with Unknown Cipher'
! 126: );
! 127:
! 128: ok( $pdb = new Palm::Keyring( -file => 't/Keys-no_data.pdb' ),
! 129: 'Loaded Palm::Keyring file with no data' );
! 130:
! 131: my $record;
! 132: ok( $record = $pdb->append_Record(), 'Append Record' );
! 133: ok( $pdb->Encrypt( $record, $password, $acct ),
! 134: 'Encrypt account into record' );
! 135: my $record2;
! 136: ok( $record2 = $pdb->append_Record(), 'Append Record' );
! 137:
! 138: ok( $pdb->PackRecord($record), 'Pack Proper Record');
! 139: eval{ $pdb->PackRecord($record2) };
! 140: like(
! 141: $@,
! 142: qr/^No \s encrypted \s content \s to \s pack/xms,
! 143: 'Fail to pack record without encrypted content'
! 144: );
! 145:
! 146: $record2->{encrypted} = '';
! 147: eval{ $pdb->PackRecord($record2) };
! 148: like(
! 149: $@,
! 150: qr/^No \s ivec/xms,
! 151: 'Fail to pack record without ivec'
! 152: );
! 153:
! 154: $record2->{ivec} = 1;
! 155: ok( $pdb->PackRecord($record2), 'Pack Proper Record');
! 156:
! 157: ok( $record = $pdb->ParseRecord(%{ $record }), 'Parse Proper Packed');
! 158:
! 159: $pdb->{version} = 999;
! 160: eval{ $pdb->PackRecord($record) };
! 161: like( $@,
! 162: qr/^Unsupported \s Version \s 999/xms,
! 163: 'Couldn\'t PackRecord with Invalid Version'
! 164: );
! 165:
! 166: eval{ $pdb->ParseRecord(%{ $record2 }) };
! 167: like( $@,
! 168: qr/^Unsupported \s Version \s 999/xms,
! 169: 'Couldn\'t ParseRecord with Invalid Version'
! 170: );
! 171:
! 172: $pdb = undef;
! 173:
! 174: unlink $file;
! 175:
1.18 andrew 176: foreach my $options (@o) {
1.20 ! andrew 177: foreach my $config_type ( 'hashref', 'cgi-style', 'list' ) {
! 178:
! 179: my $pdb;
! 180: my $record;
! 181: my $decrypted;
! 182:
! 183: my $Num_Tests_Left = 25;
! 184: SKIP: {
! 185: if ( defined $options->{cipher} && $options->{cipher} > 0 ) {
! 186: my $crypt = Palm::Keyring::crypts( $options->{cipher} );
! 187: skip 'Crypt::CBC not installed', $Num_Tests_Left
! 188: unless eval "require Crypt::CBC";
! 189: if ($crypt) {
! 190: skip 'Crypt::' . $crypt->{name} . ' not installed',
! 191: $Num_Tests_Left
! 192: unless eval "require Crypt::$crypt->{name}";
! 193: }
! 194: else {
! 195: skip 'Unknown Crypt: ' . $options->{cipher},
! 196: $Num_Tests_Left;
! 197: }
! 198: }
! 199:
! 200: if ( $options->{version} == 4 ) {
! 201: skip 'Crypt::DES not installed', $Num_Tests_Left
! 202: unless eval "require Crypt::DES ";
! 203: skip 'Digest::MD5 not installed', $Num_Tests_Left
! 204: unless eval "require Digest::MD5 ";
! 205: }
! 206: elsif ( $options->{version} == 5 ) {
! 207: skip 'Digest::HMAC_SHA1 not installed', $Num_Tests_Left
! 208: unless eval "require Digest::HMAC_SHA1 ";
! 209: }
! 210:
! 211: my @options = ($options);
! 212: if ( $config_type eq 'cgi-style' ) {
! 213: @options = (
! 214: '-version' => $options->{version},
! 215: '-password' => $options->{password},
! 216: );
! 217: if ( $options->{cipher} ) {
! 218: push @options, '-cipher', $options->{cipher};
! 219: }
! 220: }
! 221: elsif ( $config_type eq 'list' ) {
! 222: @options = ( $options->{password}, $options->{version} );
! 223: if ( $options->{cipher} ) {
! 224: push @options, $options->{cipher};
! 225: }
! 226: }
! 227:
! 228: ok( $pdb = new Palm::Keyring(@options),
! 229: 'new Palm::Keyring v' . $options->{version}
! 230: );
! 231:
! 232: ok( $pdb->Write($file), 'Write "empty" file' );
1.7 andrew 233:
1.20 ! andrew 234: ok( $record = $pdb->append_Record(), 'Append Record' );
1.7 andrew 235:
1.20 ! andrew 236: ok( $pdb->Encrypt( $record, $password, $acct ),
! 237: 'Encrypt account into record' );
1.7 andrew 238:
1.20 ! andrew 239: ok( $pdb->Write($file), 'Write file' );
1.7 andrew 240:
1.20 ! andrew 241: $pdb = undef;
1.7 andrew 242:
1.20 ! andrew 243: ok( $pdb = new Palm::Keyring(), 'new Palm::Keyring' );
1.9 andrew 244:
1.20 ! andrew 245: ok( $pdb->Load($file), 'Load File' );
1.11 andrew 246:
1.20 ! andrew 247: ok( $pdb->Password($password), 'Verify Password' );
1.7 andrew 248:
1.20 ! andrew 249: my $rec_num = 0;
! 250: ok( $decrypted = $pdb->Decrypt( $pdb->{records}->[$rec_num] ),
! 251: 'Decrypt record' );
1.7 andrew 252:
1.20 ! andrew 253: is( $decrypted->{2}->{data}, $password, 'Got password' );
1.7 andrew 254:
1.20 ! andrew 255: is_deeply( $decrypted, $acct, 'Account Matches' );
1.7 andrew 256:
1.20 ! andrew 257: my $old_date = $decrypted->{3}->{data};
1.7 andrew 258:
1.20 ! andrew 259: ok( $pdb->Password( $password, $new_password ),
! 260: 'Change PDB Password' );
1.1 andrew 261:
1.20 ! andrew 262: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
! 263: 'Decrypt with new password' );
1.7 andrew 264:
1.20 ! andrew 265: my $new_date = $decrypted->{3}->{data};
1.7 andrew 266:
1.20 ! andrew 267: is_deeply( $old_date, $new_date, 'Date didn\'t change' );
1.7 andrew 268:
1.20 ! andrew 269: $decrypted->{2}->{data} = $new_password;
1.7 andrew 270:
1.20 ! andrew 271: $pdb->{records}->[$rec_num]->{plaintext} = $decrypted;
1.4 andrew 272:
1.20 ! andrew 273: ok( $pdb->Encrypt( $pdb->{'records'}->[$rec_num] ),
! 274: 'Change record' );
1.4 andrew 275:
1.20 ! andrew 276: ok( $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] ),
! 277: 'Decrypt new record' );
1.15 andrew 278:
1.20 ! andrew 279: $new_date = $decrypted->{3}->{data};
1.7 andrew 280:
1.20 ! andrew 281: my $od = join '/', map { $old_date->{$_} } sort keys %{$old_date};
! 282: my $nd = join '/', map { $new_date->{$_} } sort keys %{$new_date};
1.7 andrew 283:
1.20 ! andrew 284: isnt( $od, $nd, 'Date changed' );
1.4 andrew 285:
1.20 ! andrew 286: is( $decrypted->{2}->{data}, $new_password, 'Got new password' );
1.7 andrew 287:
1.20 ! andrew 288: my $last_decrypted = $decrypted;
1.7 andrew 289:
1.20 ! andrew 290: $decrypted = {};
! 291: ok( $pdb->Password(), 'Forget password' );
1.7 andrew 292:
1.20 ! andrew 293: eval {
! 294: $decrypted = $pdb->Decrypt( $pdb->{'records'}->[$rec_num] );
! 295: };
! 296: ok( $@, 'Don\'t decrypt' );
1.15 andrew 297:
1.20 ! andrew 298: isnt( $decrypted->{password},
! 299: $new_password, 'Didn\'t get new password' );
1.7 andrew 300:
1.20 ! andrew 301: ok( $pdb->Unlock($new_password), 'Unlock' );
1.7 andrew 302:
1.20 ! andrew 303: my @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.4 andrew 304:
1.20 ! andrew 305: is_deeply( $plaintext[0], $last_decrypted, 'Account Matches' );
1.15 andrew 306:
1.20 ! andrew 307: ok( $pdb->Lock(), 'Lock' );
1.15 andrew 308:
1.20 ! andrew 309: my $cleared_decrypted = {};
! 310: $cleared_decrypted->{0} = $last_decrypted->{0};
! 311: @plaintext = map { $_->{plaintext} } @{ $pdb->{records} };
1.15 andrew 312:
1.20 ! andrew 313: is_deeply( $plaintext[0], $cleared_decrypted, 'Cleared records' );
1.15 andrew 314:
1.20 ! andrew 315: $pdb->{records}->[0]->{data} = undef;
! 316: ok( $pdb->Write($file), 'Write file' );
! 317: ok( $pdb->Load($file), 'Load File' );
1.15 andrew 318:
1.20 ! andrew 319: $pdb->{version} = 999;
! 320: eval { $pdb->Write($file) };
! 321: like(
! 322: $@,
! 323: qr/^Unsupported \s Version \s 999/xms,
! 324: 'Couldn\'t Write file with unsupported version'
! 325: );
1.15 andrew 326:
1.20 ! andrew 327: ok( unlink($file), 'Remove test pdb v' . $options->{version} );
1.15 andrew 328:
1.20 ! andrew 329: }
1.11 andrew 330: }
1.8 andrew 331: }
1.1 andrew 332:
333: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>