[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.48 and 1.65

version 1.48, 2007/09/12 03:44:36 version 1.65, 2011/09/19 04:23:37
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
 # $RedRiver: Keyring.pm,v 1.47 2007/09/12 00:30:10 andrew Exp $  # $RedRiver: Keyring.pm,v 1.62 2008/09/19 06:01:00 andrew Exp $
 ########################################################################  ########################################################################
 # Keyring.pm *** Perl class for Keyring for Palm OS databases.  # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #  #
Line 15 
Line 15 
 use strict;  use strict;
 use warnings;  use warnings;
   
   require 5.006_001;
   
 use Carp;  use Carp;
   
 use base qw/ Palm::StdAppInfo /;  use base qw/ Palm::StdAppInfo /;
Line 57 
Line 59 
         blocksize => 16,          blocksize => 16,
         default_iter => 250,          default_iter => 250,
     },      },
       {   # Only for testing
           alias     => 'TESTING',
           name      => 'Testing',
           keylen    => 0,
           blocksize => 0,
           default_iter => 0,
       },
 );  );
   
 my %LABELS = (  my %LABELS = (
Line 83 
Line 92 
 );  );
   
   
 our $VERSION = '0.96_01';  our $VERSION = '0.96_07';
   
 sub new  sub new
 {  {
Line 108 
Line 117 
         else {          else {
             $options->{password} = shift;              $options->{password} = shift;
             $options->{version}  = shift;              $options->{version}  = shift;
               $options->{cipher}   = shift;
         }          }
     }      }
   
Line 139 
Line 149 
         $self->{appinfo}->{iter}   ||= $self->{options}->{iterations};          $self->{appinfo}->{iter}   ||= $self->{options}->{iterations};
     };      };
   
       if ( defined $options->{file} ) {
           $self->Load($options->{file});
       }
   
     if ( defined $options->{password} ) {      if ( defined $options->{password} ) {
         $self->Password($options->{password});          $self->Password($options->{password});
     }      }
Line 217 
Line 231 
         }          }
     }      }
   
     my $rc = $self->SUPER::Write(@_);      my @rc = $self->SUPER::Write(@_);
   
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         shift @{ $self->{records} };          shift @{ $self->{records} };
     }      }
   
     return $rc;      return @rc;
 }  }
   
 # ParseRecord  # ParseRecord
Line 233 
Line 247 
     my $self     = shift;      my $self     = shift;
   
     my $rec = $self->SUPER::ParseRecord(@_);      my $rec = $self->SUPER::ParseRecord(@_);
     return $rec if ! exists $rec->{data};      return $rec if !(defined $rec->{data} && length $rec->{data} );
   
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         # skip the first record because it contains the password.          # skip the first record because it contains the password.
Line 241 
Line 255 
             $self->{encpassword} = $rec->{data};              $self->{encpassword} = $rec->{data};
             return '__DELETE_ME__';              return '__DELETE_ME__';
         }          }
   
         if ($self->{records}->[0] eq '__DELETE_ME__') {          if ($self->{records}->[0] eq '__DELETE_ME__') {
             shift @{ $self->{records} };              shift @{ $self->{records} };
         }          }
Line 270 
Line 284 
         $rec->{encrypted} = substr $extra, $blocksize;          $rec->{encrypted} = substr $extra, $blocksize;
   
     } else {      } else {
           # XXX Can never get here to test, ParseAppInfoBlock is always run
           # XXX first by Load().
         croak "Unsupported Version $self->{version}";          croak "Unsupported Version $self->{version}";
         return;  
     }      }
   
     return $rec;      return $rec;
