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

Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.30

1.14      andrew      1: package Palm::Keyring;
1.30    ! andrew      2: # $RedRiver: Keyring.pm,v 1.29 2007/02/19 00:22:42 andrew Exp $
1.27      andrew      3: ########################################################################
                      4: # Keyring.pm *** Perl class for Keyring for Palm OS databases.
                      5: #
                      6: #   This started as Memo.pm, I just made it work for Keyring.
1.1       andrew      7: #
1.27      andrew      8: # 2006.01.26 #*#*# andrew fresh <andrew@cpan.org>
                      9: ########################################################################
                     10: # Copyright (C) 2006, 2007 by Andrew Fresh
1.1       andrew     11: #
1.27      andrew     12: # This program is free software; you can redistribute it and/or modify
                     13: # it under the same terms as Perl itself.
                     14: ########################################################################
1.1       andrew     15: use strict;
1.14      andrew     16: use warnings;
1.27      andrew     17:
1.14      andrew     18: use Carp;
1.29      andrew     19: use Data::Dumper;
1.14      andrew     20:
                     21: use base qw/ Palm::StdAppInfo /;
1.1       andrew     22:
1.28      andrew     23: use Digest::HMAC_SHA1 qw(hmac_sha1);
                     24: use Digest::SHA1 qw(sha1);
                     25: use Crypt::CBC;
                     26:
1.1       andrew     27: use Digest::MD5 qw(md5);
1.2       andrew     28: use Crypt::DES;
1.14      andrew     29:
1.24      andrew     30: my $ENCRYPT    = 1;
                     31: my $DECRYPT    = 0;
                     32: my $MD5_CBLOCK = 64;
                     33: my $kSalt_Size = 4;
                     34: my $EMPTY      = q{};
                     35: my $SPACE      = q{ };
                     36: my $NULL       = chr 0;
1.14      andrew     37:
1.28      andrew     38: my @CRYPTS = (
                     39:     { # None
                     40:         name      => 'None',
                     41:         keylen    => 8,
                     42:         blocksize => 1,
1.29      andrew     43:         default_iter => 500,
1.28      andrew     44:     },
                     45:     { # DES-EDE3
                     46:         name      => 'DES_EDE3',
                     47:         keylen    => 24,
                     48:         blocksize =>  8,
                     49:         DES_odd_parity => 1,
1.29      andrew     50:         default_iter => 1000,
1.28      andrew     51:     },
                     52:     { # AES128
                     53:         name      => 'Rijndael',
                     54:         keylen    => 16,
                     55:         blocksize => 16,
1.29      andrew     56:         default_iter => 100,
1.28      andrew     57:     },
                     58:     { # AES256
                     59:         name      => 'Rijndael',
                     60:         keylen    => 32,
                     61:         blocksize => 16,
1.29      andrew     62:         default_iter => 250,
1.28      andrew     63:     },
                     64: );
                     65:
1.1       andrew     66:
1.28      andrew     67: our $VERSION = 0.95;
                     68:
                     69: sub new
                     70: {
1.14      andrew     71:     my $classname = shift;
1.28      andrew     72:     my $options = {};
                     73:
                     74:     # hashref arguments
                     75:     if (ref $_[0] eq 'HASH') {
                     76:       $options = shift;
                     77:     }
                     78:
                     79:     # CGI style arguments
1.29      andrew     80:     elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {
1.28      andrew     81:       my %tmp = @_;
                     82:       while ( my($key,$value) = each %tmp) {
                     83:         $key =~ s/^-//;
                     84:         $options->{lc $key} = $value;
                     85:       }
                     86:     }
                     87:
                     88:     else {
                     89:         $options->{password} = shift;
                     90:         $options->{version}  = shift;
                     91:     }
1.1       andrew     92:
1.14      andrew     93:     # Create a generic PDB. No need to rebless it, though.
1.28      andrew     94:     my $self = $classname->SUPER::new();
1.1       andrew     95:
1.28      andrew     96:     $self->{name}    = 'Keys-Gtkr';    # Default
                     97:     $self->{creator} = 'Gtkr';
                     98:     $self->{type}    = 'Gkyr';
1.14      andrew     99:
                    100:     # The PDB is not a resource database by
                    101:     # default, but it's worth emphasizing,
                    102:     # since MemoDB is explicitly not a PRC.
1.28      andrew    103:     $self->{attributes}{resource} = 0;
1.1       andrew    104:
1.28      andrew    105:     # Set the version
                    106:     $self->{version} = $options->{version} || 4;
1.1       andrew    107:
1.28      andrew    108:     # Set options
                    109:     $self->{options} = $options;
1.1       andrew    110:
1.29      andrew    111:     # Set defaults
                    112:     if ($self->{version} == 5) {
                    113:         $self->{options}->{cipher} ||= 0; # 'None'
                    114:         $self->{options}->{iterations} ||=
                    115:             $CRYPTS[ $self->{options}->{cipher} ]{default_iter};
                    116:
                    117:        $self->{appinfo}->{cipher} ||= $self->{options}->{cipher};
                    118:        $self->{appinfo}->{iter}   ||= $self->{options}->{iterations};
                    119:     };
                    120:
1.28      andrew    121:     if ( defined $options->{password} ) {
                    122:         $self->Password($options->{password});
1.14      andrew    123:     }
1.1       andrew    124:
1.14      andrew    125:     return $self;
                    126: }
1.1       andrew    127:
1.28      andrew    128: sub import
                    129: {
1.14      andrew    130:     Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
                    131:     return 1;
                    132: }
1.1       andrew    133:
1.29      andrew    134: # ParseRecord
1.28      andrew    135:
                    136: sub ParseRecord
                    137: {
1.14      andrew    138:     my $self     = shift;
                    139:
1.16      andrew    140:     my $rec = $self->SUPER::ParseRecord(@_);
1.28      andrew    141:     return $rec if ! exists $rec->{data};
                    142:
                    143:     if ($self->{version} == 4) {
                    144:         # skip the first record because it contains the password.
                    145:         return $rec if ! exists $self->{records};
                    146:
                    147:         my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2;
                    148:
                    149:         return $rec if ! $encrypted;
                    150:         $rec->{name}      = $name;
                    151:         $rec->{encrypted} = $encrypted;
                    152:         delete $rec->{data};
                    153:
                    154:     } elsif ($self->{version} == 5) {
1.29      andrew    155:         my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};
1.28      andrew    156:         my ($field, $extra) = _parse_field($rec->{data});
1.30    ! andrew    157:         my $ivec      = substr $extra, 0, $blocksize;
        !           158:         my $encrypted = substr $extra, $blocksize;
1.16      andrew    159:
1.28      andrew    160:         if ($self->{options}->{v4compatible}) {
                    161:             $rec->{name} = $field->{data};
                    162:         } else {
                    163:             $rec->{name} = $field;
                    164:         }
                    165:         $rec->{ivec}      = $ivec;
                    166:         $rec->{encrypted} = $encrypted;
                    167:
                    168:     } else {
1.29      andrew    169:         die 'Unsupported Version';
1.28      andrew    170:         return;
                    171:     }
