[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.42 and 1.46

version 1.42, 2007/02/23 03:41:28 version 1.46, 2007/08/10 05:13:31
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
 # $RedRiver: Keyring.pm,v 1.41 2007/02/23 03:38:07 andrew Exp $  # $RedRiver: Keyring.pm,v 1.45 2007/02/26 00:02:13 andrew Exp $
 ########################################################################  ########################################################################
 # Keyring.pm *** Perl class for Keyring for Palm OS databases.  # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #  #
Line 59 
Line 59 
     },      },
 );  );
   
   my %LABELS = (
       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',
       },
   );
   
 our $VERSION = 0.95;  
   
   our $VERSION = 0.96;
   
 sub new  sub new
 {  {
     my $classname = shift;      my $classname = shift;
     my $options = {};      my $options = {};
   
     # hashref arguments      if (@_) {
     if (ref $_[0] eq 'HASH') {          # hashref arguments
       $options = shift;          if (ref $_[0] eq 'HASH') {
     }            $options = shift;
           }
   
     # CGI style arguments          # CGI style arguments
     elsif ($_[0] =~ /^-[a-zA-Z0-9_]{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/^-//;
         $options->{lc $key} = $value;              $options->{lc $key} = $value;
       }            }
     }          }
   
     else {          else {
         $options->{password} = shift;              $options->{password} = shift;
         $options->{version}  = shift;              $options->{version}  = shift;
           }
     }      }
   
     # Create a generic PDB. No need to rebless it, though.      # Create a generic PDB. No need to rebless it, though.
Line 132 
Line 157 
 sub crypts  sub crypts
 {  {
     my $crypt = shift;      my $crypt = shift;
     if (! defined $crypt || ! length $crypt) {      if ((! defined $crypt) || (! length $crypt)) {
         return;          return;
     } elsif ($crypt =~ /\D/) {      } elsif ($crypt =~ /\D/) {
         foreach my $c (@CRYPTS) {          foreach my $c (@CRYPTS) {
Line 147 
Line 172 
     }      }
 }  }
   
   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  # ParseRecord
   
 sub ParseRecord  sub ParseRecord
Line 158 
Line 237 
   
     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.
         return $rec if ! exists $self->{records};          if (! exists $self->{records}) {
               $self->{encpassword} = $rec->{data};
               return '__DELETE_ME__';
           }
   
           if ($self->{records}->[0] eq '__DELETE_ME__') {
               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->{name}      = $name;          $rec->{decrypted}->{0} = {
               label => 'name',
               label_id => 0,
               data  => $name,
               font  => 0,
           };
         $rec->{encrypted} = $encrypted;          $rec->{encrypted} = $encrypted;
         delete $rec->{data};          delete $rec->{data};
   
Line 174 
Line 265 
         my ($field, $extra) = _parse_field($rec->{data});          my ($field, $extra) = _parse_field($rec->{data});
         delete $rec->{data};          delete $rec->{data};
   
         $rec->{name}      = $field->{data};          $rec->{decrypted}->{0} = $field;
         $rec->{ivec}      = substr $extra, 0, $blocksize;          $rec->{ivec}      = substr $extra, 0, $blocksize;
         $rec->{encrypted} = substr $extra, $blocksize;          $rec->{encrypted} = substr $extra, $blocksize;
   
     } else {      } else {
         die 'Unsupported Version';          croak "Unsupported Version $self->{version}";
         return;          return;
     }      }
   
Line 195 
Line 286 
   
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         if ($rec->{encrypted}) {          if ($rec->{encrypted}) {
             if (! defined $rec->{name}) {              my $name = $rec->{decrypted}->{0}->{data} || $EMPTY;
                 $rec->{name} = $EMPTY;              $rec->{data} = join $NULL, $name, $rec->{encrypted};
             }              delete $rec->{decrypted};
             $rec->{data} = join $NULL, $rec->{name}, $rec->{encrypted};  
             delete $rec->{name};  
             delete $rec->{encrypted};              delete $rec->{encrypted};
         }          }
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         my $field;          my $field;
         if ($rec->{name}) {          if ($rec->{decrypted}->{0}) {
             $field = {              $field = $rec->{decrypted}->{0};
                 'label_id' => 1,  
                 'data'     => $rec->{name},  
                 'font'     => 0,  
             };  
         } else {          } else {
             $field = {              $field = {
                 'label_id' => $EMPTY,                  'label'    => 'name',
                   'label_id' => 0,
                 'data'     => $EMPTY,                  'data'     => $EMPTY,
                 'font'     => 0,                  'font'     => 0,
             };              };
         }          }
         my $packed = _pack_field($field);          my $packed = _pack_field($field);
   
         $rec->{data} = join '', $packed, $rec->{ivec}, $rec->{encrypted};          $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};
   
     } else {      } else {
         die 'Unsupported Version';          croak "Unsupported Version $self->{version}";
     }      }
   
     return $self->SUPER::PackRecord($rec, @_);      return $self->SUPER::PackRecord($rec, @_);
