[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.28 and 1.31

version 1.28, 2007/02/18 05:50:25 version 1.31, 2007/02/19 02:55:35
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
 # $RedRiver: Keyring.pm,v 1.27 2007/02/10 16:21:28 andrew Exp $  # $RedRiver: Keyring.pm,v 1.30 2007/02/19 01:37:10 andrew Exp $
 ########################################################################  ########################################################################
 # Keyring.pm *** Perl class for Keyring for Palm OS databases.  # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #  #
Line 16 
Line 16 
 use warnings;  use warnings;
   
 use Carp;  use Carp;
   use Data::Dumper;
   
 use base qw/ Palm::StdAppInfo /;  use base qw/ Palm::StdAppInfo /;
   
Line 39 
Line 40 
         name      => 'None',          name      => 'None',
         keylen    => 8,          keylen    => 8,
         blocksize => 1,          blocksize => 1,
           default_iter => 500,
     },      },
     { # DES-EDE3      { # DES-EDE3
         name      => 'DES_EDE3',          name      => 'DES_EDE3',
         keylen    => 24,          keylen    => 24,
         blocksize =>  8,          blocksize =>  8,
         DES_odd_parity => 1,          DES_odd_parity => 1,
           default_iter => 1000,
     },      },
     { # AES128      { # AES128
         name      => 'Rijndael',          name      => 'Rijndael',
         keylen    => 16,          keylen    => 16,
         blocksize => 16,          blocksize => 16,
           default_iter => 100,
     },      },
     { # AES256      { # AES256
         name      => 'Rijndael',          name      => 'Rijndael',
         keylen    => 32,          keylen    => 32,
         blocksize => 16,          blocksize => 16,
           default_iter => 250,
     },      },
 );  );
   
Line 72 
Line 77 
     }      }
   
     # CGI style arguments      # CGI style arguments
     elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {      elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {
       my %tmp = @_;        my %tmp = @_;
       while ( my($key,$value) = each %tmp) {        while ( my($key,$value) = each %tmp) {
         $key =~ s/^-//;          $key =~ s/^-//;
Line 103 
Line 108 
     # Set options      # Set options
     $self->{options} = $options;      $self->{options} = $options;
   
       # Set defaults
       if ($self->{version} == 5) {
           $self->{options}->{cipher} ||= 0; # 'None'
           $self->{options}->{iterations} ||=
               $CRYPTS[ $self->{options}->{cipher} ]{default_iter};
   
          $self->{appinfo}->{cipher} ||= $self->{options}->{cipher};
          $self->{appinfo}->{iter}   ||= $self->{options}->{iterations};
       };
   
     if ( defined $options->{password} ) {      if ( defined $options->{password} ) {
         $self->Password($options->{password});          $self->Password($options->{password});
     }      }
Line 116 
Line 131 
     return 1;      return 1;
 }  }
   
 # PackRecord  # ParseRecord
   
 sub ParseRecord  sub ParseRecord
 {  {
Line 137 
Line 152 
         delete $rec->{data};          delete $rec->{data};
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         my $blocksize = $self->{appinfo}->{blocksize};          my $blocksize = $CRYPTS[ $self->{appinfo}->{cipher} ]{blocksize};
         my ($field, $extra) = _parse_field($rec->{data});          my ($field, $extra) = _parse_field($rec->{data});
         my ($ivec, $encrypted) = unpack "A$blocksize A*", $extra;          my $ivec      = substr $extra, 0, $blocksize;
           my $encrypted = substr $extra, $blocksize;
   
         if ($self->{options}->{v4compatible}) {          $rec->{name}      = $field->{data};
             $rec->{name} = $field->{data};  
         } else {  
             $rec->{name} = $field;  
         }  
         $rec->{ivec}      = $ivec;          $rec->{ivec}      = $ivec;
         $rec->{encrypted} = $encrypted;          $rec->{encrypted} = $encrypted;
   
     } else {      } else {
         # XXX Unsupported version!          die 'Unsupported Version';
         return;          return;
     }      }
   
     return $rec;      return $rec;
 }  }
   
 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,  
     };  
 }  
   
 # PackRecord  # PackRecord
   
 sub PackRecord  sub PackRecord