1.12      andrew    172:
1.16      andrew    173:     return $rec;
1.14      andrew    174: }
1.11      andrew    175:
1.28      andrew    176: # PackRecord
                    177:
                    178: sub PackRecord
                    179: {
1.16      andrew    180:     my $self = shift;
                    181:     my $rec  = shift;
                    182:
1.28      andrew    183:     if ($self->{version} == 4) {
                    184:         if ($rec->{encrypted}) {
                    185:             if (! defined $rec->{name}) {
                    186:                 $rec->{name} = $EMPTY;
                    187:             }
                    188:             $rec->{data} = join $NULL, $rec->{name}, $rec->{encrypted};
                    189:             delete $rec->{name};
                    190:             delete $rec->{encrypted};
                    191:         }
1.29      andrew    192:
1.28      andrew    193:     } elsif ($self->{version} == 5) {
1.29      andrew    194:         my $field;
                    195:         if ($rec->{name}) {
                    196:             if ($self->{options}->{v4compatible}) {
                    197:                 $field = {
                    198:                     label    => 'name',
                    199:                     font     => 0,
                    200:                     data     => $rec->{'name'},
                    201:                 };
                    202:             } else {
                    203:                 $field = $rec->{name};
                    204:             }
                    205:         }
                    206:         my $packed = '';
                    207:         if ($field) {
                    208:             $packed = _pack_field($field);
                    209:         }
                    210:         my $len = length $packed;
                    211:         my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};
                    212:
1.30    ! andrew    213:         $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};
1.29      andrew    214:
1.28      andrew    215:     } else {
1.29      andrew    216:         die 'Unsupported Version';
1.16      andrew    217:     }
1.1       andrew    218:
1.16      andrew    219:     return $self->SUPER::PackRecord($rec, @_);
1.14      andrew    220: }
1.1       andrew    221:
1.28      andrew    222: # ParseAppInfoBlock
                    223:
                    224: sub ParseAppInfoBlock
                    225: {
                    226:     my $self = shift;
                    227:     my $data = shift;
                    228:     my $appinfo = {};
                    229:
                    230:     &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);
                    231:
                    232:     # int8/uint8
                    233:     # - Signed or Unsigned Byte (8 bits). C types: char, unsigned char
                    234:     # int16/uint16
                    235:     # - Signed or Unsigned Word (16 bits). C types: short, unsigned short
                    236:     # int32/uint32
                    237:     # - Signed or Unsigned Doubleword (32 bits). C types: int, unsigned int
                    238:     # sz
                    239:     # - Zero-terminated C-style string
                    240:
                    241:     if ($self->{version} == 4) {
                    242:         # Nothing extra for version 4
                    243:
                    244:     } elsif ($self->{version} == 5) {
                    245:         _parse_appinfo_v5($appinfo) || return;
                    246:
                    247:     } else {
1.29      andrew    248:         die "Unsupported Version";
1.28      andrew    249:         return;
                    250:     }
                    251:
                    252:     return $appinfo;
                    253: }
                    254:
                    255: sub _parse_appinfo_v5
                    256: {
                    257:     my $appinfo = shift;
                    258:
                    259:     if (! exists $appinfo->{other}) {
                    260:         # XXX Corrupt appinfo?
                    261:         return;
                    262:     }
                    263:
                    264:     my $unpackstr
                    265:         = ("C1" x 8)  # 8 uint8s in an array for the salt
                    266:         . ("S1" x 2)  # the iter (uint16) and the cipher (uint16)
                    267:         . ("C1" x 8); # and finally 8 more uint8s for the hash
                    268:
                    269:     my (@salt, $iter, $cipher, @hash);
                    270:     (@salt[0..7], $iter, $cipher, @hash[0..7])
                    271:         = unpack $unpackstr, $appinfo->{other};
                    272:
                    273:     $appinfo->{salt}           = sprintf "%02x" x 8, @salt;
                    274:     $appinfo->{iter}           = $iter;
                    275:     $appinfo->{cipher}         = $cipher;
                    276:     $appinfo->{masterhash}     = sprintf "%02x" x 8, @hash;
                    277:     delete $appinfo->{other};
                    278:
                    279:     return $appinfo
                    280: }
                    281:
                    282: # PackAppInfoBlock
                    283:
                    284: sub PackAppInfoBlock
                    285: {
                    286:     my $self = shift;
                    287:     my $retval;
                    288:
                    289:     if ($self->{version} == 4) {
                    290:         # Nothing to do for v4
                    291:
                    292:     } elsif ($self->{version} == 5) {
1.29      andrew    293:         _pack_appinfo_v5($self->{appinfo});
1.28      andrew    294:     } else {
1.29      andrew    295:         die "Unsupported Version";
1.28      andrew    296:         return;
                    297:     }
                    298:     return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
                    299: }
                    300:
1.29      andrew    301: sub _pack_appinfo_v5
                    302: {
                    303:     my $appinfo = shift;
                    304:
                    305:     my $packstr
                    306:         = ("C1" x 8)  # 8 uint8s in an array for the salt
                    307:         . ("S1" x 2)  # the iter (uint16) and the cipher (uint16)
                    308:         . ("C1" x 8); # and finally 8 more uint8s for the hash
                    309:
                    310:     my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm;
                    311:     my @hash = map { hex $_ } $appinfo->{masterhash} =~ /../gxm;
                    312:
                    313:     my $packed = pack($packstr,
                    314:         @salt,
                    315:         $appinfo->{iter},
                    316:         $appinfo->{cipher},
                    317:         @hash
                    318:     );
                    319:
                    320:     $appinfo->{other}  = $packed;
                    321:
                    322:     return $appinfo
                    323: }
                    324:
1.28      andrew    325: # Encrypt
                    326:
                    327: sub Encrypt
                    328: {
1.14      andrew    329:     my $self = shift;
1.16      andrew    330:     my $rec  = shift;
                    331:     my $data = shift;
1.28      andrew    332:     my $pass = shift || $self->{password};
1.16      andrew    333:
1.29      andrew    334:     if ( ! $pass && ! $self->{appinfo}->{key}) {
1.28      andrew    335:         croak("password not set!\n");
1.16      andrew    336:     }
                    337:
                    338:     if ( ! $rec) {
                    339:         croak("Needed parameter 'record' not passed!\n");
                    340:     }
1.14      andrew    341:
1.16      andrew    342:     if ( ! $data) {
                    343:         croak("Needed parameter 'data' not passed!\n");
1.14      andrew    344:     }
                    345:
1.29      andrew    346:     if ( $pass && ! $self->Password($pass)) {
1.16      andrew    347:         croak("Incorrect Password!\n");
                    348:     }
1.14      andrew    349:
1.29      andrew    350:     my $acct;
                    351:     if ($rec->{encrypted}) {
                    352:         $acct = $self->Decrypt($rec, $pass);
                    353:     }
                    354:
                    355:     my $encrypted;
1.28      andrew    356:     if ($self->{version} == 4) {
                    357:         $self->{digest} ||= _calc_keys( $pass );
1.29      andrew    358:         $encrypted = _encrypt_v4($data, $acct, $self->{digest});
                    359:         $rec->{name}    ||= $data->{name};
                    360:
                    361:     } elsif ($self->{version} == 5) {
                    362:         my @recs = ($data, $acct);
                    363:         my $name;
                    364:         if ($self->{options}->{v4compatible}) {
                    365:             $rec->{name} ||= $data->{name};
                    366:             foreach my $rec (@recs) {
                    367:                 my @fields;
                    368:                 foreach my $k (sort keys %{ $rec }) {
                    369:                     my $field = {
                    370:                         label    => $k,
                    371:                         font     => 0,
                    372:                         data     => $rec->{$k},
                    373:                     };
                    374:                     push @fields, $field;
                    375:                 }
                    376:                 $rec = \@fields;
                    377:             }
                    378:         }
                    379:
                    380:         my $ivec;
                    381:         ($encrypted, $ivec) = _encrypt_v5(
                    382:             @recs,
                    383:             $self->{appinfo}->{key},
                    384:             $self->{appinfo}->{cipher},
                    385:         );
                    386:         if ($ivec) {
                    387:             $rec->{ivec} = $ivec;
1.28      andrew    388:         }
1.29      andrew    389:
                    390:     } else {
                    391:         die "Unsupported Version";
                    392:     }
                    393:
                    394:     if ($encrypted) {
                    395:         if ($encrypted eq '1') {
1.28      andrew    396:             return 1;
                    397:         }
1.29      andrew    398:
                    399:         $rec->{attributes}{Dirty} = 1;
                    400:         $rec->{attributes}{dirty} = 1;
                    401:         $rec->{encrypted} = $encrypted;
                    402:
                    403:         return 1;
1.28      andrew    404:     } else {
1.29      andrew    405:         return;
1.28      andrew    406:     }
                    407: }