Line 288 
Line 303 
         if ($rec->{encrypted}) {          if ($rec->{encrypted}) {
             my $name = $rec->{plaintext}->{0}->{data} || $EMPTY;              my $name = $rec->{plaintext}->{0}->{data} || $EMPTY;
             $rec->{data} = join $NULL, $name, $rec->{encrypted};              $rec->{data} = join $NULL, $name, $rec->{encrypted};
             delete $rec->{plaintext};  
             delete $rec->{encrypted};  
         }          }
   
     } elsif ($self->{version} == 5) {      }
       elsif ($self->{version} == 5) {
           croak 'No encrypted data in record' if !defined $rec->{encrypted};
           croak 'No ivec!' if !$rec->{ivec};
   
         my $field;          my $field;
         if ($rec->{plaintext}->{0}) {          if ($rec->{plaintext}->{0}) {
             $field = $rec->{plaintext}->{0};              $field = $rec->{plaintext}->{0};
Line 308 
Line 325 
   
         $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};          $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};
   
     } else {      }
       else {
         croak "Unsupported Version $self->{version}";          croak "Unsupported Version $self->{version}";
     }      }
       # XXX Should I?
       #delete $rec->{plaintext};
       #delete $rec->{encrypted};
   
       croak 'No data in record to pack' if !$rec->{data};
   
     return $self->SUPER::PackRecord($rec, @_);      return $self->SUPER::PackRecord($rec, @_);
 }  }
   
Line 338 
Line 361 
         # Nothing extra for version 4          # Nothing extra for version 4
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         _parse_appinfo_v5($appinfo) || return;          _parse_appinfo_v5($appinfo);
   
     } else {      } else {
         croak "Unsupported Version $self->{version}";          croak "Unsupported Version $self->{version}";
Line 351 
Line 374 
 {  {
     my $appinfo = shift;      my $appinfo = shift;
   
     if (! exists $appinfo->{other}) {      croak 'Corrupt appinfo? no {other}' if ! $appinfo->{other};
         # XXX Corrupt appinfo?  
         return;  
     }  
   
     my $unpackstr      my $unpackstr
         = ("C1" x 8)  # 8 uint8s in an array for the salt          = ("C1" x 8)  # 8 uint8s in an array for the salt
Line 421 
Line 441 
 sub Encrypt  sub Encrypt
 {  {
     my $self = shift;      my $self = shift;
     my $rec  = shift;      my $rec  = shift || croak('Needed parameter [record] not passed!');
     my $pass = shift || $self->{password};      my $pass = shift || $self->{password};
     my $data = shift || $rec->{plaintext};      my $data = shift || $rec->{plaintext};
     my $ivec = shift;      my $ivec = shift;
   
     if ( ! $pass && ! $self->{appinfo}->{key}) {      $self->_password_verify($pass);
         croak("password not set!\n");  
     }  
   
     if ( ! $rec) {      if ( !$data ) { croak('Needed parameter [plaintext] not passed!'); }
         croak("Needed parameter 'record' not passed!\n");  
     }  
   
     if ( ! $data) {  
         croak("Needed 'plaintext' not passed!\n");  
     }  
   
     if ( $pass && ! $self->Password($pass)) {  
         croak("Incorrect Password!\n");  
     }  
   
     my $acct;      my $acct;
     if ($rec->{encrypted}) {      if ($rec->{encrypted}) {
         $acct = $self->Decrypt($rec, $pass);          $acct = $self->Decrypt($rec, $pass);
Line 457 
Line 465 
             lastchange => $data->{3}->{data},              lastchange => $data->{3}->{data},
             notes      => $data->{255}->{data},              notes      => $data->{255}->{data},
         };          };
         my $acctv4 = {          my $acctv4 = {};
             name       => $acct->{0}->{data},          if ($acct) {
             account    => $acct->{1}->{data},              $acctv4 = {
             password   => $acct->{2}->{data},                  name       => $acct->{0}->{data},
             lastchange => $acct->{3}->{data},                  account    => $acct->{1}->{data},
             notes      => $acct->{255}->{data},                  password   => $acct->{2}->{data},
         };                  lastchange => $acct->{3}->{data},
                   notes      => $acct->{255}->{data},
               };
           }
         $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});          $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
Line 473 
Line 484 
             $self->{appinfo}->{cipher},              $self->{appinfo}->{cipher},
             $ivec,              $ivec,
         );          );
         if (defined $ivec) {          $rec->{ivec} = $ivec if $ivec;
             $rec->{ivec} = $ivec;  
         }  
   
     } else {      } else {
         croak "Unsupported Version $self->{version}";          croak "Unsupported Version $self->{version}";
     }      }
   
     $rec->{plaintext}->{0} = $data->{0};      $rec->{plaintext} = $data;
   
     if ($encrypted) {      if ($encrypted ne '1') {
         if ($encrypted eq '1') {  
             return 1;  
         }  
   
         $rec->{attributes}{Dirty} = 1;          $rec->{attributes}{Dirty} = 1;
         $rec->{attributes}{dirty} = 1;          $rec->{attributes}{dirty} = 1;
         $rec->{encrypted} = $encrypted;          $rec->{encrypted} = $encrypted;
   
         return 1;  
     } else {  
         return;  
     }      }
   
       return 1;
 }  }
   
 sub _encrypt_v4  sub _encrypt_v4