Line 189 
Line 185 
             delete $rec->{name};              delete $rec->{name};
             delete $rec->{encrypted};              delete $rec->{encrypted};
         }          }
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         # XXX do something          my $field = {
               'label_id' => 1,
               'data'     => $rec->{name},
               'font'     => 0,
           };
           my $packed .= _pack_field($field);
   
           $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};
   
     } else {      } else {
         # XXX Unsupported version!          die 'Unsupported Version';
         return;  
     }      }
   
     return $self->SUPER::PackRecord($rec, @_);      return $self->SUPER::PackRecord($rec, @_);
 }  }
   
 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);  
 }  
   
 # ParseAppInfoBlock  # ParseAppInfoBlock
   
 sub ParseAppInfoBlock  sub ParseAppInfoBlock
Line 238 
Line 229 
         _parse_appinfo_v5($appinfo) || return;          _parse_appinfo_v5($appinfo) || return;
   
     } else {      } else {
         # XXX Unknown version          die "Unsupported Version";
         return;          return;
     }      }
   
Line 266 
Line 257 
     $appinfo->{salt}           = sprintf "%02x" x 8, @salt;      $appinfo->{salt}           = sprintf "%02x" x 8, @salt;
     $appinfo->{iter}           = $iter;      $appinfo->{iter}           = $iter;
     $appinfo->{cipher}         = $cipher;      $appinfo->{cipher}         = $cipher;
     $appinfo->{keylen}         = $CRYPTS[$appinfo->{cipher}]{keylen};  
     $appinfo->{blocksize}      = $CRYPTS[$appinfo->{cipher}]{blocksize};  
     $appinfo->{DES_odd_parity} = $CRYPTS[$appinfo->{cipher}]{DES_odd_parity};  
     $appinfo->{cipher_name}    = $CRYPTS[$appinfo->{cipher}]{name};  
     $appinfo->{masterhash}     = sprintf "%02x" x 8, @hash;      $appinfo->{masterhash}     = sprintf "%02x" x 8, @hash;
     delete $appinfo->{other};      delete $appinfo->{other};
   
