[BACK]Return to Keyring.pm CVS log [TXT][DIR] Up to [local] / palm / Palm-Keyring / lib / Palm

Diff for /palm/Palm-Keyring/lib/Palm/Keyring.pm between version 1.16 and 1.46

version 1.16, 2007/01/30 04:59:55 version 1.46, 2007/08/10 05:13:31
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
   # $RedRiver: Keyring.pm,v 1.45 2007/02/26 00:02:13 andrew Exp $
 # $RedRiver: Keyring.pm,v 1.15 2007/01/29 02:49:41 andrew Exp $  ########################################################################
   # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #  #
 # Perl class for dealing with Keyring for Palm OS databases.  
 #  
 #   This started as Memo.pm, I just made it work for Keyring.  #   This started as Memo.pm, I just made it work for Keyring.
   #
   # 2006.01.26 #*#*# andrew fresh <andrew@cpan.org>
   ########################################################################
   # Copyright (C) 2006, 2007 by Andrew Fresh
   #
   # This program is free software; you can redistribute it and/or modify
   # it under the same terms as Perl itself.
   ########################################################################
 use strict;  use strict;
 use warnings;  use warnings;
   
 use Carp;  use Carp;
   
 use base qw/ Palm::StdAppInfo /;  use base qw/ Palm::StdAppInfo /;
   
 use Digest::MD5 qw(md5);  my $ENCRYPT    = 1;
 use Crypt::DES;  my $DECRYPT    = 0;
 use Readonly;  my $MD5_CBLOCK = 64;
   my $kSalt_Size = 4;
   my $EMPTY      = q{};
   my $SPACE      = q{ };
   my $NULL       = chr 0;
   
 Readonly my $ENCRYPT    => 1;  my @CRYPTS = (
 Readonly my $DECRYPT    => 0;      {
 Readonly my $MD5_CBLOCK => 64;          alias     => 'None',
 Readonly my $kSalt_Size => 4;          name      => 'None',
 Readonly my $EMPTY      => q{};          keylen    => 8,
 Readonly my $SPACE      => q{ };          blocksize => 1,
 Readonly my $NULL       => chr 0;          default_iter => 500,
       },
       {
           alias     => 'DES-EDE3',
           name      => 'DES_EDE3',
           keylen    => 24,
           blocksize =>  8,
           DES_odd_parity => 1,
           default_iter => 1000,
       },
       {
           alias     => 'AES128',
           name      => 'Rijndael',
           keylen    => 16,
           blocksize => 16,
           default_iter => 100,
       },
       {
           alias     => 'AES256',
           name      => 'Rijndael',
           keylen    => 32,
           blocksize => 16,
           default_iter => 250,
       },
   );
   
 # One liner, to allow MakeMaker to work.  my %LABELS = (
 our $VERSION = 0.91;      0 => {
           id   => 0,
           name => 'name',
       },
       1 => {
           id   => 1,
           name => 'account',
       },
       2 => {
           id   => 2,
           name => 'password',
       },
       3 => {
           id   => 3,
           name => 'lastchange',
       },
       255 => {
           id   => 255,
           name => 'notes',
       },
   );
   
 sub new {  
   our $VERSION = 0.96;
   
   sub new
   {
     my $classname = shift;      my $classname = shift;
     my $pass      = shift;      my $options = {};
   
       if (@_) {
           # hashref arguments
           if (ref $_[0] eq 'HASH') {
             $options = shift;
           }
   
           # CGI style arguments
           elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {
             my %tmp = @_;
             while ( my($key,$value) = each %tmp) {
               $key =~ s/^-//;
               $options->{lc $key} = $value;
             }
           }
   
           else {
               $options->{password} = shift;
               $options->{version}  = shift;
           }
       }
   
     # Create a generic PDB. No need to rebless it, though.      # Create a generic PDB. No need to rebless it, though.
     my $self = $classname->SUPER::new(@_);      my $self = $classname->SUPER::new();
   
     $self->{'name'}    = 'Keys-Gtkr';    # Default      $self->{name}    = 'Keys-Gtkr';    # Default
     $self->{'creator'} = 'Gtkr';      $self->{creator} = 'Gtkr';
     $self->{'type'}    = 'Gkyr';      $self->{type}    = 'Gkyr';
   
     # The PDB is not a resource database by      # The PDB is not a resource database by
     # default, but it's worth emphasizing,      # default, but it's worth emphasizing,
     # since MemoDB is explicitly not a PRC.      # since MemoDB is explicitly not a PRC.
     $self->{'attributes'}{'resource'} = 0;      $self->{attributes}{resource} = 0;
   
     # Initialize the AppInfo block      # Set the version
     $self->{'appinfo'} = {};      $self->{version} = $options->{version} || 4;
   
     # Add the standard AppInfo block stuff      # Set options
     Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} );      $self->{options} = $options;
   
     # Set the version      # Set defaults
     $self->{'version'} = 4;      if ($self->{version} == 5) {
           $self->{options}->{cipher} ||= 0; # 'None'
           my $c = crypts($self->{options}->{cipher})
               or croak('Unknown cipher ' . $self->{options}->{cipher});
           $self->{options}->{iterations} ||= $c->{default_iter};
           $self->{appinfo}->{cipher} ||= $self->{options}->{cipher};
           $self->{appinfo}->{iter}   ||= $self->{options}->{iterations};
       };
   
     if ( defined $pass ) {      if ( defined $options->{password} ) {
         $self->Password($pass);          $self->Password($options->{password});
     }      }
   
     return $self;      return $self;
 }  }
   
 sub import {  sub import
   {
     Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );      Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
     return 1;      return 1;
 }  }
   
 sub ParseRecord {  # Accessors
   
   sub crypts
   {
       my $crypt = shift;
       if ((! defined $crypt) || (! length $crypt)) {
           return;
       } elsif ($crypt =~ /\D/) {
           foreach my $c (@CRYPTS) {
               if ($c->{alias} eq $crypt) {
                   return $c;
               }
           }
           # didn't find it.
           return;
       } else {
           return $CRYPTS[$crypt];
       }
   }
   
   sub labels
   {
       my $label = shift;
   
       if ((! defined $label) || (! length $label)) {
           return;
       } elsif (exists $LABELS{$label}) {
           return $LABELS{$label};
       } else {
           foreach my $l (keys %LABELS) {
               if ($LABELS{$l}{name} eq $label) {
                   return $LABELS{$l};
               }
           }
   
           # didn't find it, make one.
           if ($label =~ /^\d+$/) {
               return {
                   id => $label,
                   name => undef,
               };
           } else {
               return;
           }
       }
   }
   
   # Write
   
   sub Write
   {
       my $self = shift;
   
       if ($self->{version} == 4) {
          # Give the PDB the first record that will hold the encrypted password
           my $rec = $self->new_Record;
           $rec->{data} = $self->{encpassword};
   
           if (ref $self->{records} eq 'ARRAY') {
               unshift @{ $self->{records} }, $rec;
           } else {
               $self->{records} = [ $rec ];
           }
       }
   
       my $rc = $self->SUPER::Write(@_);
   
       if ($self->{version} == 4) {
           shift @{ $self->{records} };
       }
   
       return $rc;
   }
   
   # ParseRecord
   
   sub ParseRecord
   {
     my $self     = shift;      my $self     = shift;
   
     my $rec = $self->SUPER::ParseRecord(@_);      my $rec = $self->SUPER::ParseRecord(@_);
       return $rec if ! exists $rec->{data};
   
     # skip the 0 record that holds the password      if ($self->{version} == 4) {
     return $rec if ! exists $self->{'records'};          # skip the first record because it contains the password.
           if (! exists $self->{records}) {
               $self->{encpassword} = $rec->{data};
               return '__DELETE_ME__';
           }
   
     # skip records with no data (There shouldn't be any)          if ($self->{records}->[0] eq '__DELETE_ME__') {
     return $rec if ! exists $rec->{'data'};              shift @{ $self->{records} };
           }
   
     my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;          my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2;
   
     return $rec if ! $encrypted;          return $rec if ! $encrypted;
     $rec->{'data'} = $name;          $rec->{decrypted}->{0} = {
     $rec->{'encrypted'} = $encrypted;              label => 'name',
               label_id => 0,
               data  => $name,
               font  => 0,
           };
           $rec->{encrypted} = $encrypted;
           delete $rec->{data};
   
       } elsif ($self->{version} == 5) {
           my $c = crypts( $self->{appinfo}->{cipher} )
               or croak('Unknown cipher ' . $self->{appinfo}->{cipher});
           my $blocksize = $c->{blocksize};
           my ($field, $extra) = _parse_field($rec->{data});
           delete $rec->{data};
   
           $rec->{decrypted}->{0} = $field;
           $rec->{ivec}      = substr $extra, 0, $blocksize;
           $rec->{encrypted} = substr $extra, $blocksize;
   
       } else {
           croak "Unsupported Version $self->{version}";
           return;
       }
   
     return $rec;      return $rec;
 }  }
   
 sub PackRecord {  # PackRecord
   
   sub PackRecord
   {
     my $self = shift;      my $self = shift;
     my $rec  = shift;      my $rec  = shift;
   
     my $rec0_id = $self->{'records'}->[0]->{'id'};      if ($self->{version} == 4) {
           if ($rec->{encrypted}) {
               my $name = $rec->{decrypted}->{0}->{data} || $EMPTY;
               $rec->{data} = join $NULL, $name, $rec->{encrypted};
               delete $rec->{decrypted};
               delete $rec->{encrypted};
           }
   
     if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) {      } elsif ($self->{version} == 5) {
         $rec->{'data'} = join $NULL, $rec->{'data'}, $rec->{'encrypted'};          my $field;
         delete $rec->{'encrypted'};          if ($rec->{decrypted}->{0}) {
               $field = $rec->{decrypted}->{0};
           } else {
               $field = {
                   'label'    => 'name',
                   'label_id' => 0,
                   'data'     => $EMPTY,
                   'font'     => 0,
               };
           }
           my $packed = _pack_field($field);
   
           $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};
   
       } else {
           croak "Unsupported Version $self->{version}";
     }      }
   
     return $self->SUPER::PackRecord($rec, @_);      return $self->SUPER::PackRecord($rec, @_);
 }  }
   
 sub Encrypt {  # ParseAppInfoBlock
   
   sub ParseAppInfoBlock
   {
     my $self = shift;      my $self = shift;
       my $data = shift;
       my $appinfo = {};
   
       &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);
   
       # int8/uint8
       # - Signed or Unsigned Byte (8 bits). C types: char, unsigned char
       # int16/uint16
       # - Signed or Unsigned Word (16 bits). C types: short, unsigned short
       # int32/uint32
       # - Signed or Unsigned Doubleword (32 bits). C types: int, unsigned int
       # sz
       # - Zero-terminated C-style string
   
       if ($self->{version} == 4) {
           # Nothing extra for version 4
   
       } elsif ($self->{version} == 5) {
           _parse_appinfo_v5($appinfo) || return;
   
       } else {
           croak "Unsupported Version $self->{version}";
       }
   
       return $appinfo;
   }
   
   sub _parse_appinfo_v5
   {
       my $appinfo = shift;
   
       if (! exists $appinfo->{other}) {
           # XXX Corrupt appinfo?
           return;
       }
   
       my $unpackstr
           = ("C1" x 8)  # 8 uint8s in an array for the salt
           . ("n1" x 2)  # the iter (uint16) and the cipher (uint16)
           . ("C1" x 8); # and finally 8 more uint8s for the hash
   
       my (@salt, $iter, $cipher, @hash);
       (@salt[0..7], $iter, $cipher, @hash[0..7])
           = unpack $unpackstr, $appinfo->{other};
   
       $appinfo->{salt}           = sprintf "%02x" x 8, @salt;
       $appinfo->{iter}           = $iter;
       $appinfo->{cipher}         = $cipher;
       $appinfo->{masterhash}     = sprintf "%02x" x 8, @hash;
       delete $appinfo->{other};
   
       return $appinfo
   }
   
   # PackAppInfoBlock
   
   sub PackAppInfoBlock
   {
       my $self = shift;
       my $retval;
   
       if ($self->{version} == 4) {
           # Nothing to do for v4
   
       } elsif ($self->{version} == 5) {
           _pack_appinfo_v5($self->{appinfo});
       } else {
           croak "Unsupported Version $self->{version}";
       }
       return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
   }
   
   sub _pack_appinfo_v5
   {
       my $appinfo = shift;
   
       my $packstr
           = ("C1" x 8)  # 8 uint8s in an array for the salt
           . ("n1" x 2)  # the iter (uint16) and the cipher (uint16)
           . ("C1" x 8); # and finally 8 more uint8s for the hash
   
       my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm;
       my @hash = map { hex $_ } $appinfo->{masterhash} =~ /../gxm;
   
       my $packed = pack($packstr,
           @salt,
           $appinfo->{iter},
           $appinfo->{cipher},
           @hash
       );
   
       $appinfo->{other}  = $packed;
   
       return $appinfo
   }
   
   # Encrypt
   
   sub Encrypt
   {
       my $self = shift;
     my $rec  = shift;      my $rec  = shift;
     my $data = shift;      my $data = shift;
     my $pass = shift || $self->{'password'};      my $pass = shift || $self->{password};
       my $ivec = shift;
   
     if ( ! $pass) {      if ( ! $pass && ! $self->{appinfo}->{key}) {
         croak("'password' not set!\n");          croak("password not set!\n");
     }      }
   
     if ( ! $rec) {      if ( ! $rec) {
Line 116 
Line 438 
         croak("Needed parameter 'data' not passed!\n");          croak("Needed parameter 'data' not passed!\n");
     }      }
   
     if ( ! $self->Password($pass)) {      if ( $pass && ! $self->Password($pass)) {
         croak("Incorrect Password!\n");          croak("Incorrect Password!\n");
     }      }
   
     $self->{'digest'} ||= _calc_keys( $pass );      my $acct;
       if ($rec->{encrypted}) {
           $acct = $self->Decrypt($rec, $pass);
       }
   
     $data->{'account'}  ||= $EMPTY;      my $encrypted;
     $data->{'password'} ||= $EMPTY;      if ($self->{version} == 4) {
     $data->{'notes'}    ||= $EMPTY;          $self->{digest} ||= _calc_keys( $pass );
           my $datav4 = {
               name       => $data->{0}->{data},
               account    => $data->{1}->{data},
               password   => $data->{2}->{data},
               lastchange => $data->{3}->{data},
               notes      => $data->{255}->{data},
           };
           my $acctv4 = {
               name       => $acct->{0}->{data},
               account    => $acct->{1}->{data},
               password   => $acct->{2}->{data},
               lastchange => $acct->{3}->{data},
               notes      => $acct->{255}->{data},
           };
           $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});
   
       } elsif ($self->{version} == 5) {
           ($encrypted, $ivec) = _encrypt_v5(
               $data, $acct,
               $self->{appinfo}->{key},
               $self->{appinfo}->{cipher},
               $ivec,
           );
           if (defined $ivec) {
               $rec->{ivec} = $ivec;
           }
   
       } else {
           croak "Unsupported Version $self->{version}";
       }
   
       $rec->{decrypted}->{0} = $data->{0};
   
       if ($encrypted) {
           if ($encrypted eq '1') {
               return 1;
           }
   
           $rec->{attributes}{Dirty} = 1;
           $rec->{attributes}{dirty} = 1;
           $rec->{encrypted} = $encrypted;
   
           return 1;
       } else {
           return;
       }
   }
   
   sub _encrypt_v4
   {
       my $new    = shift;
       my $old    = shift;
       my $digest = shift;
   
       $new->{account}  ||= $EMPTY;
       $new->{password} ||= $EMPTY;
       $new->{notes}    ||= $EMPTY;
   
       my $changed      = 0;
       my $need_newdate = 0;
       if ($old && %{ $old }) {
           no warnings 'uninitialized';
           foreach my $key (keys %{ $new }) {
               next if $key eq 'lastchange';
               if ($new->{$key} ne $old->{$key}) {
                   $changed = 1;
                   last;
               }
           }
           if ( exists $new->{lastchange} && exists $old->{lastchange} && (
               $new->{lastchange}->{day}   != $old->{lastchange}->{day}   ||
               $new->{lastchange}->{month} != $old->{lastchange}->{month} ||
               $new->{lastchange}->{year}  != $old->{lastchange}->{year}
           )) {
               $changed = 1;
               $need_newdate = 0;
           } else {
               $need_newdate = 1;
           }
   
       } else {
           $changed = 1;
       }
   
       # no need to re-encrypt if it has not changed.
       return 1 if ! $changed;
   
       my ($day, $month, $year);
   
       if ($new->{lastchange} && ! $need_newdate ) {
           $day   = $new->{lastchange}->{day}   || 1;
           $month = $new->{lastchange}->{month} || 0;
           $year  = $new->{lastchange}->{year}  || 0;
   
           # XXX Need to actually validate the above information somehow
           if ($year >= 1900) {
               $year -= 1900;
           }
       } else {
           $need_newdate = 1;
       }
   
       if ($need_newdate) {
           ($day, $month, $year) = (localtime)[3,4,5];
       }
   
       my $packed_date = _pack_keyring_date( {
               year  => $year,
               month => $month,
               day   => $day,
       });
   
     my $plaintext = join $NULL,      my $plaintext = join $NULL,
         $data->{'account'}, $data->{'password'}, $data->{'notes'};          $new->{account}, $new->{password}, $new->{notes}, $packed_date;
   
     my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );      return _crypt3des( $plaintext, $digest, $ENCRYPT );
   }
   
     return if ! $encrypted;  sub _encrypt_v5
   {
       my $new    = shift;
       my $old    = shift;
       my $key    = shift;
       my $cipher = shift;
       my $ivec   = shift;
       my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
   
     $rec->{'data'} ||= $data->{'name'};      if (! defined $ivec) {
     $rec->{'encrypted'} = $encrypted;          $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});
     return 1;      }
   
       my $changed = 0;
       my $need_newdate = 1;
       if ($new->{3}->{data}) {
           $need_newdate = 0;
       }
       foreach my $k (keys %{ $new }) {
           if (! $old) {
               $changed = 1;
           } elsif ($k == 3) {
               if ($old && (
                       $new->{$k}{data}{day}   == $old->{$k}{data}{day}   &&
                       $new->{$k}{data}{month} == $old->{$k}{data}{month} &&
                       $new->{$k}{data}{year}  == $old->{$k}{data}{year}
                   )) {
                   $changed      = 1;
                   $need_newdate = 1;
               }
   
           } else {
               my $n = join ':', sort %{ $new->{$k} };
               my $o = join ':', sort %{ $old->{$k} };
               if ($n ne $o) {
                   $changed = 1;
               }
           }
       }
   
       return 1, 0 if $changed == 0;
   
       if ($need_newdate) {
           my ($day, $month, $year) = (localtime)[3,4,5];
           $new->{3} = {
               label => 'lastchange',
               label_id => 3,
               font  => 0,
               data => {
                   year  => $year,
                   month => $month,
                   day   => $day,
               },
           };
       } else {
           # XXX Need to actually validate the above information somehow
           if ($new->{3}->{data}->{year} >= 1900) {
               $new->{3}->{data}->{year} -= 1900;
           }
       }
   
       my $decrypted;
       foreach my $k (keys %{ $new }) {
           $decrypted .= _pack_field($new->{$k});
       }
   
       my $encrypted;
       if ($c->{name} eq 'None') {
           # do nothing
           $encrypted = $decrypted;
   
       } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
           require Crypt::CBC;
           my $cbc = Crypt::CBC->new(
               -key         => $key,
               -literal_key => 1,
               -iv          => $ivec,
               -cipher      => $c->{name},
               -keysize     => $c->{keylen},
               -blocksize   => $c->{blocksize},
               -header      => 'none',
               -padding     => 'oneandzeroes',
           );
   
           if (! $c) {
               croak("Unable to set up encryption!");
           }
   
           $encrypted = $cbc->encrypt($decrypted);
   
       } else {
           croak "Unsupported Crypt $c->{name}";
       }
   
       return $encrypted, $ivec;
 }  }
   
 sub Decrypt {  # Decrypt
   
   sub Decrypt
   {
     my $self = shift;      my $self = shift;
     my $rec  = shift;      my $rec  = shift;
     my $pass = shift || $self->{'password'};      my $pass = shift || $self->{password};
   
     if ( ! $pass) {      if ( ! $pass && ! $self->{appinfo}->{key}) {
         croak("'password' not set!\n");          croak("password not set!\n");
     }      }
   
     if ( ! $rec) {      if ( ! $rec) {
         carp("Needed parameter 'record' not passed!\n");          croak("Needed parameter 'record' not passed!\n");
         return;  
     }      }
   
     if ( ! $self->Password($pass)) {      if ( $pass && ! $self->Password($pass)) {
         croak("Invalid Password!\n");          croak("Invalid Password!\n");
     }      }
   
     if ( ! $rec->{'encrypted'} ) {      if ( ! $rec->{encrypted} ) {
         croak("No encrypted content!");          croak("No encrypted content!");
     }      }
   
     $self->{'digest'} ||= _calc_keys( $pass );      if ($self->{version} == 4) {
           $self->{digest} ||= _calc_keys( $pass );
           my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
           return {
               0 => $rec->{decrypted}->{0},
               1 => {
                   label    => 'account',
                   label_id => 1,
                   font     => 0,
                   data     => $acct->{account},
               },
               2 => {
                   label    => 'password',
                   label_id => 2,
                   font     => 0,
                   data     => $acct->{password},
               },
               3 => {
                   label    => 'lastchange',
                   label_id => 3,
                   font     => 0,
                   data     => $acct->{lastchange},
               },
               255 => {
                   label    => 'notes',
                   label_id => 255,
                   font     => 0,
                   data     => $acct->{notes},
               },
           };
   
     my $decrypted =      } elsif ($self->{version} == 5) {
         _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );          my $decrypted = _decrypt_v5(
     my ( $account, $password, $notes, $extra ) = split /$NULL/xm,              $rec->{encrypted}, $self->{appinfo}->{key},
           $decrypted, 4;              $self->{appinfo}->{cipher}, $rec->{ivec},
           );
           $decrypted->{0} ||= $rec->{decrypted}->{0};
           return $decrypted;
   
       } else {
           croak "Unsupported Version $self->{version}";
       }
       return;
   }
   
   sub _decrypt_v4
   {
       my $encrypted = shift;
       my $digest    = shift;
   
       my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );
       my ( $account, $password, $notes, $packed_date )
           = split /$NULL/xm, $decrypted, 4;
   
       my $modified;
       if ($packed_date) {
           $modified = _parse_keyring_date($packed_date);
       }
   
     return {      return {
         account  => $account,          account    => $account,
         password => $password,          password   => $password,
         notes    => $notes,          notes      => $notes,
           lastchange => $modified,
     };      };
 }  }
   
 sub Password {  sub _decrypt_v5
   {
   
       my $encrypted = shift;
       my $key       = shift;
       my $cipher    = shift;
       my $ivec      = shift;
   
       my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
   
       my $decrypted;
   
       if ($c->{name} eq 'None') {
           # do nothing
           $decrypted = $encrypted;
   
       } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
           require Crypt::CBC;
           my $cbc = Crypt::CBC->new(
               -key         => $key,
               -literal_key => 1,
               -iv          => $ivec,
               -cipher      => $c->{name},
               -keysize     => $c->{keylen},
               -blocksize   => $c->{blocksize},
               -header      => 'none',
               -padding     => 'oneandzeroes',
           );
   
           if (! $c) {
               croak("Unable to set up encryption!");
           }
           my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};
           $encrypted .= $NULL x $len;
           $decrypted  = $cbc->decrypt($encrypted);
   
       } else {
           croak "Unsupported Crypt $c->{name}";
       }
   
       my %fields;
       while ($decrypted) {
           my $field;
           ($field, $decrypted) = _parse_field($decrypted);
           if (! $field) {
               last;
           }
           $fields{ $field->{label_id} } = $field;
       }
   
       return \%fields;
   }
   
   # Password
   
   sub Password
   {
     my $self = shift;      my $self = shift;
     my $pass = shift || $self->{'password'};      my $pass = shift;
     my $new_pass = shift;      my $new_pass = shift;
   
     if (! exists $self->{'records'}) {      if (! $pass) {
         # Give the PDB the first record that will hold the encrypted password          delete $self->{password};
         $self->{'records'} = [ $self->new_Record ];          delete $self->{appinfo}->{key};
           return 1;
       }
   
       if (
           ($self->{version} == 4 && ! exists $self->{encpassword}) ||
           ($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash})
       ) {
         return $self->_password_update($pass);          return $self->_password_update($pass);
     }      }
   
     if ($new_pass) {      if ($new_pass) {
         my @accts = ();          my @accts = ();
         foreach my $i (0..$#{ $self->{'records'} }) {          foreach my $rec (@{ $self->{records} }) {
             if ($i == 0) {              my $acct = $self->Decrypt($rec, $pass);
                 push @accts, undef;  
                 next;  
             }  
             my $acct = $self->Decrypt($self->{'records'}->[$i], $pass);  
             if ( ! $acct ) {              if ( ! $acct ) {
                 croak("Couldn't decrypt $self->{'records'}->[$i]->{'data'}");                  croak("Couldn't decrypt $rec->{decrypted}->{0}->{data}");
             }              }
             push @accts, $acct;              push @accts, $acct;
         }          }
Line 206 
Line 846 
         $pass = $new_pass;          $pass = $new_pass;
   
         foreach my $i (0..$#accts) {          foreach my $i (0..$#accts) {
             next if $i == 0;              delete $self->{records}->[$i]->{encrypted};
             $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);              $self->Encrypt($self->{records}->[$i], $accts[$i], $pass);
         }          }
     }      }
   
     return $self->_password_verify($pass);      if (defined $self->{password} && $pass eq $self->{password}) {
           # already verified this password
           return 1;
       }
   
       if ($self->{version} == 4) {
           my $valid = _password_verify_v4($pass, $self->{encpassword});
   
           # May as well generate the keys we need now,
           # since we know the password is right
           if ($valid) {
               $self->{digest} = _calc_keys($pass);
               if ($self->{digest} ) {
                   $self->{password} = $pass;
                   return 1;
               }
           }
       } elsif ($self->{version} == 5) {
           return _password_verify_v5($self->{appinfo}, $pass);
       } else {
           croak "Unsupported version $self->{version}";
       }
   
       return;
 }  }
   
 sub _calc_keys {  sub _password_verify_v4
   {
       require Digest::MD5;
       import Digest::MD5 qw(md5);
   
     my $pass = shift;      my $pass = shift;
     if (! defined $pass) { croak('No password defined!'); };      my $data = shift;
   
     my $digest = md5($pass);      if (! $pass) { croak('No password specified!'); };
   
     my ( $key1, $key2 ) = unpack 'a8a8', $digest;      # XXX die "No encrypted password in file!" unless defined $data;
       if ( ! defined $data) { return; };
   
     #--------------------------------------------------      $data =~ s/$NULL$//xm;
     # print "key1: $key1: ", length $key1, "\n";  
     # print "key2: $key2: ", length $key2, "\n";  
     #--------------------------------------------------  
   
     $digest = unpack 'H*', $key1 . $key2 . $key1;      my $salt = substr $data, 0, $kSalt_Size;
   
     #--------------------------------------------------      my $msg = $salt . $pass;
     # print "Digest: ", $digest, "\n";      $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
     # print length $digest, "\n";  
     #--------------------------------------------------  
   
     return $digest;      my $digest = md5($msg);
   
       if ($data ne $salt . $digest ) {
           return;
       }
   
       return 1;
 }  }
   
 sub _password_verify {  sub _password_verify_v5
     my $self = shift;  {
     my $pass = shift;      my $appinfo = shift;
       my $pass    = shift;
   
     if (! $pass) { croak('No password specified!'); };      my $salt = pack("H*", $appinfo->{salt});
   
     if (defined $self->{'password'} && $pass eq $self->{'password'}) {      my $c = crypts($appinfo->{cipher})
         # already verified this password          or croak('Unknown cipher ' . $appinfo->{cipher});
         return 1;      my ($key, $hash) = _calc_key_v5(
           $pass, $salt, $appinfo->{iter},
           $c->{keylen},
           $c->{DES_odd_parity},
       );
   
       #print "Iter: '" . $appinfo->{iter} . "'\n";
       #print "Key:  '". unpack("H*", $key) . "'\n";
       #print "Salt: '". unpack("H*", $salt) . "'\n";
       #print "Hash: '". $hash . "'\n";
       #print "Hash: '". $appinfo->{masterhash} . "'\n";
   
       if ($appinfo->{masterhash} eq $hash) {
           $appinfo->{key} = $key;
       } else {
           return;
     }      }
   
     # AFAIK the thing we use to test the password is      return $key;
     #     always in the first entry  }
     my $data = $self->{'records'}->[0]->{'data'};  
   
     #die "No encrypted password in file!" unless defined $data;  
     if ( ! defined $data) { return; };  
   
     $data =~ s/$NULL$//xm;  sub _password_update
   {
       # It is very important to Encrypt after calling this
       #     (Although it is generally only called by Encrypt)
       # because otherwise the data will be out of sync with the
       # password, and that would suck!
       my $self   = shift;
       my $pass   = shift;
   
     my $salt = substr $data, 0, $kSalt_Size;      if ($self->{version} == 4) {
           my $data = _password_update_v4($pass, @_);
   
     my $msg = $salt . $pass;          if (! $data) {
               carp("Failed  to update password!");
               return;
           }
   
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );          # AFAIK the thing we use to test the password is
           #     always in the first entry
           $self->{encpassword} = $data;
           $self->{password} = $pass;
           $self->{digest}   = _calc_keys( $self->{password} );
   
     my $digest = md5($msg);          return 1;
   
     if ( $data eq $salt . $digest ) {      } elsif ($self->{version} == 5) {
           my $cipher  = shift || $self->{appinfo}->{cipher};
           my $iter    = shift || $self->{appinfo}->{iter};
           my $salt    = shift || 0;
   
 # May as well generate the keys we need now, since we know the password is right          my $hash = _password_update_v5(
         $self->{'digest'} = _calc_keys($pass);              $self->{appinfo}, $pass, $cipher, $iter, $salt
         if ( $self->{'digest'} ) {          );
             $self->{'password'} = $pass;  
             return 1;          if (! $hash) {
               carp("Failed  to update password!");
               return;
         }          }
   
           return 1;
       } else {
           croak("Unsupported version ($self->{version})");
     }      }
   
     return;      return;
 }  }
   
 sub _password_update {  sub _password_update_v4
   {
       require Digest::MD5;
       import Digest::MD5 qw(md5);
   
     # It is very important to Encrypt after calling this  
     #     (Although it is generally only called by Encrypt)  
     # because otherwise the data will be out of sync with the  
     # password, and that would suck!  
     my $self = shift;  
     my $pass = shift;      my $pass = shift;
   
     if (! defined $pass) { croak('No password specified!'); };      if (! defined $pass) { croak('No password specified!'); };
   
     my $salt;      my $salt;
Line 301 
Line 1006 
   
     my $data = $salt . $digest;    # . "\0";      my $data = $salt . $digest;    # . "\0";
   
     # AFAIK the thing we use to test the password is      return $data;
     #     always in the first entry  }
     $self->{'records'}->[0]->{'data'} = $data;  
   
     $self->{'password'} = $pass;  sub _password_update_v5
     $self->{'digest'}   = _calc_keys( $self->{'password'} );  {
       my $appinfo = shift;
       my $pass    = shift;
       my $cipher  = shift;
       my $iter    = shift;
   
     return 1;      # I thought this needed to be 'blocksize', but apparently not.
       #my $length  = $CRYPTS[ $cipher ]{blocksize};
       my $length  = 8;
       my $salt    = shift || pack("C*",map {rand(256)} 1..$length);
   
       my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
       my ($key, $hash) = _calc_key_v5(
           $pass, $salt, $iter,
           $c->{keylen},
           $c->{DES_odd_parity},
       );
   
       $appinfo->{salt}           = unpack "H*", $salt;
       $appinfo->{iter}           = $iter;
       $appinfo->{cipher}         = $cipher;
       $appinfo->{masterhash}     = $hash;
       $appinfo->{key}            = $key;
   
       return $key;
 }  }
   
 sub _crypt3des {  # Helpers
   
   sub _calc_keys
   {
       my $pass = shift;
       if (! defined $pass) { croak('No password defined!'); };
   
       my $digest = md5($pass);
   
       my ( $key1, $key2 ) = unpack 'a8a8', $digest;
   
       #--------------------------------------------------
       # print "key1: $key1: ", length $key1, "\n";
       # print "key2: $key2: ", length $key2, "\n";
       #--------------------------------------------------
   
       $digest = unpack 'H*', $key1 . $key2 . $key1;
   
       #--------------------------------------------------
       # print "Digest: ", $digest, "\n";
       # print length $digest, "\n";
       #--------------------------------------------------
   
       return $digest;
   }
   
   sub _calc_key_v5
   {
       my ($pass, $salt, $iter, $keylen, $dop) = @_;
   
       require Digest::HMAC_SHA1;
       import  Digest::HMAC_SHA1 qw(hmac_sha1);
       require Digest::SHA1;
       import  Digest::SHA1 qw(sha1);
   
       my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );
       if ($dop) { $key = _DES_odd_parity($key); }
   
       my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
   
       return $key, $hash;
   }
   
   sub _crypt3des
   {
       require Crypt::DES;
   
     my ( $plaintext, $passphrase, $flag ) = @_;      my ( $plaintext, $passphrase, $flag ) = @_;
   
     $passphrase   .= $SPACE x ( 16 * 3 );      $passphrase   .= $SPACE x ( 16 * 3 );
Line 335 
Line 1107 
         if ( (length $pt) < 8 ) {          if ( (length $pt) < 8 ) {
             if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };              if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
             my $len = 8 - (length $pt);              my $len = 8 - (length $pt);
   
             #print "LENGTH: $len\n";  
             #print "Binary:    '" . unpack("b*", $pt) . "'\n";  
             $pt .= ($NULL x $len);              $pt .= ($NULL x $len);
   
             #print "PT: '$pt' - Length: " . length($pt) . "\n";  
             #print "Binary:    '" . unpack("b*", $pt) . "'\n";  
         }          }
         if ( $flag == $ENCRYPT ) {          if ( $flag == $ENCRYPT ) {
             $pt = $C[0]->encrypt($pt);              $pt = $C[0]->encrypt($pt);
Line 365 
Line 1131 
     return $cyphertext;      return $cyphertext;
 }  }
   
   sub _parse_field
   {
       my $field = shift;
   
       my ($len) = unpack "n", $field;
       if ($len + 4 > length $field) {
           return undef, $field;
       }
       my $unpackstr = "x2 C1 C1 A$len";
       my $offset    =   2 +1 +1 +$len;
       if ($len % 2) {
           # trim the 0/1 byte padding for next even address.
           $offset++;
           $unpackstr .= ' x'
       }
   
       my ($label, $font, $data) = unpack $unpackstr, $field;
       my $leftover = substr $field, $offset;
   
       my $label_id = $label;
       my $l = labels($label);
       if ($l) {
           $label = $l->{name} || $l->{id};
           $label_id = $l->{id};
       }
   
       if ($label_id && $label_id == 3) {
           ($data) = substr $field, 4, $len;
           $data = _parse_keyring_date($data);
       }
       return {
           #len      => $len,
           label    => $label,
           label_id => $label_id,
           font     => $font,
           data     => $data,
       }, $leftover;
   }
   
   sub _pack_field
   {
       my $field = shift;
   
       my $packed;
       if (defined $field) {
           my $label = $field->{label_id} || 0;
           if (defined $field->{label} && ! $label) {
               $label = $field->{label};
           }
   
           my $l = labels($field->{label});
           if ($l) {
               $label = $l->{id};
           }
   
           my $font  = $field->{font} || 0;
           my $data  = defined $field->{data} ? $field->{data} : $EMPTY;
   
           if ($label && $label == 3) {
               $data = _pack_keyring_date($data);
           }
           my $len = length $data;
           my $packstr = "n1 C1 C1 A*";
   
           $packed = pack $packstr, ($len, $label, $font, $data);
   
           if ($len % 2) {
               # add byte padding for next even address.
               $packed .= $NULL;
           }
       } else {
           my $packstr = "n1 C1 C1 x1";
           $packed = pack $packstr, 0, 0, 0;
       }
   
       return $packed;
   }
   
   sub _parse_keyring_date
   {
       my $data = shift;
   
       my $u = unpack 'n', $data;
       my $year  = (($u & 0xFE00) >> 9) + 4; # since 1900
       my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
       my $day   = (($u & 0x001F) >> 0);     # 1-31
   
       return {
           year   => $year,
           month  => $month || 0,
           day    => $day   || 1,
       };
   }
   
   sub _pack_keyring_date
   {
       my $d = shift;
       my $year  = $d->{year};
       my $month = $d->{month};
       my $day   = $d->{day};
   
       $year -= 4;
       $month++;
   
       return pack 'n*', $day | ($month << 5) | ($year << 9);
   }
   
   
   sub _hexdump
   {
       my $prefix = shift;   # What to print in front of each line
       my $data = shift;     # The data to dump
       my $maxlines = shift; # Max # of lines to dump
       my $offset;           # Offset of current chunk
   
       for ($offset = 0; $offset < length($data); $offset += 16)
       {
           my $hex;   # Hex values of the data
           my $ascii; # ASCII values of the data
           my $chunk; # Current chunk of data
   
           last if defined($maxlines) && ($offset >= ($maxlines * 16));
   
           $chunk = substr($data, $offset, 16);
   
           ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;
   
           ($ascii = $chunk) =~ y/\040-\176/./c;
   
           printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
       }
   }
   
   sub _bindump
   {
       my $prefix = shift;   # What to print in front of each line
       my $data = shift;     # The data to dump
       my $maxlines = shift; # Max # of lines to dump
       my $offset;           # Offset of current chunk
   
       for ($offset = 0; $offset < length($data); $offset += 8)
       {
           my $bin;   # binary values of the data
           my $ascii; # ASCII values of the data
           my $chunk; # Current chunk of data
   
           last if defined($maxlines) && ($offset >= ($maxlines * 8));
   
           $chunk = substr($data, $offset, 8);
   
           ($bin = $chunk) =~ s/./sprintf "%08b ", ord($&)/ges;
   
           ($ascii = $chunk) =~ y/\040-\176/./c;
   
           printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
       }
   }
   
   # Thanks to Jochen Hoenicke <hoenicke@gmail.com>
   # (one of the authors of Palm Keyring)
   # for these next two subs.
   
   # Usage pbkdf2(password, salt, iter, keylen, prf)
   # iter is number of iterations
   # keylen is length of generated key in bytes
   # prf is the pseudo random function (e.g. hmac_sha1)
   # returns the key.
   sub _pbkdf2($$$$$)
   {
       my ($password, $salt, $iter, $keylen, $prf) = @_;
       my ($k, $t, $u, $ui, $i);
       $t = "";
       for ($k = 1; length($t) <  $keylen; $k++) {
       $u = $ui = &$prf($salt.pack('N', $k), $password);
       for ($i = 1; $i < $iter; $i++) {
           $ui = &$prf($ui, $password);
           $u ^= $ui;
       }
       $t .= $u;
       }
       return substr($t, 0, $keylen);
   }
   
   sub _DES_odd_parity($) {
       my $key = $_[0];
       my ($r, $i);
       my @odd_parity = (
     1,  1,  2,  2,  4,  4,  7,  7,  8,  8, 11, 11, 13, 13, 14, 14,
    16, 16, 19, 19, 21, 21, 22, 22, 25, 25, 26, 26, 28, 28, 31, 31,
    32, 32, 35, 35, 37, 37, 38, 38, 41, 41, 42, 42, 44, 44, 47, 47,
    49, 49, 50, 50, 52, 52, 55, 55, 56, 56, 59, 59, 61, 61, 62, 62,
    64, 64, 67, 67, 69, 69, 70, 70, 73, 73, 74, 74, 76, 76, 79, 79,
    81, 81, 82, 82, 84, 84, 87, 87, 88, 88, 91, 91, 93, 93, 94, 94,
    97, 97, 98, 98,100,100,103,103,104,104,107,107,109,109,110,110,
   112,112,115,115,117,117,118,118,121,121,122,122,124,124,127,127,
   128,128,131,131,133,133,134,134,137,137,138,138,140,140,143,143,
   145,145,146,146,148,148,151,151,152,152,155,155,157,157,158,158,
   161,161,162,162,164,164,167,167,168,168,171,171,173,173,174,174,
   176,176,179,179,181,181,182,182,185,185,186,186,188,188,191,191,
   193,193,194,194,196,196,199,199,200,200,203,203,205,205,206,206,
   208,208,211,211,213,213,214,214,217,217,218,218,220,220,223,223,
   224,224,227,227,229,229,230,230,233,233,234,234,236,236,239,239,
   241,241,242,242,244,244,247,247,248,248,251,251,253,253,254,254);
       for ($i = 0; $i< length($key); $i++) {
       $r .= chr($odd_parity[ord(substr($key, $i, 1))]);
       }
       return $r;
   }
   
 1;  1;
 __END__  __END__
   
 =head1 NAME  =head1 NAME
   
 Palm::Keyring - Handler for Palm Keyring databases.  Palm::Keyring - Handler for Palm Keyring databases.
Line 381 
Line 1355 
 It has the standard Palm::PDB methods with 2 additional public methods.  It has the standard Palm::PDB methods with 2 additional public methods.
 Decrypt and Encrypt.  Decrypt and Encrypt.
   
 It currently supports the v4 Keyring databases.  The v5 databases from  It currently supports the v4 Keyring databases as well as
 the pre-release keyring-2.0 are not supported.  the pre-release v5 databases.  I am not completely happy with the interface
   for accessing v5 databases, so any suggestions on improvements on
   the interface are appreciated.
   
 This module doesn't store the decrypted content.  It only keeps it until it  This module doesn't store the decrypted content.  It only keeps it until it
 returns it to you or encrypts it.  returns it to you or encrypts it.
Line 391 
Line 1367 
   
     use Palm::PDB;      use Palm::PDB;
     use Palm::Keyring;      use Palm::Keyring;
     my $pdb = new Palm::PDB;  
       my $pass = 'password';
       my $file = 'Keys-Gtkr.pdb';
       my $pdb  = new Palm::PDB;
     $pdb->Load($file);      $pdb->Load($file);
     foreach my $rec (@{ $pdb->{'records'} }) {  
         print "$rec->{'plaintext'}->{'name'}\n";      foreach my $rec (@{ $pdb->{records} }) {
           my $acct = $pdb->Decrypt($rec, $pass);
           print $acct->{0}->{data}, ' - ', $acct->{1}->{data}, "\n";
     }      }
     $pdb->Decrypt($password);  
     # do something with the decrypted parts  
   
 =head1 SUBROUTINES/METHODS  =head1 SUBROUTINES/METHODS
   
 =head2 new  =head2 new
   
     $pdb = new Palm::Keyring([$password]);      $pdb = new Palm::Keyring([$password[, $version]]);
   
 Create a new PDB, initialized with the various Palm::Keyring fields  Create a new PDB, initialized with the various Palm::Keyring fields
 and an empty record list.  and an empty record list.
Line 411 
Line 1390 
 Use this method if you're creating a Keyring PDB from scratch otherwise you  Use this method if you're creating a Keyring PDB from scratch otherwise you
 can just use Palm::PDB::new() before calling Load().  can just use Palm::PDB::new() before calling Load().
   
   If you pass in a password, it will initalize the first record with the encrypted
   password.
   
   new() now also takes options in other formats
   
       $pdb = new Palm::Keyring({ key1 => value1,  key2 => value2 });
       $pdb = new Palm::Keyring( -key1 => value1, -key2 => value2);
   
   =over
   
   =item Supported options
   
   =over
   
   =item password
   
   The password used to initialize the database
   
   =item version
   
   The version of database to create.  Accepts either 4 or 5.  Currently defaults to 4.
   
   =item cipher
   
   The cipher to use.  Either the number or the name.
   
       0 => None
       1 => DES_EDE3
       2 => AES128
       3 => AES256
   
   =item iterations
   
   The number of iterations to encrypt with.
   
   =item options
   
   A hashref of the options that are set
   
   =back
   
   =back
   
   For v5 databases there are some additional appinfo fields set.
   These are set either on new() or Load().
   
       $pdb->{appinfo} = {
           # normal appinfo stuff described in L<Palm::StdAppInfo>
           cipher     => The index number of the cipher being used
           iter       => Number of iterations for the cipher
       };
   
   =head2 crypts
   
   Pass in the alias of the crypt to use, or the index.
   
   These only make sense for v5 databases.
   
   This is a function, not a method.
   
   $cipher can be 0, 1, 2, 3, None, DES_EDE3, AES128 or AES256.
   
       my $c = Palm::Keyring::crypt($cipher);
   
   $c is now:
   
       $c = {
           alias     => (None|DES_EDE3|AES128|AES256),
           name      => (None|DES_EDE3|Rijndael),
           keylen    => <key length of the cipher>,
           blocksize => <block size of the cipher>,
           default_iter => <default iterations for the cipher>,
       };
   
   If it is unable to find the crypt it will return undef.
   
   =head2 labels
   
   Pass in the id or the name of the label;
   
   This is a function, not a method.
   
       my $l = Palm::Keyring::labels($label);
   
   $l is now:
   
       $l = {
           id => 0,
           name => 'name',
       };
   
   If what you passed in was a number that doesn't have a name, it will return:
   
       $l => {
           id => $num_passed_in,
           name => undef,
       }
   
   If you pass in a name that it can't find, then it returns undef.
   
 =head2 Encrypt  =head2 Encrypt
   
     $pdb->Encrypt($rec, $acct, [$password]);      $pdb->Encrypt($rec, $acct[, $password[, $ivec]]);
   
 Encrypts an account into a record, either with the password previously  Encrypts an account into a record, either with the password previously
 used, or with a password that is passed.  used, or with a password that is passed.
   
 $rec is a record from $pdb->{'records'} or a newly generated record.  $ivec is the initialization vector to use to encrypt the record.  This is
 $acct is a hashref in the format below.  not used by v4 databases.  Normally this is not passed and is generated
   randomly.
   
   $rec is a record from $pdb->{records} or a new_Record().
   The $acct is a hashref in the format below.
   
     my $acct = {      my $acct = {
         account  => $account,          0 => {
         password => $password,              label    => 'name',
         notes    => $notes,              label_id => 0,
               font     => 0,
               data     => $name,
           1 => {
               label    => 'account',
               label_id => 1,
               font     => 0,
               data     => $account,
           },
           2 => {
               label    => 'password',
               label_id => 2,
               font     => 0,
               data     => $password,
           },
           3 => {
               label    => 'lastchange',
               label_id => 3,
               font     => 0,
               data     => $lastchange,
           },
           255 => {
               label    => 'notes',
               label_id => 255,
               font     => 0,
               data     => $notes,
           },
     };      };
   
   The account name is also stored in $rec->{decrypted}->{0}->{data} for both v4
   and v5 databases.
   
       $rec->{decrypted}->{0} => {
           label => 'name',
           data  => 'account name',
       };
   
   If you have changed anything other than the lastchange, or don't pass in a
   lastchange key, Encrypt() will generate a new lastchange date for you.
   
   If you pass in a lastchange field that is different than the one in the
   record, it will honor what you passed in.
   
   
 =head2 Decrypt  =head2 Decrypt
   
     my $acct = $pdb->Decrypt($rec[, $password]);      my $acct = $pdb->Decrypt($rec[, $password]);
   
 Decrypts the record and returns a hashref for the account as described  Decrypts the record and returns a reference for the account as described
 under Encrypt();  under Encrypt().
   
     foreach (0..$#{ $pdb->{'records'}) {      foreach my $rec (@{ $pdb->{records} }) {
         next if $_ == 0;          my $acct = $pdb->Decrypt($rec);
         my $rec = $pdb->{'records'}->[$_];  
         my $acct = $pdb->Decrypt($rec[, $password]);  
         # do something with $acct          # do something with $acct
     }      }
   
   
 =head2 Password  =head2 Password
   
     $pdb->Password([$password[, $new_password]]);      $pdb->Password([$password[, $new_password]]);
Line 452 
Line 1575 
 called new(), you only need to pass one password and it will set that as  called new(), you only need to pass one password and it will set that as
 the password.  the password.
   
 If nothing is passed, and there has been a password used before,  If nothing is passed, it forgets the password that it was remembering.
 it just verifies that the password was correct.  
   
   After a successful password verification the following fields are set
   
   For v4
   
       $pdb->{digest}   = the calculated digest used from the key;
       $pdb->{password} = the password that was passed in;
       $pdb->{encpassword} = the password as stored in the pdb;
   
   For v5
   
       $pdb->{appinfo} = {
           # As described under new() with these additional fields
           cipher     => The index number of the cipher being used
           iter       => Number of iterations for the cipher
           key        => The key that is calculated from the password
                         and salt and is used to decrypt the records.
           masterhash => the hash of the key that is stored in the
                         database.  Either set when Loading the database
                         or when setting a new password.
           salt       => the salt that is either read out of the database
                         or calculated when setting a new password.
       };
   
   =head2 Other overridden subroutines/methods
   
   =over
   
   =item Write
   
   For v4 databases it also puts back the record 0 for the encrypted password
   before writing it.
   
   =item ParseAppInfoBlock
   
   Converts the extra returned by Palm::StdAppInfo::ParseAppInfoBlock() into
   the following additions to $pdb->{appinfo}
   
       $pdb->{appinfo} = {
           cipher     => The index number of the cipher being used (Not v4)
           iter       => Number of iterations for the cipher (Not v4)
       };
   
   =item PackAppInfoBlock
   
   Reverses ParseAppInfoBlock before
   sending it on to Palm::StdAppInfo::PackAppInfoBlock()
   
   =item ParseRecord
   
   Adds some fields to a record from Palm::StdAppInfo::ParseRecord()
   
       $rec = {
           name       => Account name
           ivec       => The IV for the encrypted record.  (Not v4)
           encrypted  => the encrypted information
       };
   
   For v4 databases it also removes record 0 and moves the encrypted password
   to $self->{encpassword}.
   
   =item PackRecord
   
   Reverses ParseRecord and then sends it through Palm::StdAppInfo::PackRecord()
   
   =back
   
 =head1 DEPENDENCIES  =head1 DEPENDENCIES
   
 Palm::StdAppInfo  Palm::StdAppInfo
   
   B<For v4 databases>
   
 Digest::MD5  Digest::MD5
   
 Crypt::DES  Crypt::DES
   
 Readonly  B<For v5 databases>
   
   Digest::HMAC_SHA1
   
   Digest::SHA1
   
   Depending on how the database is encrypted
   
   Crypt::CBC - For any encryption but None
   
   Crypt::DES_EDE3 - DES_EDE3 encryption
   
   Crytp::Rijndael - AES encryption schemes
   
   =head1 THANKS
   
   I would like to thank the helpful Perlmonk shigetsu who gave me some great advice
   and helped me get my first module posted.  L<http://perlmonks.org/?node_id=596998>
   
   I would also like to thank
   Johan Vromans
   E<lt>jvromans@squirrel.nlE<gt> --
   L<http://www.squirrel.nl/people/jvromans>.
   He had his own Palm::KeyRing module that he posted a couple of days before
   mine was ready and he was kind enough to let me have the namespace as well
   as giving me some very helpful hints about doing a few things that I was
   unsure of.  He is really great.
   
   And finally,
   thanks to Jochen Hoenicke E<lt>hoenicke@gmail.comE<gt>
   (one of the authors of Palm Keyring)
   for getting me started on the v5 support as well as providing help
   and some subroutines.
   
 =head1 BUGS AND LIMITATIONS  =head1 BUGS AND LIMITATIONS
   
 Once this module is uploaded, you can  I am sure there are problems with this module.  For example, I have
   not done very extensive testing of the v5 databases.
   
   I am not sure I am 'require module' the best way, but I don't want to
   depend on modules that you don't need to use.
   
   I am not very happy with the data structures used by Encrypt() and
   Decrypt() for v5 databases, but I am not sure of a better way.
   
   The v4 compatibility mode does not insert a fake record 0 where
   normally the encrypted password is stored.
   
   The date validation for packing new dates is very poor.
   
   I have not gone through and standardized on how the module fails.  Some
   things fail with croak, some return undef, some may even fail silently.
   Nothing initializes a lasterr method or anything like that.  I need
   to fix all that before it is a 1.0 candidate.
   
 Please report any bugs or feature requests to  Please report any bugs or feature requests to
 C<bug-palm-keyring at rt.cpan.org>, or through the web interface at  C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
 L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be  L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
Line 475 
Line 1715 
   
 =head1 AUTHOR  =head1 AUTHOR
   
 Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>  Andrew Fresh E<lt>andrew@cpan.orgE<gt>
   
 =head1 LICENSE AND COPYRIGHT  =head1 LICENSE AND COPYRIGHT
   
Line 492 
Line 1732 
   
 The Keyring for Palm OS website:  The Keyring for Palm OS website:
 L<http://gnukeyring.sourceforge.net/>  L<http://gnukeyring.sourceforge.net/>
   
   The HACKING guide for palm keyring databases:
   L<http://gnukeyring.cvs.sourceforge.net/*checkout*/gnukeyring/keyring/HACKING>
   
   Johan Vromans also has a wxkeyring app that now uses this module, available
   from his website at L<http://www.vromans.org/johan/software/sw_palmkeyring.html>
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.46
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>