Line 578 
Line 581 
     my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);      my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
   
     if (! defined $ivec) {      if (! defined $ivec) {
         $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});          if (!$c->{blocksize}) {
               $ivec = $EMPTY;
           }
           else {
               while (! $ivec) {
                   $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});
               }
           }
     }      }
   
     my $changed = 0;      my $changed = 0;
Line 586 
Line 596 
     if ($new->{3}->{data}) {      if ($new->{3}->{data}) {
         $need_newdate = 0;          $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 {      if ($old) {
             my $n = join ':', sort %{ $new->{$k} };          foreach my $k (keys %{ $new }) {
             my $o = join ':', sort %{ $old->{$k} };              if (! $old->{$k} ) {
             if ($n ne $o) {  
                 $changed = 1;                  $changed = 1;
                   last;
               }
               if (! $new->{$k}) {
                   $changed = 1;
                   last;
             }              }
               elsif ($k == 3) {
                   if (! $new->{$k}->{data} && $old->{$k}->{data} ) {
                       $changed = 1;
                       last;
                   }
   
                   my %n = %{ $new->{$k}->{data} };
                   my %o = %{ $old->{$k}->{data} };
   
                   foreach (qw( day month year )) {
                       $n{$_} ||= 0;
                       $o{$_} ||= 0;
                   }
   
                   if (
                       $n{day}   == $o{day}   &&
                       $n{month} == $o{month} &&
                       $n{year}  == $o{year}
                   ) {
                       $need_newdate = 1;
                   }
                   else {
                       $changed = 1;
                       last;
                   }
   
               }
               else {
                   my $n = join ':', sort %{ $new->{$k} };
                   my $o = join ':', sort %{ $old->{$k} };
                   if ($n ne $o) {
                       $changed = 1;
                       last;
                   }
               }
         }          }
     }      }
       else {
           $changed = 1;
       }
   
     return 1, 0 if $changed == 0;      return 1 if $changed == 0;
   
     if ($need_newdate) {      if ($need_newdate) {
         my ($day, $month, $year) = (localtime)[3,4,5];          my ($day, $month, $year) = (localtime)[3,4,5];
Line 631 
Line 671 
   
     my $plaintext;      my $plaintext;
     foreach my $k (keys %{ $new }) {      foreach my $k (keys %{ $new }) {
           next if $new->{$k}->{label_id} == 0;
         $plaintext .= _pack_field($new->{$k});          $plaintext .= _pack_field($new->{$k});
     }      }
       $plaintext .= chr(0xff) x 2;
   
       #print "CRYPT(e): $c->{name} [$cipher]\n";
     my $encrypted;      my $encrypted;
     if ($c->{name} eq 'None') {      if ($c->{name} eq 'None') {
         # do nothing          # do nothing
Line 650 
Line 693 
             -blocksize   => $c->{blocksize},              -blocksize   => $c->{blocksize},
             -header      => 'none',              -header      => 'none',
             -padding     => 'oneandzeroes',              -padding     => 'oneandzeroes',
         );          ) || croak("Unable to set up encryption!");
   
         if (! $c) {  
             croak("Unable to set up encryption!");  
         }  
   
         $encrypted = $cbc->encrypt($plaintext);          $encrypted = $cbc->encrypt($plaintext);
   
     } else {      } else {
Line 673 
Line 712 
     my $rec  = shift;      my $rec  = shift;
     my $pass = shift || $self->{password};      my $pass = shift || $self->{password};
   
     if ( ! $pass && ! $self->{appinfo}->{key}) {      if ( ! $rec) { croak('Needed parameter [record] not passed!'); }
         croak("password not set!\n");      if ( ! $rec->{encrypted} ) { croak('No encrypted content!'); }
     }  
   
     if ( ! $rec) {      $self->_password_verify($pass);
         croak("Needed parameter 'record' not passed!\n");  
     }  
   
     if ( $pass && ! $self->Password($pass)) {  
         croak("Invalid Password!\n");  
     }  
   
     if ( ! $rec->{encrypted} ) {  
         croak("No encrypted content!");  
     }  
   
     my $plaintext;      my $plaintext;
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         $self->{digest} ||= _calc_keys( $pass );          $self->{digest} ||= _calc_keys( $pass );
Line 732 
Line 760 
         croak "Unsupported Version $self->{version}";          croak "Unsupported Version $self->{version}";
     }      }
   
     if ($plaintext) {      $rec->{plaintext} = $plaintext;
         $rec->{plaintext} = $plaintext;      return $plaintext;
         return $plaintext;  
     }  
     return;  
 }  }
   
 sub _decrypt_v4  sub _decrypt_v4