Line 255 
Line 341 
         _parse_appinfo_v5($appinfo) || return;          _parse_appinfo_v5($appinfo) || return;
   
     } else {      } else {
         die "Unsupported Version";          croak "Unsupported Version $self->{version}";
         return;  
     }      }
   
     return $appinfo;      return $appinfo;
Line 302 
Line 387 
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         _pack_appinfo_v5($self->{appinfo});          _pack_appinfo_v5($self->{appinfo});
     } else {      } else {
         die "Unsupported Version";          croak "Unsupported Version $self->{version}";
         return;  
     }      }
     return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});      return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
 }  }
Line 366 
Line 450 
     my $encrypted;      my $encrypted;
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         $self->{digest} ||= _calc_keys( $pass );          $self->{digest} ||= _calc_keys( $pass );
         $encrypted = _encrypt_v4($data, $acct, $self->{digest});          my $datav4 = {
         $rec->{name}    ||= $data->{name};              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) {      } elsif ($self->{version} == 5) {
         my @accts = ($data, $acct);  
         if ($self->{options}->{v4compatible}) {  
             $rec->{name} ||= $data->{name};  
             foreach my $a (@accts) {  
                 my @fields;  
                 foreach my $k (sort keys %{ $a }) {  
                     my $field = {  
                         label    => $k,  
                         font     => 0,  
                         data     => $a->{$k},  
                     };  
                     push @fields, $field;  
                 }  
                 $a = \@fields;  
             }  
         }  
   
         ($encrypted, $ivec) = _encrypt_v5(          ($encrypted, $ivec) = _encrypt_v5(
             @accts,              $data, $acct,
             $self->{appinfo}->{key},              $self->{appinfo}->{key},
             $self->{appinfo}->{cipher},              $self->{appinfo}->{cipher},
             $ivec,              $ivec,
Line 398 
Line 478 
         }          }
   
     } else {      } else {
         die "Unsupported Version";          croak "Unsupported Version $self->{version}";
     }      }
   
       $rec->{decrypted}->{0} = $data->{0};
   
     if ($encrypted) {      if ($encrypted) {
         if ($encrypted eq '1') {          if ($encrypted eq '1') {
             return 1;              return 1;
Line 429 
Line 511 
     my $changed      = 0;      my $changed      = 0;
     my $need_newdate = 0;      my $need_newdate = 0;
     if ($old && %{ $old }) {      if ($old && %{ $old }) {
           no warnings 'uninitialized';
         foreach my $key (keys %{ $new }) {          foreach my $key (keys %{ $new }) {
             next if $key eq 'lastchange';              next if $key eq 'lastchange';
             if ($new->{$key} ne $old->{$key}) {              if ($new->{$key} ne $old->{$key}) {
Line 500 
Line 583 
   
     my $changed = 0;      my $changed = 0;
     my $need_newdate = 1;      my $need_newdate = 1;
     my $date_index;      if ($new->{3}->{data}) {
     for (my $i = 0; $i < @{ $new }; $i++) {          $need_newdate = 0;
         if (      }
             ($new->[$i]->{label_id} && $new->[$i]->{label_id} == 3) ||      foreach my $k (keys %{ $new }) {
             ($new->[$i]->{label} && $new->[$i]->{label} eq 'lastchange')          if (! $old) {
         ) {              $changed = 1;
             $date_index   = $i;          } elsif ($k == 3) {
             if ( $old && $#{ $new } == $#{ $old } && (              if ($old && (
                     $new->[$i]{data}{day}   != $old->[$i]{data}{day}   ||                      $new->{$k}{data}{day}   == $old->{$k}{data}{day}   &&
                     $new->[$i]{data}{month} != $old->[$i]{data}{month} ||                      $new->{$k}{data}{month} == $old->{$k}{data}{month} &&
                     $new->[$i]{data}{year}  != $old->[$i]{data}{year}                      $new->{$k}{data}{year}  == $old->{$k}{data}{year}
                 )) {                  )) {
                 $changed      = 1;                  $changed      = 1;
                 $need_newdate = 0;                  $need_newdate = 1;
             }              }
   
         } elsif ($old && $#{ $new } == $#{ $old }) {          } else {
             my $n = join ':', %{ $new->[$i] };              my $n = join ':', sort %{ $new->{$k} };
             my $o = join ':', %{ $old->[$i] };              my $o = join ':', sort %{ $old->{$k} };
             if ($n ne $o) {              if ($n ne $o) {
                 $changed = 1;                  $changed = 1;
             }              }
         } elsif ($#{ $new } != $#{ $old }) {  
             $changed = 1;  
         }          }
     }      }
     if ($old && (! @{ $old }) && $date_index) {  
         $need_newdate = 0;  
     }  
   
     return 1, 0 if $changed == 0;      return 1, 0 if $changed == 0;
   
     if ($need_newdate || ! defined $date_index) {      if ($need_newdate) {
         my ($day, $month, $year) = (localtime)[3,4,5];          my ($day, $month, $year) = (localtime)[3,4,5];
         my $date = {          $new->{3} = {
             year  => $year,              label => 'lastchange',
             month => $month,              label_id => 3,
             day   => $day,              font  => 0,
               data => {
                   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 {      } else {
         # XXX Need to actually validate the above information somehow          # XXX Need to actually validate the above information somehow
         if ($new->[$date_index]->{data}->{year} >= 1900) {          if ($new->{3}->{data}->{year} >= 1900) {
             $new->[$date_index]->{data}->{year} -= 1900;              $new->{3}->{data}->{year} -= 1900;
         }          }
     }      }
   
     my $decrypted;      my $decrypted;
     foreach my $field (@{ $new }) {      foreach my $k (keys %{ $new }) {
         $decrypted .= _pack_field($field);          $decrypted .= _pack_field($new->{$k});
     }      }
   
     my $encrypted;      my $encrypted;
     if ($c->{name} eq 'None') {      if ($c->{name} eq 'None') {
         # do nothing          # do nothing
Line 584 
Line 659 
         $encrypted = $cbc->encrypt($decrypted);          $encrypted = $cbc->encrypt($decrypted);
   
     } else {      } else {
         die "Unsupported Version";          croak "Unsupported Crypt $c->{name}";
     }      }
   
     return $encrypted, $ivec;      return $encrypted, $ivec;
Line 617 
Line 692 
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         $self->{digest} ||= _calc_keys( $pass );          $self->{digest} ||= _calc_keys( $pass );
         my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});          my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
         $acct->{name} ||= $rec->{name};          return {
         return $acct;              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},
               },
           };
   
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         my $fields = _decrypt_v5(          my $decrypted = _decrypt_v5(
             $rec->{encrypted}, $self->{appinfo}->{key},              $rec->{encrypted}, $self->{appinfo}->{key},
             $self->{appinfo}->{cipher}, $rec->{ivec},              $self->{appinfo}->{cipher}, $rec->{ivec},
         );          );
         if ($self->{options}->{v4compatible}) {          $decrypted->{0} ||= $rec->{decrypted}->{0};
             my %acct;          return $decrypted;
             foreach my $f (@{ $fields }) {  
                 $acct{ $f->{label} } = $f->{data};  
             }  
             $acct{name} ||= $rec->{name};  
             return \%acct;  
         } else {  
             return $fields;  
         }  
   
     } else {      } else {
         die "Unsupported Version";          croak "Unsupported Version $self->{version}";
     }      }
     return;      return;
 }  }
Line 701 
Line 793 
         $decrypted  = $cbc->decrypt($encrypted);          $decrypted  = $cbc->decrypt($encrypted);
   
     } else {      } else {
         die "Unsupported Version";          croak "Unsupported Crypt $c->{name}";
         return;  
     }      }
   
     my @fields;      my %fields;
     while ($decrypted) {      while ($decrypted) {
         my $field;          my $field;
         ($field, $decrypted) = _parse_field($decrypted);          ($field, $decrypted) = _parse_field($decrypted);
         if (! $field) {          if (! $field) {
             last;              last;
         }          }
         push @fields, $field;          $fields{ $field->{label_id} } = $field;
     }      }
   
     return \@fields;      return \%fields;
 }  }
   
 # Password  # Password