Line 287 
Line 274 
         # Nothing to do for v4          # Nothing to do for v4
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         croak("Unsupported version!");          _pack_appinfo_v5($self->{appinfo});
         #$self->{appinfo}{other} = <pack application-specific data>;  
     } else {      } else {
         # XXX Unknown version          die "Unsupported Version";
         return;          return;
     }      }
     return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});      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
           . ("S1" 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  # Encrypt
   
 sub Encrypt  sub Encrypt
Line 305 
Line 315 
     my $data = shift;      my $data = shift;
     my $pass = shift || $self->{password};      my $pass = shift || $self->{password};
   
     if ( ! $pass && ! $self->{key}) {      if ( ! $pass && ! $self->{appinfo}->{key}) {
         croak("password not set!\n");          croak("password not set!\n");
     }      }
   
Line 317 
Line 327 
         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");
     }      }
   
       my $acct;
       if ($rec->{encrypted}) {
           $acct = $self->Decrypt($rec, $pass);
       }
   
       my $encrypted;
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         $self->{digest} ||= _calc_keys( $pass );          $self->{digest} ||= _calc_keys( $pass );
         my $acct = {};          $encrypted = _encrypt_v4($data, $acct, $self->{digest});
         if ($rec->{encrypted}) {          $rec->{name}    ||= $data->{name};
             $acct = $self->Decrypt($rec, $pass);  
       } elsif ($self->{version} == 5) {
           my @recs = ($data, $acct);
           my $name;
           if ($self->{options}->{v4compatible}) {
               $rec->{name} ||= $data->{name};
               foreach my $rec (@recs) {
                   my @fields;
                   foreach my $k (sort keys %{ $rec }) {
                       my $field = {
                           label    => $k,
                           font     => 0,
                           data     => $rec->{$k},
                       };
                       push @fields, $field;
                   }
                   $rec = \@fields;
               }
         }          }
         my $encrypted = _encrypt_v4($data, $self->{digest}, $acct);  
         if ($encrypted) {          my $ivec;
             $rec->{attributes}{Dirty} = 1;          ($encrypted, $ivec) = _encrypt_v5(
             $rec->{attributes}{dirty} = 1;              @recs,
             $rec->{name}    ||= $data->{name};              $self->{appinfo}->{key},
             $rec->{encrypted} = $encrypted;              $self->{appinfo}->{cipher},
           );
           if ($ivec) {
               $rec->{ivec} = $ivec;
           }
   
       } else {
           die "Unsupported Version";
       }
   
       if ($encrypted) {
           if ($encrypted eq '1') {
             return 1;              return 1;
         }          }
     } elsif ($self->{version} == 5) {  
         croak("Unsupported version!");          $rec->{attributes}{Dirty} = 1;
         return _encrypt_v5(          $rec->{attributes}{dirty} = 1;
             $rec->{encrypted}, $rec->{ivec}, $self->{key},          $rec->{encrypted} = $encrypted;
             $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},  
         );          return 1;
     } else {      } else {
         # XXX Unsupported version!          return;
     }      }
     return;  
 }  }
   
 sub _encrypt_v4  sub _encrypt_v4
 {  {
     my $data   = shift;      my $new    = shift;
       my $old    = shift;
     my $digest = shift;      my $digest = shift;
     my $acct   = shift;  
   
     $data->{account}  ||= $EMPTY;      $new->{account}  ||= $EMPTY;
     $data->{password} ||= $EMPTY;      $new->{password} ||= $EMPTY;
     $data->{notes}    ||= $EMPTY;      $new->{notes}    ||= $EMPTY;
   
     my $changed      = 0;      my $changed      = 0;
     my $need_newdate = 0;      my $need_newdate = 0;
     if (%{ $acct }) {      if ($old && %{ $old }) {
         foreach my $key (keys %{ $data }) {          foreach my $key (keys %{ $new }) {
             next if $key eq 'lastchange';              next if $key eq 'lastchange';
             if ($data->{$key} ne $acct->{$key}) {              if ($new->{$key} ne $old->{$key}) {
                 $changed = 1;                  $changed = 1;
                 last;                  last;
             }              }
         }          }
         if ( exists $data->{lastchange} && exists $acct->{lastchange} && (          if ( exists $new->{lastchange} && exists $old->{lastchange} && (
             $data->{lastchange}->{day}   != $acct->{lastchange}->{day}   ||              $new->{lastchange}->{day}   != $old->{lastchange}->{day}   ||
             $data->{lastchange}->{month} != $acct->{lastchange}->{month} ||              $new->{lastchange}->{month} != $old->{lastchange}->{month} ||
             $data->{lastchange}->{year}  != $acct->{lastchange}->{year}              $new->{lastchange}->{year}  != $old->{lastchange}->{year}
         )) {          )) {
             $changed = 1;              $changed = 1;
             $need_newdate = 0;              $need_newdate = 0;
Line 387 
Line 430 
   
     my ($day, $month, $year);      my ($day, $month, $year);
   
     if ($data->{lastchange} && ! $need_newdate ) {      if ($new->{lastchange} && ! $need_newdate ) {
         $day   = $data->{lastchange}->{day}   || 1;          $day   = $new->{lastchange}->{day}   || 1;
         $month = $data->{lastchange}->{month} || 0;          $month = $new->{lastchange}->{month} || 0;
         $year  = $data->{lastchange}->{year}  || 0;          $year  = $new->{lastchange}->{year}  || 0;
   
         # XXX Need to actually validate the above information somehow          # XXX Need to actually validate the above information somehow
         if ($year >= 1900) {          if ($year >= 1900) {
Line 404 
Line 447 
         ($day, $month, $year) = (localtime)[3,4,5];          ($day, $month, $year) = (localtime)[3,4,5];
     }      }
   
     my $packeddate = _pack_keyring_date( {      my $packed_date = _pack_keyring_date( {
             year  => $year,              year  => $year,
             month => $month,              month => $month,
             day   => $day,              day   => $day,
     });      });
   
     my $plaintext = join $NULL,      my $plaintext = join $NULL,
         $data->{account}, $data->{password}, $data->{notes}, $packeddate;          $new->{account}, $new->{password}, $new->{notes}, $packed_date;
   
     return _crypt3des( $plaintext, $digest, $ENCRYPT );      return _crypt3des( $plaintext, $digest, $ENCRYPT );
 }  }
   
   sub _encrypt_v5
   {
       my $new    = shift;
       my $old    = shift;
       my $key    = shift;
       my $cipher = shift;
       my $length = $CRYPTS[ $cipher ]{blocksize};
       my $ivec   = shift || pack("C*",map {rand(256)} 1..$length);
   
       my $keylen      = $CRYPTS[ $cipher ]{keylen};
       my $cipher_name = $CRYPTS[ $cipher ]{name};
   
       my $changed = 0;
       my $need_newdate = 1;
       my $date_index;
       for (my $i = 0; $i < @{ $new }; $i++) {
           if (
               (exists $new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) ||
               (exists $new->[$i]->{label}    && $new->[$i]->{label}    eq 'lastchange')
           ) {
               $date_index   = $i;
               if ( $old && $#{ $new } == $#{ $old } && (
                       $new->[$i]->{data}->{day}   != $old->[$i]->{data}->{day}   ||
                       $new->[$i]->{data}->{month} != $old->[$i]->{data}->{month} ||
                       $new->[$i]->{data}->{year}  != $old->[$i]->{data}->{year}
                   )) {
                   $changed      = 1;
                   $need_newdate = 0;
                   last;
               }
   
           } elsif ($old && $#{ $new } == $#{ $old }) {
               my $n = join ':', %{ $new->[$i] };
               my $o = join ':', %{ $old->[$i] };
               if ($n ne $o) {
                   $changed = 1;
               }
           } elsif ($#{ $new } != $#{ $old }) {
               $changed = 1;
           }
       }
       if ($old && (! @{ $old }) && $date_index) {
           $need_newdate = 0;
       }
   
       return 1, 0 if $changed == 0;
   
       if ($need_newdate || ! defined $date_index) {
           my ($day, $month, $year) = (localtime)[3,4,5];
           my $date = {
               year  => $year,
               month => $month,
               day   => $day,
           };
           if (defined $date_index) {
               $new->[$date_index]->{data} = $date;
           } else {
               push @{ $new }, {
                   label => 'lastchange',
                   font  => 0,
                   data  => $date,
               };
           }
       } else {
           # XXX Need to actually validate the above information somehow
           if ($new->[$date_index]->{data}->{year} >= 1900) {
               $new->[$date_index]->{data}->{year} -= 1900;
           }
       }
   
       my $decrypted;
       foreach my $field (@{ $new }) {
           $decrypted .= _pack_field($field);
       }
   
       my $encrypted;
       if ($cipher_name eq 'None') {
           # do nothing
           $encrypted = $decrypted;
   
       } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {
           my $c = Crypt::CBC->new(
               -literal_key => 1,
               -key         => $key,
               -iv          => $ivec,
               -cipher      => $cipher_name,
               -keysize     => $keylen,
               -header      => 'none',
               -padding     => 'oneandzeroes',
           );
   
           if (! $c) {
               croak("Unable to set up encryption!");
           }
   
           $encrypted = $c->encrypt($decrypted);
   
       } else {
           die "Unsupported Version";
       }
   
       return $encrypted, $ivec;
   }
   
 # Decrypt  # Decrypt
   
 sub 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 && ! $self->{key}) {      if ( ! $pass && ! $self->{appinfo}->{key}) {
         croak("password not set!\n");          croak("password not set!\n");
     }      }
   
Line 432 
Line 579 
         croak("Needed parameter 'record' not passed!\n");          croak("Needed parameter 'record' not passed!\n");
     }      }
   
     if ( ! $self->Password($pass)) {      if ( $pass && ! $self->Password($pass)) {
         croak("Invalid Password!\n");          croak("Invalid Password!\n");
     }      }
   
Line 445 
Line 592 
         my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});          my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
         $acct->{name} ||= $rec->{name};          $acct->{name} ||= $rec->{name};
         return $acct;          return $acct;
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         my $fields = _decrypt_v5(          my $fields = _decrypt_v5(
             $rec->{encrypted}, $rec->{ivec}, $self->{key},              $rec->{encrypted}, $self->{appinfo}->{key},
             $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},              $self->{appinfo}->{cipher}, $rec->{ivec},
         );          );
         if ($self->{options}->{v4compatible}) {          if ($self->{options}->{v4compatible}) {
             my %acct;              my %acct;
Line 460 
Line 608 
         } else {          } else {
             return $fields;              return $fields;
         }          }
   
     } else {      } else {
         # XXX Unsupported version!          die "Unsupported Version";
     }      }
     return;      return;
 }  }