Line 750 
Line 775 
   
     my $modified;      my $modified;
     if ($packed_date) {      if ($packed_date) {
           #print _hexdump('DATE:', $packed_date);
         $modified = _parse_keyring_date($packed_date);          $modified = _parse_keyring_date($packed_date);
     }      }
   
Line 773 
Line 799 
   
     my $plaintext;      my $plaintext;
   
       #print "CRYPT(d): $c->{name} [$cipher]\n";
     if ($c->{name} eq 'None') {      if ($c->{name} eq 'None') {
         # do nothing          # do nothing
         $plaintext = $encrypted;          $plaintext = $encrypted;
   
     } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {      }
       elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
         require Crypt::CBC;          require Crypt::CBC;
         my $cbc = Crypt::CBC->new(          my $cbc = Crypt::CBC->new(
             -key         => $key,              -key         => $key,
Line 788 
Line 816 
             -blocksize   => $c->{blocksize},              -blocksize   => $c->{blocksize},
             -header      => 'none',              -header      => 'none',
             -padding     => 'oneandzeroes',              -padding     => 'oneandzeroes',
         );          ) || croak("Unable to set up decryption!");
   
         if (! $c) {  
             croak("Unable to set up encryption!");  
         }  
         my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};          my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};
         $encrypted .= $NULL x $len;          $encrypted .= $NULL x $len;
   
         $plaintext  = $cbc->decrypt($encrypted);          $plaintext  = $cbc->decrypt($encrypted);
   
     } else {  
         croak "Unsupported Crypt $c->{name}";  
     }      }
       else {
           croak "Unsupported Crypt $c->{name} in decrypt";
       }
   
     my %fields;      my %fields;
     while ($plaintext) {      while ($plaintext) {
         my $field;          my $field;
         ($field, $plaintext) = _parse_field($plaintext);          ($field, $plaintext) = _parse_field($plaintext);
         if (! $field) {          last if ! $field;
             last;  
         }  
         $fields{ $field->{label_id} } = $field;          $fields{ $field->{label_id} } = $field;
     }      }
   