Line 733 
Line 824 
     }      }
   
     if (      if (
         ($self->{version} == 4 && ! exists $self->{records}) ||          ($self->{version} == 4 && ! exists $self->{encpassword}) ||
         ($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash})          ($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 $rec (@{ $self->{records} }) {
             if ($self->{version} == 4 && $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]->{name}");                  croak("Couldn't decrypt $rec->{decrypted}->{0}->{data}");
             }              }
             push @accts, $acct;              push @accts, $acct;
         }          }
Line 767 
Line 846 
         $pass = $new_pass;          $pass = $new_pass;
   
         foreach my $i (0..$#accts) {          foreach my $i (0..$#accts) {
             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 783 
Line 857 
     }      }
   
     if ($self->{version} == 4) {      if ($self->{version} == 4) {
         # AFAIK the thing we use to test the password is          my $valid = _password_verify_v4($pass, $self->{encpassword});
         #     always in the first entry  
         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 798 
Line 871 
     } elsif ($self->{version} == 5) {      } elsif ($self->{version} == 5) {
         return _password_verify_v5($self->{appinfo}, $pass);          return _password_verify_v5($self->{appinfo}, $pass);
     } else {      } else {
         # XXX unsupported version          croak "Unsupported version $self->{version}";
     }      }
   
     return;      return;
