[BACK]Return to keyring.t CVS log [TXT][DIR] Up to [local] / palm / Palm-Keyring / t

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>