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

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

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