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

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

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