1.14      andrew    408:
1.28      andrew    409: sub _encrypt_v4
                    410: {
1.29      andrew    411:     my $new    = shift;
                    412:     my $old    = shift;
1.28      andrew    413:     my $digest = shift;
                    414:
1.29      andrew    415:     $new->{account}  ||= $EMPTY;
                    416:     $new->{password} ||= $EMPTY;
                    417:     $new->{notes}    ||= $EMPTY;
1.1       andrew    418:
1.22      andrew    419:     my $changed      = 0;
                    420:     my $need_newdate = 0;
1.29      andrew    421:     if ($old && %{ $old }) {
                    422:         foreach my $key (keys %{ $new }) {
1.22      andrew    423:             next if $key eq 'lastchange';
1.29      andrew    424:             if ($new->{$key} ne $old->{$key}) {
1.22      andrew    425:                 $changed = 1;
                    426:                 last;
                    427:             }
                    428:         }
1.29      andrew    429:         if ( exists $new->{lastchange} && exists $old->{lastchange} && (
                    430:             $new->{lastchange}->{day}   != $old->{lastchange}->{day}   ||
                    431:             $new->{lastchange}->{month} != $old->{lastchange}->{month} ||
                    432:             $new->{lastchange}->{year}  != $old->{lastchange}->{year}
1.22      andrew    433:         )) {
                    434:             $changed = 1;
                    435:             $need_newdate = 0;
                    436:         } else {
                    437:             $need_newdate = 1;
                    438:         }
                    439:
                    440:     } else {
                    441:         $changed = 1;
                    442:     }
                    443:
                    444:     # no need to re-encrypt if it has not changed.
                    445:     return 1 if ! $changed;
                    446:
1.21      andrew    447:     my ($day, $month, $year);
                    448:
1.29      andrew    449:     if ($new->{lastchange} && ! $need_newdate ) {
                    450:         $day   = $new->{lastchange}->{day}   || 1;
                    451:         $month = $new->{lastchange}->{month} || 0;
                    452:         $year  = $new->{lastchange}->{year}  || 0;
1.22      andrew    453:
                    454:         # XXX Need to actually validate the above information somehow
                    455:         if ($year >= 1900) {
                    456:             $year -= 1900;
                    457:         }
                    458:     } else {
                    459:         $need_newdate = 1;
                    460:     }
                    461:
                    462:     if ($need_newdate) {
1.21      andrew    463:         ($day, $month, $year) = (localtime)[3,4,5];
                    464:     }
1.22      andrew    465:
1.29      andrew    466:     my $packed_date = _pack_keyring_date( {
1.28      andrew    467:             year  => $year,
                    468:             month => $month,
                    469:             day   => $day,
                    470:     });
1.19      andrew    471:
1.16      andrew    472:     my $plaintext = join $NULL,
1.29      andrew    473:         $new->{account}, $new->{password}, $new->{notes}, $packed_date;
1.1       andrew    474:
1.28      andrew    475:     return _crypt3des( $plaintext, $digest, $ENCRYPT );
                    476: }
1.11      andrew    477:
1.29      andrew    478: sub _encrypt_v5
                    479: {
                    480:     my $new    = shift;
                    481:     my $old    = shift;
                    482:     my $key    = shift;
                    483:     my $cipher = shift;
1.30    ! andrew    484:     my $length = $CRYPTS[ $cipher ]{blocksize};
        !           485:     my $ivec   = shift || pack("C*",map {rand(256)} 1..$length);
1.29      andrew    486:
                    487:     my $keylen      = $CRYPTS[ $cipher ]{keylen};
                    488:     my $cipher_name = $CRYPTS[ $cipher ]{name};
                    489:
                    490:     my $changed = 0;
                    491:     my $need_newdate = 1;
                    492:     my $date_index;
                    493:     for (my $i = 0; $i < @{ $new }; $i++) {
                    494:         if (
                    495:             (exists $new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) ||
                    496:             (exists $new->[$i]->{label}    && $new->[$i]->{label}    eq 'lastchange')
                    497:         ) {
                    498:             $date_index   = $i;
                    499:             if ( $old && $#{ $new } == $#{ $old } && (
                    500:                     $new->[$i]->{data}->{day}   != $old->[$i]->{data}->{day}   ||
                    501:                     $new->[$i]->{data}->{month} != $old->[$i]->{data}->{month} ||
                    502:                     $new->[$i]->{data}->{year}  != $old->[$i]->{data}->{year}
                    503:                 )) {
                    504:                 $changed      = 1;
                    505:                 $need_newdate = 0;
                    506:                 last;
                    507:             }
                    508:
                    509:         } elsif ($old && $#{ $new } == $#{ $old }) {
                    510:             my $n = join ':', %{ $new->[$i] };
                    511:             my $o = join ':', %{ $old->[$i] };
                    512:             if ($n ne $o) {
                    513:                 $changed = 1;
                    514:             }
                    515:         } elsif ($#{ $new } != $#{ $old }) {
                    516:             $changed = 1;
                    517:         }
                    518:     }
                    519:     if ($old && (! @{ $old }) && $date_index) {
                    520:         $need_newdate = 0;
                    521:     }
                    522:
                    523:     return 1, 0 if $changed == 0;
                    524:
                    525:     if ($need_newdate || ! defined $date_index) {
                    526:         my ($day, $month, $year) = (localtime)[3,4,5];
                    527:         my $date = {
                    528:             year  => $year,
                    529:             month => $month,
                    530:             day   => $day,
                    531:         };
                    532:         if (defined $date_index) {
                    533:             $new->[$date_index]->{data} = $date;
                    534:         } else {
                    535:             push @{ $new }, {
                    536:                 label => 'lastchange',
                    537:                 font  => 0,
                    538:                 data  => $date,
                    539:             };
                    540:         }
                    541:     } else {
                    542:         # XXX Need to actually validate the above information somehow
                    543:         if ($new->[$date_index]->{data}->{year} >= 1900) {
                    544:             $new->[$date_index]->{data}->{year} -= 1900;
                    545:         }
                    546:     }
                    547:
                    548:     my $decrypted;
                    549:     foreach my $field (@{ $new }) {
                    550:         $decrypted .= _pack_field($field);
                    551:     }
                    552:
                    553:     my $encrypted;
                    554:     if ($cipher_name eq 'None') {
                    555:         # do nothing
                    556:         $encrypted = $decrypted;
                    557:
                    558:     } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {
                    559:         my $c = Crypt::CBC->new(
                    560:             -literal_key => 1,
                    561:             -key         => $key,
                    562:             -iv          => $ivec,
                    563:             -cipher      => $cipher_name,
                    564:             -keysize     => $keylen,
                    565:             -header      => 'none',
                    566:             -padding     => 'oneandzeroes',
                    567:         );
                    568:
                    569:         if (! $c) {
                    570:             croak("Unable to set up encryption!");
                    571:         }
                    572:
                    573:         $encrypted = $c->encrypt($decrypted);
                    574:
                    575:     } else {
                    576:         die "Unsupported Version";
                    577:     }
                    578:
                    579:     return $encrypted, $ivec;
                    580: }
                    581:
1.28      andrew    582: # Decrypt
1.1       andrew    583:
1.28      andrew    584: sub Decrypt
                    585: {
1.14      andrew    586:     my $self = shift;
1.16      andrew    587:     my $rec  = shift;
1.28      andrew    588:     my $pass = shift || $self->{password};
1.16      andrew    589:
1.29      andrew    590:     if ( ! $pass && ! $self->{appinfo}->{key}) {
1.28      andrew    591:         croak("password not set!\n");
1.16      andrew    592:     }
                    593:
                    594:     if ( ! $rec) {
1.19      andrew    595:         croak("Needed parameter 'record' not passed!\n");
1.16      andrew    596:     }
1.14      andrew    597:
1.30    ! andrew    598:     if ( $pass && ! $self->Password($pass)) {
1.16      andrew    599:         croak("Invalid Password!\n");
1.14      andrew    600:     }
                    601:
1.28      andrew    602:     if ( ! $rec->{encrypted} ) {
1.16      andrew    603:         croak("No encrypted content!");
                    604:     }
1.14      andrew    605:
1.28      andrew    606:     if ($self->{version} == 4) {
                    607:         $self->{digest} ||= _calc_keys( $pass );
                    608:         my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
                    609:         $acct->{name} ||= $rec->{name};
                    610:         return $acct;
1.29      andrew    611:
1.28      andrew    612:     } elsif ($self->{version} == 5) {
                    613:         my $fields = _decrypt_v5(
1.29      andrew    614:             $rec->{encrypted}, $self->{appinfo}->{key},
                    615:             $self->{appinfo}->{cipher}, $rec->{ivec},
1.28      andrew    616:         );
                    617:         if ($self->{options}->{v4compatible}) {
                    618:             my %acct;
                    619:             foreach my $f (@{ $fields }) {
                    620:                 $acct{ $f->{label} } = $f->{data};
                    621:             }
                    622:             $acct{name} ||= $rec->{name};
                    623:             return \%acct;
                    624:         } else {
                    625:             return $fields;
                    626:         }
1.29      andrew    627:
1.28      andrew    628:     } else {
1.29      andrew    629:         die "Unsupported Version";
1.28      andrew    630:     }
                    631:     return;
                    632: }
1.14      andrew    633:
1.28      andrew    634: sub _decrypt_v4
                    635: {
                    636:     my $encrypted = shift;
                    637:     my $digest    = shift;
                    638:
                    639:     my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );
1.29      andrew    640:     my ( $account, $password, $notes, $packed_date )
1.28      andrew    641:         = split /$NULL/xm, $decrypted, 4;
1.14      andrew    642:
1.28      andrew    643:     my $modified;
1.29      andrew    644:     if ($packed_date) {
                    645:         $modified = _parse_keyring_date($packed_date);
1.19      andrew    646:     }
                    647:
1.16      andrew    648:     return {
1.20      andrew    649:         account    => $account,
                    650:         password   => $password,
                    651:         notes      => $notes,
1.28      andrew    652:         lastchange => $modified,
1.16      andrew    653:     };
                    654: }
