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

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

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