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

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

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