1.14      andrew    655:
1.28      andrew    656: sub _decrypt_v5
                    657: {
                    658:     my $encrypted = shift;
                    659:     my $key       = shift;
                    660:     my $cipher    = shift;
1.29      andrew    661:     my $ivec      = shift;
                    662:
                    663:     my $keylen       = $CRYPTS[ $cipher ]{keylen};
                    664:     my $cipher_name  = $CRYPTS[ $cipher ]{name};
1.28      andrew    665:
                    666:     my $decrypted;
                    667:
1.29      andrew    668:     if ($cipher_name eq 'None') {
1.28      andrew    669:         # do nothing
                    670:         $decrypted = $encrypted;
                    671:
1.29      andrew    672:     } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {
                    673:         my $c = Crypt::CBC->new(
                    674:             -literal_key => 1,
                    675:             -key         => $key,
                    676:             -iv          => $ivec,
                    677:             -cipher      => $cipher_name,
                    678:             -keysize     => $keylen,
                    679:             -header      => 'none',
                    680:             -padding     => 'oneandzeroes',
                    681:         );
                    682:
1.28      andrew    683:         if (! $c) {
                    684:             croak("Unable to set up encryption!");
                    685:         }
                    686:         $encrypted .= $NULL x $keylen; # pad out a keylen
                    687:         $decrypted  = $c->decrypt($encrypted);
                    688:
                    689:     } else {
1.29      andrew    690:         die "Unsupported Version";
1.28      andrew    691:         return;
                    692:     }
                    693:
                    694:     my @fields;
                    695:     while ($decrypted) {
                    696:         my $field;
                    697:         ($field, $decrypted) = _parse_field($decrypted);
                    698:         if (! $field) {
                    699:             last;
                    700:         }
                    701:         push @fields, $field;
                    702:     }
                    703:
                    704:     return \@fields;
                    705: }
                    706:
                    707: # Password
                    708:
                    709: sub Password
                    710: {
1.16      andrew    711:     my $self = shift;
1.24      andrew    712:     my $pass = shift;
1.16      andrew    713:     my $new_pass = shift;
1.14      andrew    714:
1.24      andrew    715:     if (! $pass) {
                    716:         delete $self->{password};
1.30    ! andrew    717:         delete $self->{appinfo}->{key};
1.28      andrew    718:         return 1;
1.24      andrew    719:     }
                    720:
1.29      andrew    721:     if (
                    722:         ($self->{version} == 4 && ! exists $self->{records}) ||
                    723:         ($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash})
                    724:     ) {
                    725:         if ($self->{version} == 4) {
                    726:             # Give the PDB the first record that will hold the encrypted password
                    727:             $self->{records} = [ $self->new_Record ];
                    728:         }
1.16      andrew    729:
                    730:         return $self->_password_update($pass);
                    731:     }
                    732:
                    733:     if ($new_pass) {
1.29      andrew    734:         my $v4compat = $self->{options}->{v4compatible};
                    735:         $self->{options}->{v4compatible} = 0;
                    736:
1.16      andrew    737:         my @accts = ();
1.28      andrew    738:         foreach my $i (0..$#{ $self->{records} }) {
1.29      andrew    739:             if ($self->{version} == 4 && $i == 0) {
1.16      andrew    740:                 push @accts, undef;
                    741:                 next;
                    742:             }
1.28      andrew    743:             my $acct = $self->Decrypt($self->{records}->[$i], $pass);
1.16      andrew    744:             if ( ! $acct ) {
1.28      andrew    745:                 croak("Couldn't decrypt $self->{records}->[$i]->{name}");
1.16      andrew    746:             }
                    747:             push @accts, $acct;
                    748:         }
1.14      andrew    749:
1.16      andrew    750:         if ( ! $self->_password_update($new_pass)) {
                    751:             croak("Couldn't set new password!");
                    752:         }
                    753:         $pass = $new_pass;
1.1       andrew    754:
1.16      andrew    755:         foreach my $i (0..$#accts) {
1.29      andrew    756:             if ($self->{version} == 4 && $i == 0) {
                    757:                 next;
                    758:             }
1.28      andrew    759:             delete $self->{records}->[$i]->{encrypted};
                    760:             $self->Encrypt($self->{records}->[$i], $accts[$i], $pass);
1.16      andrew    761:         }
1.29      andrew    762:
                    763:         $self->{options}->{v4compatible} = $v4compat;
1.14      andrew    764:     }
1.1       andrew    765:
1.28      andrew    766:     if (defined $self->{password} && $pass eq $self->{password}) {
                    767:         # already verified this password
                    768:         return 1;
                    769:     }
                    770:
                    771:     if ($self->{version} == 4) {
                    772:         # AFAIK the thing we use to test the password is
                    773:         #     always in the first entry
                    774:         my $valid = _password_verify_v4($pass, $self->{records}->[0]->{data});
                    775:
1.29      andrew    776:         # May as well generate the keys we need now, since we know the password is right
1.28      andrew    777:         if ($valid) {
                    778:             $self->{digest} = _calc_keys($pass);
                    779:             if ($self->{digest} ) {
                    780:                 $self->{password} = $pass;
                    781:                 return 1;
                    782:             }
                    783:         }
                    784:     } elsif ($self->{version} == 5) {
1.29      andrew    785:         return _password_verify_v5($pass, $self->{appinfo});
1.28      andrew    786:     } else {
                    787:         # XXX unsupported version
                    788:     }
                    789:
                    790:     return;
                    791: }
                    792:
                    793: sub _password_verify_v4
                    794: {
                    795:     my $pass = shift;
                    796:     my $data = shift;
                    797:
                    798:     if (! $pass) { croak('No password specified!'); };
                    799:
                    800:     # XXX die "No encrypted password in file!" unless defined $data;
                    801:     if ( ! defined $data) { return; };
                    802:
                    803:     $data =~ s/$NULL$//xm;
                    804:
                    805:     my $salt = substr $data, 0, $kSalt_Size;
                    806:
                    807:     my $msg = $salt . $pass;
                    808:     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
                    809:
                    810:     my $digest = md5($msg);
                    811:
                    812:     if (! $data eq $salt . $digest ) {
                    813:         return;
                    814:     }
                    815:
                    816:     return 1;
                    817: }
                    818:
                    819: sub _password_verify_v5
                    820: {
                    821:     my $pass    = shift;
                    822:     my $appinfo = shift;
                    823:
                    824:     my $salt = pack("H*", $appinfo->{salt});
                    825:
1.29      andrew    826:     my ($key, $hash) = _calc_key_v5(
                    827:         $pass, $salt, $appinfo->{iter},
                    828:         $CRYPTS[ $appinfo->{cipher} ]{keylen},
                    829:         $CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity},
1.28      andrew    830:     );
                    831:
                    832:     #print "Key:  '". unpack("H*", $key) . "'\n";
1.29      andrew    833:     #print "Hash: '". $hash . "'\n";
1.28      andrew    834:     #print "Hash: '". $appinfo->{masterhash} . "'\n";
                    835:
1.29      andrew    836:     if ($appinfo->{masterhash} eq $hash) {
1.28      andrew    837:         $appinfo->{key} = $key;
                    838:     } else {
                    839:         return;
                    840:     }
1.29      andrew    841:
                    842:     return $key;
                    843: }
                    844:
                    845:
                    846: sub _password_update
                    847: {
                    848:     # It is very important to Encrypt after calling this
                    849:     #     (Although it is generally only called by Encrypt)
                    850:     # because otherwise the data will be out of sync with the
                    851:     # password, and that would suck!
                    852:     my $self   = shift;
                    853:     my $pass   = shift;
                    854:
                    855:     if ($self->{version} == 4) {
                    856:         my $data = _password_update_v4($pass, @_);
                    857:
                    858:         if (! $data) {
                    859:             carp("Failed  to update password!");
                    860:             return;
                    861:         }
                    862:
                    863:         # AFAIK the thing we use to test the password is
                    864:         #     always in the first entry
                    865:         $self->{records}->[0]->{data} = $data;
                    866:         $self->{password} = $pass;
                    867:         $self->{digest}   = _calc_keys( $self->{password} );
                    868:
                    869:         return 1;
                    870:
                    871:     } elsif ($self->{version} == 5) {
                    872:         my $cipher  = shift || $self->{appinfo}->{cipher};
                    873:         my $iter    = shift || $self->{appinfo}->{iter};
                    874:         my $salt    = shift || 0;
                    875:
                    876:         my $hash = _password_update_v5(
                    877:             $self->{appinfo}, $pass, $cipher, $iter, $salt
                    878:         );
                    879:
                    880:         if (! $hash) {
                    881:             carp("Failed  to update password!");
                    882:             return;
                    883:         }
                    884:
                    885:         return 1;
                    886:     } else {
                    887:         croak("Unsupported version ($self->{version})");
                    888:     }
                    889:
                    890:     return;
                    891: }
                    892:
                    893: sub _password_update_v4
                    894: {
                    895:     my $pass = shift;
                    896:
                    897:     if (! defined $pass) { croak('No password specified!'); };
                    898:
                    899:     my $salt;
                    900:     for ( 1 .. $kSalt_Size ) {
                    901:         $salt .= chr int rand 255;
                    902:     }
                    903:
                    904:     my $msg = $salt . $pass;
                    905:
                    906:     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
                    907:
                    908:     my $digest = md5($msg);
                    909:
                    910:     my $data = $salt . $digest;    # . "\0";
                    911:
                    912:     return $data;
                    913: }
                    914:
                    915: sub _password_update_v5
                    916: {
                    917:     my $appinfo = shift;
                    918:     my $pass    = shift;
                    919:     my $cipher  = shift;
                    920:     my $iter    = shift;
                    921:
                    922:     # I thought this needed to be 'blocksize', but apparently not.
                    923:     #my $length  = $CRYPTS[ $cipher ]{blocksize};
                    924:     my $length  = 8;
                    925:     my $salt    = shift || pack("C*",map {rand(256)} 1..$length);
                    926:
                    927:     my ($key, $hash) = _calc_key_v5(
                    928:         $pass, $salt, $iter,
                    929:         $CRYPTS[ $cipher ]->{keylen},
                    930:         $CRYPTS[ $cipher ]->{DES_odd_parity},
                    931:     );
                    932:
                    933:     $appinfo->{salt}           = unpack "H*", $salt;
                    934:     $appinfo->{iter}           = $iter;
                    935:     $appinfo->{cipher}         = $cipher;
                    936:
                    937:     $appinfo->{key}            = $key;
                    938:     $appinfo->{masterhash}     = $hash;
                    939:
1.28      andrew    940:     return $key;
1.1       andrew    941: }
                    942:
1.28      andrew    943:
                    944: sub _calc_keys
                    945: {
1.14      andrew    946:     my $pass = shift;
                    947:     if (! defined $pass) { croak('No password defined!'); };
                    948:
                    949:     my $digest = md5($pass);
                    950:
                    951:     my ( $key1, $key2 ) = unpack 'a8a8', $digest;
                    952:
                    953:     #--------------------------------------------------
                    954:     # print "key1: $key1: ", length $key1, "\n";
                    955:     # print "key2: $key2: ", length $key2, "\n";
                    956:     #--------------------------------------------------
                    957:
                    958:     $digest = unpack 'H*', $key1 . $key2 . $key1;
                    959:
                    960:     #--------------------------------------------------
                    961:     # print "Digest: ", $digest, "\n";
                    962:     # print length $digest, "\n";
                    963:     #--------------------------------------------------
                    964:
                    965:     return $digest;
1.3       andrew    966: }
                    967:
1.29      andrew    968: sub _calc_key_v5
                    969: {
                    970:     my ($pass, $salt, $iter, $keylen, $dop) = @_;
                    971:
                    972:     my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );
                    973:     if ($dop) { $key = DES_odd_parity($key); }
                    974:
                    975:     my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
                    976:
                    977:     return $key, $hash;
                    978: }
                    979:
1.28      andrew    980: sub _crypt3des
                    981: {
                    982:     my ( $plaintext, $passphrase, $flag ) = @_;
                    983:
                    984:     $passphrase   .= $SPACE x ( 16 * 3 );
                    985:     my $cyphertext = $EMPTY;
                    986:
                    987:     my $size = length $plaintext;
1.14      andrew    988:
1.28      andrew    989:     #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
1.11      andrew    990:
1.28      andrew    991:     my @C;
                    992:     for ( 0 .. 2 ) {
                    993:         $C[$_] =
                    994:           new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
1.16      andrew    995:     }
                    996:
1.28      andrew    997:     for ( 0 .. ( ($size) / 8 ) ) {
                    998:         my $pt = substr $plaintext, $_ * 8, 8;
                    999:
                   1000:         #print "PT: '$pt' - Length: " . length($pt) . "\n";
                   1001:         if (! length $pt) { next; };
                   1002:         if ( (length $pt) < 8 ) {
                   1003:             if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
                   1004:             my $len = 8 - (length $pt);
                   1005:             $pt .= ($NULL x $len);
                   1006:         }
                   1007:         if ( $flag == $ENCRYPT ) {
                   1008:             $pt = $C[0]->encrypt($pt);
                   1009:             $pt = $C[1]->decrypt($pt);
                   1010:             $pt = $C[2]->encrypt($pt);
                   1011:         }
                   1012:         else {
                   1013:             $pt = $C[0]->decrypt($pt);
                   1014:             $pt = $C[1]->encrypt($pt);
                   1015:             $pt = $C[2]->decrypt($pt);
                   1016:         }
                   1017:
                   1018:         #print "PT: '$pt' - Length: " . length($pt) . "\n";
                   1019:         $cyphertext .= $pt;
                   1020:     }
1.11      andrew   1021:
1.28      andrew   1022:     $cyphertext =~ s/$NULL+$//xm;
1.11      andrew   1023:
1.28      andrew   1024:     #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11      andrew   1025:
1.28      andrew   1026:     return $cyphertext;
                   1027: }
1.11      andrew   1028:
1.28      andrew   1029: sub _parse_field
                   1030: {
                   1031:     my $field = shift;
                   1032:
                   1033:     my @labels;
                   1034:     $labels[0]   = 'name';
                   1035:     $labels[1]   = 'account';
                   1036:     $labels[2]   = 'password';
                   1037:     $labels[3]   = 'lastchange';
                   1038:     $labels[255] = 'notes';
                   1039:
                   1040:     my ($len) = unpack "S1", $field;
                   1041:     if ($len + 4 > length $field) {
                   1042:         return undef, $field;
                   1043:     }
                   1044:     my $unpackstr = "S1 C1 C1 A$len";
1.30    ! andrew   1045:     if ($len % 2 && $len + 4 < length $field) {
1.28      andrew   1046:         # trim the 0/1 byte padding for next even address.
                   1047:         $unpackstr .= ' x'
                   1048:     }
                   1049:     $unpackstr .= ' A*';
1.11      andrew   1050:
1.28      andrew   1051:     my (undef, $label, $font, $data, $leftover)
                   1052:         = unpack $unpackstr, $field;
1.11      andrew   1053:
1.28      andrew   1054:     if ($label == 3) {
                   1055:         $data = _parse_keyring_date($data);
1.14      andrew   1056:     }
1.28      andrew   1057:     return {
                   1058:         #len      => $len,
                   1059:         label    => $labels[ $label ] || $label,
                   1060:         label_id => $label,
                   1061:         font     => $font,
                   1062:         data     => $data,
                   1063:     }, $leftover;
1.6       andrew   1064: }
                   1065:
1.29      andrew   1066: sub _pack_field
                   1067: {
                   1068:     my $field = shift;
1.28      andrew   1069:
1.29      andrew   1070:     my %labels = (
                   1071:         name       =>   0,
                   1072:         account    =>   1,
                   1073:         password   =>   2,
                   1074:         lastchange =>   3,
                   1075:         notes      => 255,
                   1076:     );
1.14      andrew   1077:
1.29      andrew   1078:     my $label = $field->{label_id} || $labels{ $field->{label} };
                   1079:     my $font  = $field->{font}     || 0;
                   1080:     my $data  = $field->{data}     || '';
1.14      andrew   1081:
1.29      andrew   1082:     if ($label == 3) {
                   1083:         $data = _pack_keyring_date($data);
                   1084:     }
                   1085:     my $len = length $data;
                   1086:     my $packstr = "S1 C1 C1 A*";
1.28      andrew   1087:
1.29      andrew   1088:     my $packed = pack $packstr, ($len, $label, $font, $data);
1.14      andrew   1089:
1.29      andrew   1090:     if ($len % 2) {
                   1091:         # add byte padding for next even address.
                   1092:         $packed .= $NULL;
1.14      andrew   1093:     }
                   1094:
1.29      andrew   1095:     return $packed;
                   1096: }
1.11      andrew   1097:
1.29      andrew   1098: sub _parse_keyring_date
                   1099: {
                   1100:     my $data = shift;
1.11      andrew   1101:
1.29      andrew   1102:     my $u = unpack 'n', $data;
                   1103:     my $year  = (($u & 0xFE00) >> 9) + 4; # since 1900
                   1104:     my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
                   1105:     my $day   = (($u & 0x001F) >> 0);     # 1-31
1.11      andrew   1106:
1.29      andrew   1107:     return {
                   1108:         year   => $year,
                   1109:         month  => $month || 0,
                   1110:         day    => $day   || 1,
                   1111:     };
                   1112: }