Line 838 
Line 863 
     if ($new_pass) {      if ($new_pass) {
         my @accts = ();          my @accts = ();
         foreach my $rec (@{ $self->{records} }) {          foreach my $rec (@{ $self->{records} }) {
             my $acct = $self->Decrypt($rec, $pass);              my $acct = $self->Decrypt($rec, $pass)
             if ( ! $acct ) {                  || croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");
                 croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");  
             }  
             push @accts, $acct;              push @accts, $acct;
         }          }
   
         if ( ! $self->_password_update($new_pass)) {          $self->_password_update($new_pass);
             croak("Couldn't set new password!");  
         }  
         $pass = $new_pass;          $pass = $new_pass;
   
         foreach my $i (0..$#accts) {          foreach my $i (0..$#accts) {
Line 857 
Line 878 
         }          }
     }      }
   
       return $self->_password_verify($pass);
   }
   
   sub _password_verify {
       my $self = shift;
       my $pass = shift;
       if (!defined $pass) {
           $pass = $self->{password};
       }
   
       if ( !$pass ) {
           croak("Password not set!\n");
       }
   
     if (defined $self->{password} && $pass eq $self->{password}) {      if (defined $self->{password} && $pass eq $self->{password}) {
         # already verified this password          # already verified this password
         return 1;          return 1;
     }      }
   
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         my $valid = _password_verify_v4($pass, $self->{encpassword});          _password_verify_v4($pass, $self->{encpassword});
   
         # May as well generate the keys we need now,          # May as well generate the keys we need now,
         # since we know the password is right          # since we know the password is right
         if ($valid) {          $self->{digest}   = _calc_keys($pass);
             $self->{digest} = _calc_keys($pass);          $self->{password} = $pass;
             if ($self->{digest} ) {  
                 $self->{password} = $pass;          return 1;
                 return 1;      }
             }      elsif ($self->{version} == 5) {
         }          _password_verify_v5($self->{appinfo}, $pass);
     } elsif ($self->{version} == 5) {          $self->{password} = $pass;
         return _password_verify_v5($self->{appinfo}, $pass);          return 1;
     } else {  
         croak "Unsupported version $self->{version}";  
     }      }
   
     return;      croak "Unsupported Version $self->{version}";
 }  }
   
 sub _password_verify_v4  sub _password_verify_v4
Line 891 
Line 924 
     my $pass = shift;      my $pass = shift;
     my $data = shift;      my $data = shift;
   
     if (! $pass) { croak('No password specified!'); };      if (! $pass) { croak('No password specified!'); }
       if (! $data) { croak('No encrypted password in file!'); }
   
     # XXX die "No encrypted password in file!" unless defined $data;  
     if ( ! defined $data) { return; };  
   
     $data =~ s/$NULL$//xm;      $data =~ s/$NULL$//xm;
   
     my $salt = substr $data, 0, $kSalt_Size;      my $salt = substr $data, 0, $kSalt_Size;
Line 903 
Line 934 
     my $msg = $salt . $pass;      my $msg = $salt . $pass;
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );      $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
   
     my $digest = md5($msg);      my $digest = md5($msg) || croak('MD5 Failed');
   
     if ($data ne $salt . $digest ) {      if ($data ne $salt . $digest ) {
         return;          croak("Incorrect Password!");
     }      }
   
     return 1;      return 1;
Line 933 
Line 964 
     #print "Hash: '". $hash . "'\n";      #print "Hash: '". $hash . "'\n";
     #print "Hash: '". $appinfo->{masterhash} . "'\n";      #print "Hash: '". $appinfo->{masterhash} . "'\n";
   
     if ($appinfo->{masterhash} eq $hash) {      if ($appinfo->{masterhash} && $appinfo->{masterhash} ne $hash) {
         $appinfo->{key} = $key;          croak('Incorrect Password');
     } else {  
         return;  
     }      }
       $appinfo->{key} = $key;
     return $key;      return 1;
 }  }
   
   
Line 955 
Line 984 
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         my $data = _password_update_v4($pass, @_);          my $data = _password_update_v4($pass, @_);
   
         if (! $data) {          if (! $data) { croak "Failed to update password!"; }
             carp("Failed  to update password!");  
             return;  
         }  
   
         # AFAIK the thing we use to test the password is          # AFAIK the thing we use to test the password is
         #     always in the first entry          #     always in the first entry
Line 967 
Line 993 
         $self->{digest}   = _calc_keys( $self->{password} );          $self->{digest}   = _calc_keys( $self->{password} );
   
         return 1;          return 1;
       }
     } elsif ($self->{version} == 5) {      elsif ($self->{version} == 5) {
         my $cipher  = shift || $self->{appinfo}->{cipher};          my $cipher  = shift || $self->{appinfo}->{cipher};
         my $iter    = shift || $self->{appinfo}->{iter};          my $iter    = shift || $self->{appinfo}->{iter};
         my $salt    = shift || 0;          my $salt    = shift || 0;
Line 977 
Line 1003 
             $self->{appinfo}, $pass, $cipher, $iter, $salt              $self->{appinfo}, $pass, $cipher, $iter, $salt
         );          );
   
         if (! $hash) {          if (! $hash) { croak "Failed to update password!"; }
             carp("Failed  to update password!");  
             return;  
         }  
   
           $self->{password} = $pass;
   
         return 1;          return 1;
     } else {  
         croak("Unsupported version ($self->{version})");  
     }      }
   
     return;      croak "Unsupported Version $self->{version}";
 }  }
   
 sub _password_update_v4  sub _password_update_v4