Line 472 
Line 621 
     my $digest    = shift;      my $digest    = shift;
   
     my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );      my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );
     my ( $account, $password, $notes, $packeddate )      my ( $account, $password, $notes, $packed_date )
         = split /$NULL/xm, $decrypted, 4;          = split /$NULL/xm, $decrypted, 4;
   
     my $modified;      my $modified;
     if ($packeddate) {      if ($packed_date) {
         $modified = _parse_keyring_date($packeddate);          $modified = _parse_keyring_date($packed_date);
     }      }
   
     return {      return {
Line 491 
Line 640 
 sub _decrypt_v5  sub _decrypt_v5
 {  {
     my $encrypted = shift;      my $encrypted = shift;
     my $ivec      = shift;  
     my $key       = shift;      my $key       = shift;
     my $keylen    = shift;  
     my $cipher    = shift;      my $cipher    = shift;
       my $ivec      = shift;
   
       my $keylen       = $CRYPTS[ $cipher ]{keylen};
       my $cipher_name  = $CRYPTS[ $cipher ]{name};
   
     my $decrypted;      my $decrypted;
   
     if ($cipher eq 'None') {      if ($cipher_name eq 'None') {
         # do nothing          # do nothing
         $decrypted = $encrypted;          $decrypted = $encrypted;
   
     } elsif ($cipher eq 'DES_EDE3' or $cipher eq 'Rijndael') {      } elsif ($cipher_name eq 'DES_EDE3' or $cipher_name eq 'Rijndael') {
         my $c = _setup_cipher_v5($ivec, $key, $keylen, $cipher);          my $c = Crypt::CBC->new(
               -literal_key => 1,
               -key         => $key,
               -iv          => $ivec,
               -cipher      => $cipher_name,
               -keysize     => $keylen,
               -header      => 'none',
               -padding     => 'oneandzeroes',
           );
   
         if (! $c) {          if (! $c) {
             croak("Unable to set up encryption!");              croak("Unable to set up encryption!");
         }          }
Line 511 
Line 671 
         $decrypted  = $c->decrypt($encrypted);          $decrypted  = $c->decrypt($encrypted);
   
     } else {      } else {
         # XXX Unknown encryption          die "Unsupported Version";
         return;          return;
     }      }
   
Line 538 
Line 698 
   
     if (! $pass) {      if (! $pass) {
         delete $self->{password};          delete $self->{password};
           delete $self->{appinfo}->{key};
         return 1;          return 1;
     }      }
   
     if (! exists $self->{records}) {      if (
         # Give the PDB the first record that will hold the encrypted password          ($self->{version} == 4 && ! exists $self->{records}) ||
         $self->{records} = [ $self->new_Record ];          ($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash})
       ) {
           if ($self->{version} == 4) {
               # Give the PDB the first record that will hold the encrypted password
               $self->{records} = [ $self->new_Record ];
           }
   
         return $self->_password_update($pass);          return $self->_password_update($pass);
     }      }
   
     if ($new_pass) {      if ($new_pass) {
           my $v4compat = $self->{options}->{v4compatible};
           $self->{options}->{v4compatible} = 0;
   
         my @accts = ();          my @accts = ();
         foreach my $i (0..$#{ $self->{records} }) {          foreach my $i (0..$#{ $self->{records} }) {
             if ($i == 0) {              if ($self->{version} == 4 && $i == 0) {
                 push @accts, undef;                  push @accts, undef;
                 next;                  next;
             }              }
Line 568 
Line 737 
         $pass = $new_pass;          $pass = $new_pass;
   
         foreach my $i (0..$#accts) {          foreach my $i (0..$#accts) {
             next if $i == 0;              if ($self->{version} == 4 && $i == 0) {
                   next;
               }
             delete $self->{records}->[$i]->{encrypted};              delete $self->{records}->[$i]->{encrypted};
             $self->Encrypt($self->{records}->[$i], $accts[$i], $pass);              $self->Encrypt($self->{records}->[$i], $accts[$i], $pass);
         }          }
   
           $self->{options}->{v4compatible} = $v4compat;
     }      }
   
     if (defined $self->{password} && $pass eq $self->{password}) {      if (defined $self->{password} && $pass eq $self->{password}) {
Line 584 
Line 757 
         #     always in the first entry          #     always in the first entry
         my $valid = _password_verify_v4($pass, $self->{records}->[0]->{data});          my $valid = _password_verify_v4($pass, $self->{records}->[0]->{data});
   
 # May as well generate the keys we need now, since we know the password is right          # May as well generate the keys we need now, since we know the password is right
         if ($valid) {          if ($valid) {
             $self->{digest} = _calc_keys($pass);              $self->{digest} = _calc_keys($pass);
             if ($self->{digest} ) {              if ($self->{digest} ) {
Line 593 
Line 766 
             }              }
         }          }
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         $self->{key} = _password_verify_v5($pass, $self->{appinfo});          return _password_verify_v5($pass, $self->{appinfo});
         return 1 if $self->{key};  
     } else {      } else {
         # XXX unsupported version          # XXX unsupported version
     }      }
Line 635 
Line 807 
   
     my $salt = pack("H*", $appinfo->{salt});      my $salt = pack("H*", $appinfo->{salt});
   
     my $key = _pbkdf2(      my ($key, $hash) = _calc_key_v5(
         $pass, $salt, $appinfo->{iter}, $appinfo->{keylen}, \&hmac_sha1          $pass, $salt, $appinfo->{iter},
           $CRYPTS[ $appinfo->{cipher} ]{keylen},
           $CRYPTS[ $appinfo->{cipher} ]{DES_odd_parity},
     );      );
     if ($appinfo->{DES_odd_parity}) {  
         $key = DES_odd_parity($key);  
     }  
   
     my $newhash = unpack("H*", substr(sha1($key.$salt),0, 8));  
   
     #print "Key:  '". unpack("H*", $key) . "'\n";      #print "Key:  '". unpack("H*", $key) . "'\n";
     #print "Hash: '". $newhash . "'\n";      #print "Hash: '". $hash . "'\n";
     #print "Hash: '". $appinfo->{masterhash} . "'\n";      #print "Hash: '". $appinfo->{masterhash} . "'\n";
   
     if ($appinfo->{masterhash} eq $newhash) {      if ($appinfo->{masterhash} eq $hash) {
         $appinfo->{key} = $key;          $appinfo->{key} = $key;
     } else {      } else {
         return;          return;
     }      }
   
     return $key;      return $key;
 }  }
   
 # V4 helpers  
   
   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;
   
       if ($self->{version} == 4) {
           my $data = _password_update_v4($pass, @_);
   
           if (! $data) {
               carp("Failed  to update password!");
               return;
           }
   
           # AFAIK the thing we use to test the password is
           #     always in the first entry
           $self->{records}->[0]->{data} = $data;
           $self->{password} = $pass;
           $self->{digest}   = _calc_keys( $self->{password} );
   
           return 1;
   
       } elsif ($self->{version} == 5) {
           my $cipher  = shift || $self->{appinfo}->{cipher};
           my $iter    = shift || $self->{appinfo}->{iter};
           my $salt    = shift || 0;
   
           my $hash = _password_update_v5(
               $self->{appinfo}, $pass, $cipher, $iter, $salt
           );
   
           if (! $hash) {
               carp("Failed  to update password!");
               return;
           }
   
           return 1;
       } else {
           croak("Unsupported version ($self->{version})");
       }
   
       return;
   }
   
   sub _password_update_v4
   {
       my $pass = shift;
   
       if (! defined $pass) { croak('No password specified!'); };
   
       my $salt;
       for ( 1 .. $kSalt_Size ) {
           $salt .= chr int rand 255;
       }
   
       my $msg = $salt . $pass;
   
       $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
   
       my $digest = md5($msg);
   
       my $data = $salt . $digest;    # . "\0";
   
       return $data;
   }
   
   sub _password_update_v5
   {
       my $appinfo = shift;
       my $pass    = shift;
       my $cipher  = shift;
       my $iter    = shift;
   
       # 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 ($key, $hash) = _calc_key_v5(
           $pass, $salt, $iter,
           $CRYPTS[ $cipher ]->{keylen},
           $CRYPTS[ $cipher ]->{DES_odd_parity},
       );
   
       $appinfo->{salt}           = unpack "H*", $salt;
       $appinfo->{iter}           = $iter;
       $appinfo->{cipher}         = $cipher;
   
       $appinfo->{key}            = $key;
       $appinfo->{masterhash}     = $hash;
   
       return $key;
   }
   
   
 sub _calc_keys  sub _calc_keys
 {  {
     my $pass = shift;      my $pass = shift;
Line 682 
Line 949 
     return $digest;      return $digest;
 }  }
   
   sub _calc_key_v5
   {
       my ($pass, $salt, $iter, $keylen, $dop) = @_;
   
       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  sub _crypt3des
 {  {
     my ( $plaintext, $passphrase, $flag ) = @_;      my ( $plaintext, $passphrase, $flag ) = @_;
Line 731 
Line 1010 
     return $cyphertext;      return $cyphertext;
 }  }
   
 # V5 helpers  
   
 sub _setup_cipher_v5  
 {  
     my $ivec   = shift;  
     my $key    = shift;  
     my $keylen = shift;  
     my $cipher = shift;  
   
     return Crypt::CBC->new(  
         -literal_key => 1,  
         -key         => $key,  
         -iv          => $ivec,  
         -cipher      => $cipher,  
         -keysize     => $keylen,  
         -header      => 'none',  
         -padding     => 'oneandzeroes',  
     );  
 }  
   
 sub _parse_field  sub _parse_field
 {  {
     my $field = shift;      my $field = shift;
Line 767 
Line 1026 
         return undef, $field;          return undef, $field;
     }      }
     my $unpackstr = "S1 C1 C1 A$len";      my $unpackstr = "S1 C1 C1 A$len";
     if ($len % 2) {      if ($len % 2 && $len + 4 < length $field) {
         # trim the 0/1 byte padding for next even address.          # trim the 0/1 byte padding for next even address.
         $unpackstr .= ' x'          $unpackstr .= ' x'
     }      }
Line 788 
Line 1047 
     }, $leftover;      }, $leftover;
 }  }
   
 # All version helpers  sub _pack_field
   
 sub _password_update  
 {  {
       my $field = shift;
   
     # It is very important to Encrypt after calling this      my %labels = (
     #     (Although it is generally only called by Encrypt)          name       =>   0,
     # because otherwise the data will be out of sync with the          account    =>   1,
     # password, and that would suck!          password   =>   2,
     my $self = shift;          lastchange =>   3,
     my $pass = shift;          notes      => 255,
       );
   
     # XXX have to separate this out to v4 and v5 sections.      my $label = $field->{label_id} || $labels{ $field->{label} };
     die "Unsupported version" unless $self->{version} == 4;      my $font  = $field->{font}     || 0;
       my $data  = $field->{data}     || '';
   
     if (! defined $pass) { croak('No password specified!'); };      if ($label == 3) {
           $data = _pack_keyring_date($data);
       }
       my $len = length $data;
       my $packstr = "S1 C1 C1 A*";
   
     my $salt;      my $packed = pack $packstr, ($len, $label, $font, $data);
     for ( 1 .. $kSalt_Size ) {  
         $salt .= chr int rand 255;      if ($len % 2) {
           # add byte padding for next even address.
           $packed .= $NULL;
     }      }
   
     my $msg = $salt . $pass;      return $packed;
   }
   
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );  sub _parse_keyring_date
   {
       my $data = shift;
   
     my $digest = md5($msg);      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
   
     my $data = $salt . $digest;    # . "\0";      return {
           year   => $year,
           month  => $month || 0,
           day    => $day   || 1,
       };
   }
   
     # AFAIK the thing we use to test the password is  sub _pack_keyring_date
     #     always in the first entry  {
     $self->{records}->[0]->{data} = $data;      my $d = shift;
       my $year  = $d->{year};
       my $month = $d->{month};
       my $day   = $d->{day};
   
     $self->{password} = $pass;      $year -= 4;
     $self->{digest}   = _calc_keys( $self->{password} );      $month++;
   
     return 1;      return pack 'n', $day | ($month << 5) | ($year << 9);
 }  }
   
   
 sub _hexdump  sub _hexdump
 {  {
     my $prefix = shift;   # What to print in front of each line      my $prefix = shift;   # What to print in front of each line
Line 931 
Line 1212 
   
 1;  1;
 __END__  __END__
   
 =head1 NAME  =head1 NAME
   
 Palm::Keyring - Handler for Palm Keyring databases.  Palm::Keyring - Handler for Palm Keyring databases.
Line 945 
Line 1225 
 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.
 the pre-release keyring-2.0 are not supported.  The pre-release v5 databases are mostly supported.  There are definitely some
   bugs,  For example, t/keyring5.t sometimes fails.  I am not sure why yet.
   
 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 962 
Line 1243 
     $pdb->Load($file);      $pdb->Load($file);
   
     foreach (0..$#{ $pdb->{records} }) {      foreach (0..$#{ $pdb->{records} }) {
         next if $_ = 0; # skip the password record          # skip the password record for version 4 databases
           next if $_ == 0 && $pdb->{version} == 4;
         my $rec  = $pdb->{records}->[$_];          my $rec  = $pdb->{records}->[$_];
         my $acct = $pdb->Decrypt($rec, $pass);          my $acct = $pdb->Decrypt($rec, $pass);
         print $rec->{name}, ' - ', $acct->{account}, "\n";          print $rec->{name}, ' - ', $acct->{account}, "\n";
Line 972 
Line 1254 
   
 =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 983 
Line 1265 
 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 first record with the encrypted
 password.  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);
   
   =head3 Supported options are:
   
   =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 v4compatible
   
   The format of the fields passed to Encrypt and returned from Decrypt have changed.
   This allows programs to use the newer databases with few changes but with less features.
   
   =item cipher
   
   The cipher to use.  0, 1, 2 or 3.
   
       0 => None
       1 => DES_EDE3
       2 => AES128
       3 => AES256
   
   =item iterations
   
   The number of iterations to encrypt with.
   
   =back
   
 =head2 Encrypt  =head2 Encrypt
   
     $pdb->Encrypt($rec, $acct[, $password]);      $pdb->Encrypt($rec, $acct[, $password]);
Line 991 
Line 1310 
 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 new_Record().  $rec is a record from $pdb->{records} or a new_Record().
 $acct is a hashref in the format below.  The v4 $acct is a hashref in the format below.
   
     my $acct = {      my $v4acct = {
         name       => $rec->{name},          name       => $rec->{name},
         account    => $account,          account    => $account,
         password   => $password,          password   => $password,
Line 1005 
Line 1324 
         },          },
     };      };
   
   The v5 $acct is an arrayref full of hashrefs that contain each encrypted field.
   
       my $v5acct = [
           {
               'label_id' => 2,
               'data' => 'abcd1234',
               'label' => 'password',
               'font' => 0
           },
           {
               'label_id' => 3,
               'data' => {
                   'month' => 1,
                   'day' => 11,
                   'year' => 107
               },
               'label' => 'lastchange',
               'font' => 0
           },
           {
               'label_id' => 255,
               'data' => 'This is a short note.',
               'label' => 'notes',
               'font' => 0
           }
       ];
   
   
   The account name is stored in $rec->{name} for both v4 and v5 databases.
   It is not returned in the decrypted information for v5.
   
       $rec->{name} = 'account name';
   
 If you have changed anything other than the lastchange, or don't pass in a  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.  lastchange key, Encrypt() will generate a new lastchange date for you.
   
Line 1017 
Line 1369 
   
     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 (0..$#{ $pdb->{records}) {
         next if $_ == 0;          next if $_ == 0 && $pdb->{version} == 4;
         my $rec = $pdb->{records}->[$_];          my $rec = $pdb->{records}->[$_];
         my $acct = $pdb->Decrypt($rec[, $password]);          my $acct = $pdb->Decrypt($rec);
         # do something with $acct          # do something with $acct
     }      }
   
   
 =head2 Password  =head2 Password
   
     $pdb->Password([$password[, $new_password]]);      $pdb->Password([$password[, $new_password]]);
Line 1090 
Line 1443 
   
 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  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>  from his website at L<http://www.vromans.org/johan/software/sw_palmkeyring.html>
Legend:
Removed from v.1.28  
changed lines
  Added in v.1.31
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>