1.11      andrew   1113:
1.29      andrew   1114: sub _pack_keyring_date
                   1115: {
                   1116:     my $d = shift;
                   1117:     my $year  = $d->{year};
                   1118:     my $month = $d->{month};
                   1119:     my $day   = $d->{day};
1.11      andrew   1120:
1.29      andrew   1121:     $year -= 4;
                   1122:     $month++;
1.11      andrew   1123:
1.29      andrew   1124:     return pack 'n', $day | ($month << 5) | ($year << 9);
1.1       andrew   1125: }
1.29      andrew   1126:
1.1       andrew   1127:
1.28      andrew   1128: sub _hexdump
                   1129: {
                   1130:     my $prefix = shift;   # What to print in front of each line
                   1131:     my $data = shift;     # The data to dump
                   1132:     my $maxlines = shift; # Max # of lines to dump
                   1133:     my $offset;           # Offset of current chunk
                   1134:
                   1135:     for ($offset = 0; $offset < length($data); $offset += 16)
                   1136:     {
                   1137:         my $hex;   # Hex values of the data
                   1138:         my $ascii; # ASCII values of the data
                   1139:         my $chunk; # Current chunk of data
                   1140:
                   1141:         last if defined($maxlines) && ($offset >= ($maxlines * 16));
1.14      andrew   1142:
1.28      andrew   1143:         $chunk = substr($data, $offset, 16);
1.14      andrew   1144:
1.28      andrew   1145:         ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;
1.11      andrew   1146:
1.28      andrew   1147:         ($ascii = $chunk) =~ y/\040-\176/./c;
1.14      andrew   1148:
1.28      andrew   1149:         printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
1.14      andrew   1150:     }
1.28      andrew   1151: }
                   1152:
                   1153: sub _bindump
                   1154: {
                   1155:     my $prefix = shift;   # What to print in front of each line
                   1156:     my $data = shift;     # The data to dump
                   1157:     my $maxlines = shift; # Max # of lines to dump
                   1158:     my $offset;           # Offset of current chunk
                   1159:
                   1160:     for ($offset = 0; $offset < length($data); $offset += 8)
                   1161:     {
                   1162:         my $bin;   # binary values of the data
                   1163:         my $ascii; # ASCII values of the data
                   1164:         my $chunk; # Current chunk of data
1.14      andrew   1165:
1.28      andrew   1166:         last if defined($maxlines) && ($offset >= ($maxlines * 8));
1.14      andrew   1167:
1.28      andrew   1168:         $chunk = substr($data, $offset, 8);
1.14      andrew   1169:
1.28      andrew   1170:         ($bin = $chunk) =~ s/./sprintf "%08b ", ord($&)/ges;
1.14      andrew   1171:
1.28      andrew   1172:         ($ascii = $chunk) =~ y/\040-\176/./c;
1.14      andrew   1173:
1.28      andrew   1174:         printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
1.14      andrew   1175:     }
1.28      andrew   1176: }
1.14      andrew   1177:
1.28      andrew   1178: # Thanks to Jochen Hoenicke <hoenicke@gmail.com>
                   1179: # (one of the authors of Palm Keyring)
                   1180: # for these next two subs.
                   1181:
                   1182: # Usage pbkdf2(password, salt, iter, keylen, prf)
                   1183: # iter is number of iterations
                   1184: # keylen is length of generated key in bytes
                   1185: # prf is the pseudo random function (e.g. hmac_sha1)
                   1186: # returns the key.
                   1187: sub _pbkdf2($$$$$)
                   1188: {
                   1189:     my ($password, $salt, $iter, $keylen, $prf) = @_;
                   1190:     my ($k, $t, $u, $ui, $i);
                   1191:     $t = "";
                   1192:     for ($k = 1; length($t) <  $keylen; $k++) {
                   1193:     $u = $ui = &$prf($salt.pack('N', $k), $password);
                   1194:     for ($i = 1; $i < $iter; $i++) {
                   1195:         $ui = &$prf($ui, $password);
                   1196:         $u ^= $ui;
                   1197:     }
                   1198:     $t .= $u;
                   1199:     }
                   1200:     return substr($t, 0, $keylen);
                   1201: }
1.11      andrew   1202:
1.28      andrew   1203: sub DES_odd_parity($) {
                   1204:     my $key = $_[0];
                   1205:     my ($r, $i);
                   1206:     my @odd_parity = (
                   1207:   1,  1,  2,  2,  4,  4,  7,  7,  8,  8, 11, 11, 13, 13, 14, 14,
                   1208:  16, 16, 19, 19, 21, 21, 22, 22, 25, 25, 26, 26, 28, 28, 31, 31,
                   1209:  32, 32, 35, 35, 37, 37, 38, 38, 41, 41, 42, 42, 44, 44, 47, 47,
                   1210:  49, 49, 50, 50, 52, 52, 55, 55, 56, 56, 59, 59, 61, 61, 62, 62,
                   1211:  64, 64, 67, 67, 69, 69, 70, 70, 73, 73, 74, 74, 76, 76, 79, 79,
                   1212:  81, 81, 82, 82, 84, 84, 87, 87, 88, 88, 91, 91, 93, 93, 94, 94,
                   1213:  97, 97, 98, 98,100,100,103,103,104,104,107,107,109,109,110,110,
                   1214: 112,112,115,115,117,117,118,118,121,121,122,122,124,124,127,127,
                   1215: 128,128,131,131,133,133,134,134,137,137,138,138,140,140,143,143,
                   1216: 145,145,146,146,148,148,151,151,152,152,155,155,157,157,158,158,
                   1217: 161,161,162,162,164,164,167,167,168,168,171,171,173,173,174,174,
                   1218: 176,176,179,179,181,181,182,182,185,185,186,186,188,188,191,191,
                   1219: 193,193,194,194,196,196,199,199,200,200,203,203,205,205,206,206,
                   1220: 208,208,211,211,213,213,214,214,217,217,218,218,220,220,223,223,
                   1221: 224,224,227,227,229,229,230,230,233,233,234,234,236,236,239,239,
                   1222: 241,241,242,242,244,244,247,247,248,248,251,251,253,253,254,254);
                   1223:     for ($i = 0; $i< length($key); $i++) {
                   1224:     $r .= chr($odd_parity[ord(substr($key, $i, 1))]);
                   1225:     }
                   1226:     return $r;
1.14      andrew   1227: }
1.11      andrew   1228:
1.14      andrew   1229: 1;
                   1230: __END__
1.11      andrew   1231:
1.14      andrew   1232: =head1 NAME
1.11      andrew   1233:
1.14      andrew   1234: Palm::Keyring - Handler for Palm Keyring databases.
1.1       andrew   1235:
1.14      andrew   1236: =head1 DESCRIPTION
1.7       andrew   1237:
1.14      andrew   1238: The Keyring PDB handler is a helper class for the Palm::PDB package. It
                   1239: parses Keyring for Palm OS databases.  See
                   1240: L<http://gnukeyring.sourceforge.net/>.
1.1       andrew   1241:
1.14      andrew   1242: It has the standard Palm::PDB methods with 2 additional public methods.
                   1243: Decrypt and Encrypt.