Line 997 
Line 1020 
   
     my $pass = shift;      my $pass = shift;
   
     if (! defined $pass) { croak('No password specified!'); };      croak('No password specified!') if ! defined $pass;
   
     my $salt;      my $salt;
     for ( 1 .. $kSalt_Size ) {      for ( 1 .. $kSalt_Size ) {
Line 1008 
Line 1031 
   
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );      $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
   
     my $digest = md5($msg);      my $digest = md5($msg) || croak('MD5 failed');
   
     my $data = $salt . $digest;    # . "\0";      my $data = $salt . $digest;    # . "\0";
   
Line 1022 
Line 1045 
     my $cipher  = shift;      my $cipher  = shift;
     my $iter    = shift;      my $iter    = shift;
   
     # I thought this needed to be 'blocksize', but apparently not.      # I thought $length needed to be 'blocksize', but apparently not.
     #my $length  = $CRYPTS[ $cipher ]{blocksize};      #my $length  = $CRYPTS[ $cipher ]{blocksize};
     my $length  = 8;      my $length  = 8;
     my $salt    = shift || pack("C*",map {rand(256)} 1..$length);      my $salt    = shift || pack("C*",map {rand(256)} 1..$length);
Line 1049 
Line 1072 
     my ($pass) = @_;      my ($pass) = @_;
     $pass ||= $self->{password};      $pass ||= $self->{password};
   
     if ( $pass && ! $self->Password($pass)) {      $self->_password_verify($pass);
         croak("Invalid Password!\n");  
     }  
   
     foreach my $rec (@{ $self->{records} }) {      foreach my $rec (@{ $self->{records} }) {
         $self->Decrypt($rec);          $self->Decrypt($rec);
Line 1080 
Line 1101 
   
 sub _calc_keys  sub _calc_keys
 {  {
       require Digest::MD5;
       import Digest::MD5 qw(md5);
   
     my $pass = shift;      my $pass = shift;
     if (! defined $pass) { croak('No password defined!'); };      if (! defined $pass) { croak('No password defined!'); };
   
Line 1112 
Line 1136 
     import  Digest::SHA1 qw(sha1);      import  Digest::SHA1 qw(sha1);
   
     my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );      my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );
     if ($dop) { $key = _DES_odd_parity($key); }      $key = _DES_odd_parity($key) if $dop;
   
     my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));      my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
   
Line 1176 
Line 1200 
   
     my ($len) = unpack "n", $field;      my ($len) = unpack "n", $field;
     if ($len + 4 > length $field) {      if ($len + 4 > length $field) {
         return undef, $field;          return (undef, $field);
     }      }
     my $unpackstr = "x2 C1 C1 A$len";      my $unpackstr = "x2 C1 C1 A$len";
     my $offset    =   2 +1 +1 +$len;      my $offset    =   2 +1 +1 +$len;
Line 1285 
Line 1309 
     my $maxlines = shift; # Max # of lines to dump      my $maxlines = shift; # Max # of lines to dump
     my $offset;           # Offset of current chunk      my $offset;           # Offset of current chunk
   
       my @lines;
   
     for ($offset = 0; $offset < length($data); $offset += 16)      for ($offset = 0; $offset < length($data); $offset += 16)
     {      {
         my $hex;   # Hex values of the data          my $hex;   # Hex values of the data
Line 1299 
Line 1325 
   
         ($ascii = $chunk) =~ y/\040-\176/./c;          ($ascii = $chunk) =~ y/\040-\176/./c;
   
         printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;          push @lines, sprintf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
     }      }
       return wantarray ? @lines : \@lines;
 }  }
   
 sub _bindump  sub _bindump