Line 883 
Line 956 
   
         # 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
         $self->{records}->[0]->{data} = $data;          $self->{encpassword} = $data;
         $self->{password} = $pass;          $self->{password} = $pass;
         $self->{digest}   = _calc_keys( $self->{password} );          $self->{digest}   = _calc_keys( $self->{password} );
   
Line 1000 
Line 1073 
     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); }      if ($dop) { $key = _DES_odd_parity($key); }
   
     my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));      my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
   
Line 1062 
Line 1135 
 {  {
     my $field = shift;      my $field = shift;
   
     my @labels;      my ($len) = unpack "n", $field;
     $labels[0]   = 'name';  
     $labels[1]   = 'account';  
     $labels[2]   = 'password';  
     $labels[3]   = 'lastchange';  
     $labels[255] = 'notes';  
   
     my ($len) = unpack "n1", $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;
     if ($len % 2) { # && $len + 4 < length $field) {      if ($len % 2) {
         # trim the 0/1 byte padding for next even address.          # trim the 0/1 byte padding for next even address.
         $offset++;          $offset++;
         $unpackstr .= ' x'          $unpackstr .= ' x'
Line 1084 
Line 1150 
     my ($label, $font, $data) = unpack $unpackstr, $field;      my ($label, $font, $data) = unpack $unpackstr, $field;
     my $leftover = substr $field, $offset;      my $leftover = substr $field, $offset;
   
     if ($label && $label == 3) {      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);          $data = _parse_keyring_date($data);
     }      }
     return {      return {
         #len      => $len,          #len      => $len,
         label    => $labels[ $label ] || $label,          label    => $label,
         label_id => $label,          label_id => $label_id,
         font     => $font,          font     => $font,
         data     => $data,          data     => $data,
     }, $leftover;      }, $leftover;
Line 1100 
Line 1174 
 {  {
     my $field = shift;      my $field = shift;
   
     my %labels = (  
         name       =>   0,  
         account    =>   1,  
         password   =>   2,  
         lastchange =>   3,  
         notes      => 255,  
     );  
   
     my $packed;      my $packed;
     if (defined $field) {      if (defined $field) {
         my $label = $field->{label_id} || 0;          my $label = $field->{label_id} || 0;
         if (defined $field->{label} && ! $label) {          if (defined $field->{label} && ! $label) {
             $label = $labels{ $field->{label} };              $label = $field->{label};
         }          }
   
           my $l = labels($field->{label});
           if ($l) {
               $label = $l->{id};
           }
   
         my $font  = $field->{font} || 0;          my $font  = $field->{font} || 0;
         my $data  = defined $field->{data} ? $field->{data} : $EMPTY;          my $data  = defined $field->{data} ? $field->{data} : $EMPTY;
   
Line 1163 
Line 1235 
     $year -= 4;      $year -= 4;
     $month++;      $month++;
   
     return pack 'n', $day | ($month << 5) | ($year << 9);      return pack 'n*', $day | ($month << 5) | ($year << 9);
 }  }
   
   
Line 1242 
Line 1314 
     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 1301 
Line 1373 
     my $pdb  = new Palm::PDB;      my $pdb  = new Palm::PDB;
     $pdb->Load($file);      $pdb->Load($file);
   
     foreach (0..$#{ $pdb->{records} }) {      foreach my $rec (@{ $pdb->{records} }) {
         # skip the password record for version 4 databases  
         next if $_ == 0 && $pdb->{version} == 4;  
         my $rec  = $pdb->{records}->[$_];  
         my $acct = $pdb->Decrypt($rec, $pass);          my $acct = $pdb->Decrypt($rec, $pass);
         print $rec->{name}, ' - ';          print $acct->{0}->{data}, ' - ', $acct->{1}->{data}, "\n";
         if ($pdb->{version} == 4 || $pdb->{options}->{v4compatible}) {  
             print ' - ', $acct->{account};  
         } else {  
             foreach my $a (@{ $acct }) {  
                 if ($a->{label} eq 'account') {  
                     print ' - ',  $a->{data};  
                     last;  
                 }  
             }  
         }  
         print "\n";  
     }      }
   
 =head1 SUBROUTINES/METHODS  =head1 SUBROUTINES/METHODS
Line 1354 
Line 1412 
   
 The version of database to create.  Accepts either 4 or 5.  Currently defaults to 4.  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  =item cipher
   
 The cipher to use.  Either the number or the name.  The cipher to use.  Either the number or the name.
Line 1389 
Line 1442 
         iter       => Number of iterations for the cipher          iter       => Number of iterations for the cipher
     };      };
   
 =head2 crypt  =head2 crypts
   
 Pass in the alias of the crypt to use, or the index.  Pass in the alias of the crypt to use, or the index.
   
