[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.32

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

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