Line 1310 
Line 1337 
     my $maxlines = shift; # Max # of lines to dump      my $maxlines = shift; # Max # of lines to dump
     my $offset;           # Offset of current chunk      my $offset;           # Offset of current chunk
   
       my @lines;
   
     for ($offset = 0; $offset < length($data); $offset += 8)      for ($offset = 0; $offset < length($data); $offset += 8)
     {      {
         my $bin;   # binary values of the data          my $bin;   # binary values of the data
Line 1324 
Line 1353 
   
         ($ascii = $chunk) =~ y/\040-\176/./c;          ($ascii = $chunk) =~ y/\040-\176/./c;
   
         printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;          push @lines, sprintf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
     }      }
       return wantarray ? @lines : \@lines;
 }  }
   
 # Thanks to Jochen Hoenicke <hoenicke@gmail.com>  # Thanks to Jochen Hoenicke <hoenicke@gmail.com>
Line 1337 
Line 1367 
 # keylen is length of generated key in bytes  # keylen is length of generated key in bytes
 # prf is the pseudo random function (e.g. hmac_sha1)  # prf is the pseudo random function (e.g. hmac_sha1)
 # returns the key.  # returns the key.
 sub _pbkdf2($$$$$)  sub _pbkdf2
 {  {
     my ($password, $salt, $iter, $keylen, $prf) = @_;      my ($password, $salt, $iter, $keylen, $prf) = @_;
     my ($k, $t, $u, $ui, $i);      my ($k, $t, $u, $ui, $i);
Line 1353 
Line 1383 
     return substr($t, 0, $keylen);      return substr($t, 0, $keylen);
 }  }
   
 sub _DES_odd_parity($) {  sub _DES_odd_parity {
     my $key = $_[0];      my $key = $_[0];
     my ($r, $i);      my ($r, $i);
     my @odd_parity = (      my @odd_parity = (
Line 1391 
Line 1421 
 parses Keyring for Palm OS databases.  See  parses Keyring for Palm OS databases.  See
 L<http://gnukeyring.sourceforge.net/>.  L<http://gnukeyring.sourceforge.net/>.
   
 It has the standard Palm::PDB methods with 2 additional public methods.  It has the standard Palm::PDB methods with 4 additional public methods.
 Decrypt and Encrypt.  Unlock, Lock, Decrypt and Encrypt.
   
 It currently supports the v4 Keyring databases as well as  It currently supports the v4 Keyring databases as well as
 the pre-release v5 databases.  I am not completely happy with the interface  the pre-release v5 databases.
 for accessing v5 databases, so any suggestions on improvements on  
 the interface are appreciated.  
   
 This module doesn't store the plaintext content.  It only keeps it until it  
 returns it to you or encrypts it.  
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
     use Palm::PDB;      use Palm::PDB;
Line 1412 
Line 1437 
     my $pdb  = new Palm::PDB;      my $pdb  = new Palm::PDB;
     $pdb->Load($file);      $pdb->Load($file);
   
       $pdb->Unlock($pass);
     foreach my $rec (@{ $pdb->{records} }) {      foreach my $rec (@{ $pdb->{records} }) {
         my $plaintext = $pdb->Decrypt($rec, $pass);          print $rec->{plaintext}->{0}->{data}, ' - ',
         print $plaintext->{0}->{data}, ' - ', $plaintext->{1}->{data}, "\n";                $rec->{plaintext}->{1}->{data}, "\n";
     }      }
       $pdb->Lock();
   
 =head1 SUBROUTINES/METHODS  =head1 SUBROUTINES/METHODS
   
 =head2 new  =head2 new
   
     $pdb = new Palm::Keyring([$password[, $version]]);      $pdb = new Palm::Keyring([$password[, $version[, $cipher]]]);
   
 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 1429 
Line 1456 
 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  If you pass in a password, it will initalize the database with the encrypted
 password.  password.
   
 new() now also takes options in other formats  new() now also takes options in other formats
Line 1453 
Line 1480 
   
 =item cipher  =item cipher
   
 The cipher to use.  Either the number or the name.  The cipher to use.  Either the number or the name.  Only used by v5 datbases.
   
     0 => None      0 => None
     1 => DES_EDE3      1 => DES_EDE3
Line 1462 
Line 1489 
   
 =item iterations  =item iterations
   
 The number of iterations to encrypt with.  The number of iterations to encrypt with.  Only used by somy crypts in v5 databases.
   
 =item options  =item file
   
 A hashref of the options that are set  The name of a file to Load().  This will override many of the other options.
   
 =back  =back
   
Line 1507 
Line 1534 
   
 =head2 labels  =head2 labels
   
 Pass in the id or the name of the label;  Pass in the id or the name of the label.  The label id is used as a key
   to the different parts of the records.
   See Encrypt() for details on where the label is used.
   
 This is a function, not a method.  This is a function, not a method.
   
Line 1531 
Line 1560 
   
 =head2 Encrypt  =head2 Encrypt
   
   =head3 B<!!! IMPORTANT !!!>  The order of the arguments to Encrypt has
   changed.  $password and $plaintext used to be swapped.  They changed
   because you can now set $rec->{plaintext} and not pass in $plaintext so
   $password is more important.
   
     $pdb->Encrypt($rec[, $password[, $plaintext[, $ivec]]]);      $pdb->Encrypt($rec[, $password[, $plaintext[, $ivec]]]);
   
 Encrypts an account into a record, either with the password previously  Encrypts an account into a record, either with the password previously
Line 1565 
Line 1599 
             label    => 'lastchange',              label    => 'lastchange',
             label_id => 3,              label_id => 3,
             font     => 0,              font     => 0,
             data     => $lastchange,              data     => {
                   year => $year, # usually the year - 1900
                   mon  => $mon,  # range 0-11
                   day  => $day,  # range 1-31
               },
         },          },
         255 => {          255 => {
             label    => 'notes',              label    => 'notes',
Line 1575 
Line 1613 
         },          },
     };      };
   
 The account name is also stored in $rec->{plaintext}->{0}->{data} for both v4  The account name is stored in $rec->{plaintext}->{0}->{data} for both v4
 and v5 databases.  and v5 databases even when the record has not been Decrypt()ed.
   
     $rec->{plaintext}->{0} => {      $rec->{plaintext}->{0} => {
         label    => 'name',          label    => 'name',
Line 1600 
Line 1638 
     my $plaintext = $pdb->Decrypt($rec[, $password]);      my $plaintext = $pdb->Decrypt($rec[, $password]);
   
 Decrypts the record and returns a reference for the plaintext account as  Decrypts the record and returns a reference for the plaintext account as
 described under L<Encrypt>.  described under Encrypt().
 Also sets $rec->{plaintext} with the same information as $plaintext as  Also sets $rec->{plaintext} with the same information as $plaintext as
 described in L<Encrypt>.  described in Encrypt().
   
     foreach my $rec (@{ $pdb->{records} }) {      foreach my $rec (@{ $pdb->{records} }) {
         my $plaintext = $pdb->Decrypt($rec);          my $plaintext = $pdb->Decrypt($rec);
Line 1668 
Line 1706 
   
 Unsets $rec->{plaintext} for all records and unsets the saved password.  Unsets $rec->{plaintext} for all records and unsets the saved password.
   
 This does NOT L<Encrypt> any of the records before clearing them, so if  This does NOT Encrypt() any of the records before clearing them, so if
 you are not careful you will lose information.  you are not careful you will lose information.
   
 B<CAVEAT!> This only does "delete $rec->{plaintext}" and the same for the  B<CAVEAT!> This only does "delete $rec->{plaintext}" and the same for the
Line 1774 
Line 1812 
 I am not sure I am 'require module' the best way, but I don't want to  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.  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 date validation for packing new dates is very poor.  The date validation for packing new dates is very poor.
   
 I have not gone through and standardized on how the module fails.  Some  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.  things fail with croak, some return undef, some may even fail silently.
 Nothing initializes a lasterr method or anything like that.  I need  Nothing initializes a lasterr method or anything like that.
 to fix all that before it is a 1.0 candidate.  
   This module does not do anything special with the plaintext data.  It SHOULD
   treat it somehow special so that it can't be found in RAM or in a swap file
   anywhere.  I don't have a clue how to do this.
   
   I need to fix all this 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
Legend:
Removed from v.1.48  
changed lines
  Added in v.1.65
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>