1.1       andrew   1244:
1.16      andrew   1245: It currently supports the v4 Keyring databases.  The v5 databases from
                   1246: the pre-release keyring-2.0 are not supported.
                   1247:
                   1248: This module doesn't store the decrypted content.  It only keeps it until it
                   1249: returns it to you or encrypts it.
1.1       andrew   1250:
1.14      andrew   1251: =head1 SYNOPSIS
1.1       andrew   1252:
1.16      andrew   1253:     use Palm::PDB;
                   1254:     use Palm::Keyring;
1.17      andrew   1255:
                   1256:     my $pass = 'password';
1.18      andrew   1257:     my $file = 'Keys-Gtkr.pdb';
                   1258:     my $pdb  = new Palm::PDB;
1.16      andrew   1259:     $pdb->Load($file);
1.17      andrew   1260:
1.28      andrew   1261:     foreach (0..$#{ $pdb->{records} }) {
1.17      andrew   1262:         next if $_ = 0; # skip the password record
1.28      andrew   1263:         my $rec  = $pdb->{records}->[$_];
1.17      andrew   1264:         my $acct = $pdb->Decrypt($rec, $pass);
1.28      andrew   1265:         print $rec->{name}, ' - ', $acct->{account}, "\n";
1.16      andrew   1266:     }
1.1       andrew   1267:
1.14      andrew   1268: =head1 SUBROUTINES/METHODS
1.1       andrew   1269:
1.14      andrew   1270: =head2 new
1.11      andrew   1271:
1.16      andrew   1272:     $pdb = new Palm::Keyring([$password]);
1.11      andrew   1273:
1.14      andrew   1274: Create a new PDB, initialized with the various Palm::Keyring fields
                   1275: and an empty record list.
1.11      andrew   1276:
1.14      andrew   1277: Use this method if you're creating a Keyring PDB from scratch otherwise you
1.16      andrew   1278: can just use Palm::PDB::new() before calling Load().
1.11      andrew   1279:
1.24      andrew   1280: If you pass in a password, it will initalize the first record with the encrypted
                   1281: password.
                   1282:
1.16      andrew   1283: =head2 Encrypt
1.11      andrew   1284:
1.24      andrew   1285:     $pdb->Encrypt($rec, $acct[, $password]);
1.11      andrew   1286:
1.16      andrew   1287: Encrypts an account into a record, either with the password previously
                   1288: used, or with a password that is passed.
1.1       andrew   1289:
1.28      andrew   1290: $rec is a record from $pdb->{records} or a new_Record().
1.16      andrew   1291: $acct is a hashref in the format below.
1.1       andrew   1292:
1.16      andrew   1293:     my $acct = {
1.28      andrew   1294:         name       => $rec->{name},
1.20      andrew   1295:         account    => $account,
                   1296:         password   => $password,
                   1297:         notes      => $notes,
                   1298:         lastchange => {
                   1299:             year  => 107, # years since 1900
                   1300:             month =>   0, # 0-11, 0 = January, 11 = December
1.21      andrew   1301:             day   =>  30, # 1-31, same as localtime
1.20      andrew   1302:         },
1.16      andrew   1303:     };
1.7       andrew   1304:
1.22      andrew   1305: If you have changed anything other than the lastchange, or don't pass in a
1.24      andrew   1306: lastchange key, Encrypt() will generate a new lastchange date for you.
1.22      andrew   1307:
                   1308: If you pass in a lastchange field that is different than the one in the
                   1309: record, it will honor what you passed in.
                   1310:
1.28      andrew   1311: Encrypt() only uses the $acct->{name} if there is not already a $rec->{name}.
1.22      andrew   1312:
1.16      andrew   1313: =head2 Decrypt
1.1       andrew   1314:
1.16      andrew   1315:     my $acct = $pdb->Decrypt($rec[, $password]);
1.1       andrew   1316:
1.16      andrew   1317: Decrypts the record and returns a hashref for the account as described
1.20      andrew   1318: under Encrypt().
1.1       andrew   1319:
1.28      andrew   1320:     foreach (0..$#{ $pdb->{records}) {
1.16      andrew   1321:         next if $_ == 0;
1.28      andrew   1322:         my $rec = $pdb->{records}->[$_];
1.16      andrew   1323:         my $acct = $pdb->Decrypt($rec[, $password]);
                   1324:         # do something with $acct
                   1325:     }
1.1       andrew   1326:
1.16      andrew   1327: =head2 Password
1.1       andrew   1328:
1.16      andrew   1329:     $pdb->Password([$password[, $new_password]]);
1.1       andrew   1330:
1.16      andrew   1331: Either sets the password to be used to crypt, or if you pass $new_password,
                   1332: changes the password on the database.
1.1       andrew   1333:
1.16      andrew   1334: If you have created a new $pdb, and you didn't set a password when you
                   1335: called new(), you only need to pass one password and it will set that as
                   1336: the password.
1.1       andrew   1337:
1.24      andrew   1338: If nothing is passed, it forgets the password that it was remembering.
1.1       andrew   1339:
1.14      andrew   1340: =head1 DEPENDENCIES
1.1       andrew   1341:
1.14      andrew   1342: Palm::StdAppInfo
1.1       andrew   1343:
1.14      andrew   1344: Digest::MD5
1.9       andrew   1345:
1.14      andrew   1346: Crypt::DES
1.4       andrew   1347:
1.14      andrew   1348: Readonly
1.10      andrew   1349:
1.24      andrew   1350: =head1 THANKS
                   1351:
                   1352: I would like to thank the helpful Perlmonk shigetsu who gave me some great advice
                   1353: and helped me get my first module posted.  L<http://perlmonks.org/?node_id=596998>
                   1354:
                   1355: I would also like to thank
                   1356: Johan Vromans
                   1357: E<lt>jvromans@squirrel.nlE<gt> --
                   1358: L<http://www.squirrel.nl/people/jvromans>.
                   1359: He had his own Palm::KeyRing module that he posted a couple of days before
                   1360: mine was ready and he was kind enough to let me have the namespace as well
                   1361: as giving me some very helpful hints about doing a few things that I was
                   1362: unsure of.  He is really great.
                   1363:
1.14      andrew   1364: =head1 BUGS AND LIMITATIONS
1.1       andrew   1365:
1.14      andrew   1366: Please report any bugs or feature requests to
                   1367: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
                   1368: L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
                   1369: notified of progress on your bug as I make changes.
1.1       andrew   1370:
                   1371: =head1 AUTHOR
                   1372:
1.27      andrew   1373: Andrew Fresh E<lt>andrew@cpan.orgE<gt>
1.1       andrew   1374:
1.14      andrew   1375: =head1 LICENSE AND COPYRIGHT
                   1376:
                   1377: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
                   1378:
1.15      andrew   1379: This program is free software; you can redistribute it and/or
                   1380: modify it under the same terms as Perl itself.
1.14      andrew   1381:
1.1       andrew   1382: =head1 SEE ALSO
                   1383:
                   1384: Palm::PDB(3)
                   1385:
                   1386: Palm::StdAppInfo(3)
1.11      andrew   1387:
                   1388: The Keyring for Palm OS website:
                   1389: L<http://gnukeyring.sourceforge.net/>
1.24      andrew   1390:
                   1391: Johan Vromans also has a wxkeyring app that now uses this module, available
1.27      andrew   1392: from his website at L<http://www.vromans.org/johan/software/sw_palmkeyring.html>

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>