Line 1406 
Line 1459 
     $c = {      $c = {
         alias     => (None|DES_EDE3|AES128|AES256),          alias     => (None|DES_EDE3|AES128|AES256),
         name      => (None|DES_EDE3|Rijndael),          name      => (None|DES_EDE3|Rijndael),
         keylen    => <key length of the ciphe>,          keylen    => <key length of the cipher>,
         blocksize => <block size of the cipher>,          blocksize => <block size of the cipher>,
         default_iter => <default iterations for 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[, $ivec]]);      $pdb->Encrypt($rec, $acct[, $password[, $ivec]]);
Line 1423 
Line 1502 
 randomly.  randomly.
   
 $rec is a record from $pdb->{records} or a new_Record().  $rec is a record from $pdb->{records} or a new_Record().
 The v4 $acct is a hashref in the format below.  The $acct is a hashref in the format below.
   
     my $v4acct = {      my $acct = {
         name       => $rec->{name},          0 => {
         account    => $account,              label    => 'name',
         password   => $password,              label_id => 0,
         notes      => $notes,              font     => 0,
         lastchange => {              data     => $name,
             year  => 107, # years since 1900          1 => {
             month =>   0, # 0-11, 0 = January, 11 = December              label    => 'account',
             day   =>  30, # 1-31, same as localtime              label_id => 1,
               font     => 0,
               data     => $account,
         },          },
     };          2 => {
               label    => 'password',
 The v5 $acct is an arrayref full of hashrefs that contain each encrypted field.              label_id => 2,
               font     => 0,
     my $v5acct = [              data     => $password,
         {  
             'label_id' => 2,  
             'data' => 'abcd1234',  
             'label' => 'password',  
             'font' => 0  
         },          },
         {          3 => {
             'label_id' => 3,              label    => 'lastchange',
             'data' => {              label_id => 3,
                 'month' => 1,              font     => 0,
                 'day' => 11,              data     => $lastchange,
                 'year' => 107  
             },  
             'label' => 'lastchange',  
             'font' => 0  
         },          },
         {          255 => {
             'label_id' => 255,              label    => 'notes',
             'data' => 'This is a short note.',              label_id => 255,
             'label' => 'notes',              font     => 0,
             'font' => 0              data     => $notes,
         }          },
     ];      };
   
   The account name is also stored in $rec->{decrypted}->{0}->{data} for both v4
   and v5 databases.
   
 The account name is stored in $rec->{name} for both v4 and v5 databases.      $rec->{decrypted}->{0} => {
 It is not returned in the decrypted information for v5.          label => 'name',
           data  => 'account name',
       };
   
     $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.
   
 If you pass in a lastchange field that is different than the one in the  If you pass in a lastchange field that is different than the one in the
 record, it will honor what you passed in.  record, it will honor what you passed in.
   
 Encrypt() only uses the $acct->{name} if there is not already a $rec->{name}.  
   
 =head2 Decrypt  =head2 Decrypt
   
Line 1485 
Line 1558 
 Decrypts the record and returns a reference 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 && $pdb->{version} == 4;  
         my $rec = $pdb->{records}->[$_];  
         my $acct = $pdb->Decrypt($rec);          my $acct = $pdb->Decrypt($rec);
         # do something with $acct          # do something with $acct
     }      }
Line 1512 
Line 1583 
   
     $pdb->{digest}   = the calculated digest used from the key;      $pdb->{digest}   = the calculated digest used from the key;
     $pdb->{password} = the password that was passed in;      $pdb->{password} = the password that was passed in;
       $pdb->{encpassword} = the password as stored in the pdb;
   
 For v5  For v5
   
Line 1528 
Line 1600 
                       or calculated when setting a new password.                        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
Line 1548 
Line 1663 
   
 Crypt::CBC - For any encryption but None  Crypt::CBC - For any encryption but None
   
 Crypt::DES_EDE3  Crypt::DES_EDE3 - DES_EDE3 encryption
   
 Crytp::Rijndael - The AES encryption schemes  Crytp::Rijndael - AES encryption schemes
   
 =head1 THANKS  =head1 THANKS
   
Line 1573 
Line 1688 
 and some subroutines.  and some subroutines.
   
 =head1 BUGS AND LIMITATIONS  =head1 BUGS AND LIMITATIONS
   
   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
Legend:
Removed from v.1.42  
changed lines
  Added in v.1.46
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>