[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.27 and 1.28

version 1.27, 2007/02/10 16:21:28 version 1.28, 2007/02/18 05:50:25
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
 # $RedRiver: Keyring.pm,v 1.26 2007/02/06 02:58:50 andrew Exp $  # $RedRiver: Keyring.pm,v 1.27 2007/02/10 16:21:28 andrew Exp $
 ########################################################################  ########################################################################
 # Keyring.pm *** Perl class for Keyring for Palm OS databases.  # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #  #
Line 19 
Line 19 
   
 use base qw/ Palm::StdAppInfo /;  use base qw/ Palm::StdAppInfo /;
   
   use Digest::HMAC_SHA1 qw(hmac_sha1);
   use Digest::SHA1 qw(sha1);
   use Crypt::CBC;
   
 use Digest::MD5 qw(md5);  use Digest::MD5 qw(md5);
 use Crypt::DES;  use Crypt::DES;
   
Line 30 
Line 34 
 my $SPACE      = q{ };  my $SPACE      = q{ };
 my $NULL       = chr 0;  my $NULL       = chr 0;
   
 our $VERSION = 0.94;  my @CRYPTS = (
       { # None
           name      => 'None',
           keylen    => 8,
           blocksize => 1,
       },
       { # DES-EDE3
           name      => 'DES_EDE3',
           keylen    => 24,
           blocksize =>  8,
           DES_odd_parity => 1,
       },
       { # AES128
           name      => 'Rijndael',
           keylen    => 16,
           blocksize => 16,
       },
       { # AES256
           name      => 'Rijndael',
           keylen    => 32,
           blocksize => 16,
       },
   );
   
 sub new {  
   our $VERSION = 0.95;
   
   sub new
   {
     my $classname = shift;      my $classname = shift;
     my $pass      = shift;      my $options = {};
   
       # hashref arguments
       if (ref $_[0] eq 'HASH') {
         $options = shift;
       }
   
       # CGI style arguments
       elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {
         my %tmp = @_;
         while ( my($key,$value) = each %tmp) {
           $key =~ s/^-//;
           $options->{lc $key} = $value;
         }
       }
   
       else {
           $options->{password} = shift;
           $options->{version}  = shift;
       }
   
     # Create a generic PDB. No need to rebless it, though.      # Create a generic PDB. No need to rebless it, though.
     my $self = $classname->SUPER::new(@_);      my $self = $classname->SUPER::new();
   
     $self->{'name'}    = 'Keys-Gtkr';    # Default      $self->{name}    = 'Keys-Gtkr';    # Default
     $self->{'creator'} = 'Gtkr';      $self->{creator} = 'Gtkr';
     $self->{'type'}    = 'Gkyr';      $self->{type}    = 'Gkyr';
   
     # The PDB is not a resource database by      # The PDB is not a resource database by
     # default, but it's worth emphasizing,      # default, but it's worth emphasizing,
     # since MemoDB is explicitly not a PRC.      # since MemoDB is explicitly not a PRC.
     $self->{'attributes'}{'resource'} = 0;      $self->{attributes}{resource} = 0;
   
     # Initialize the AppInfo block  
     $self->{'appinfo'} = {};  
   
     # Add the standard AppInfo block stuff  
     Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} );  
   
     # Set the version      # Set the version
     $self->{'version'} = 4;      $self->{version} = $options->{version} || 4;
   
     if ( defined $pass ) {      # Set options
         $self->Password($pass);      $self->{options} = $options;
   
       if ( defined $options->{password} ) {
           $self->Password($options->{password});
     }      }
   
     return $self;      return $self;
 }  }
   
 sub import {  sub import
   {
     Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );      Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
     return 1;      return 1;
 }  }
   
 sub ParseRecord {  # PackRecord
   
   sub ParseRecord
   {
     my $self     = shift;      my $self     = shift;
   
     my $rec = $self->SUPER::ParseRecord(@_);      my $rec = $self->SUPER::ParseRecord(@_);
       return $rec if ! exists $rec->{data};
   
     # skip the 0 record that holds the password      if ($self->{version} == 4) {
     return $rec if ! exists $self->{'records'};          # skip the first record because it contains the password.
     return $rec if ! exists $rec->{'data'};          return $rec if ! exists $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;
     delete $rec->{'data'};          $rec->{name}      = $name;
     $rec->{'name'} = $name;          $rec->{encrypted} = $encrypted;
     $rec->{'encrypted'} = $encrypted;          delete $rec->{data};
   
       } elsif ($self->{version} == 5) {
           my $blocksize = $self->{appinfo}->{blocksize};
           my ($field, $extra) = _parse_field($rec->{data});
           my ($ivec, $encrypted) = unpack "A$blocksize A*", $extra;
   
           if ($self->{options}->{v4compatible}) {
               $rec->{name} = $field->{data};
           } else {
               $rec->{name} = $field;
           }
           $rec->{ivec}      = $ivec;
           $rec->{encrypted} = $encrypted;
   
       } else {
           # XXX Unsupported version!
           return;
       }
   
     return $rec;      return $rec;
 }  }
   
 sub PackRecord {  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
   
   sub PackRecord
   {
     my $self = shift;      my $self = shift;
     my $rec  = shift;      my $rec  = shift;
   
     if ($rec->{'encrypted'}) {      if ($self->{version} == 4) {
         if (! defined $rec->{'name'}) {          if ($rec->{encrypted}) {
             $rec->{'name'} = $EMPTY;              if (! defined $rec->{name}) {
                   $rec->{name} = $EMPTY;
               }
               $rec->{data} = join $NULL, $rec->{name}, $rec->{encrypted};
               delete $rec->{name};
               delete $rec->{encrypted};
         }          }
         $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'};      } elsif ($self->{version} == 5) {
         delete $rec->{'name'};          # XXX do something
         delete $rec->{'encrypted'};      } else {
           # XXX Unsupported version!
           return;
     }      }
   
     return $self->SUPER::PackRecord($rec, @_);      return $self->SUPER::PackRecord($rec, @_);
 }  }
   
 sub Encrypt {  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
   
   sub ParseAppInfoBlock
   {
     my $self = shift;      my $self = shift;
       my $data = shift;
       my $appinfo = {};
   
       &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);
   
       # int8/uint8
       # - Signed or Unsigned Byte (8 bits). C types: char, unsigned char
       # int16/uint16
       # - Signed or Unsigned Word (16 bits). C types: short, unsigned short
       # int32/uint32
       # - Signed or Unsigned Doubleword (32 bits). C types: int, unsigned int
       # sz
       # - Zero-terminated C-style string
   
       if ($self->{version} == 4) {
           # Nothing extra for version 4
   
       } elsif ($self->{version} == 5) {
           _parse_appinfo_v5($appinfo) || return;
   
       } else {
           # XXX Unknown version
           return;
       }
   
       return $appinfo;
   }
   
   sub _parse_appinfo_v5
   {
       my $appinfo = shift;
   
       if (! exists $appinfo->{other}) {
           # XXX Corrupt appinfo?
           return;
       }
   
       my $unpackstr
           = ("C1" x 8)  # 8 uint8s in an array for the salt
           . ("S1" x 2)  # the iter (uint16) and the cipher (uint16)
           . ("C1" x 8); # and finally 8 more uint8s for the hash
   
       my (@salt, $iter, $cipher, @hash);
       (@salt[0..7], $iter, $cipher, @hash[0..7])
           = unpack $unpackstr, $appinfo->{other};
   
       $appinfo->{salt}           = sprintf "%02x" x 8, @salt;
       $appinfo->{iter}           = $iter;
       $appinfo->{cipher}         = $cipher;
       $appinfo->{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;
       delete $appinfo->{other};
   
       return $appinfo
   }
   
   # PackAppInfoBlock
   
   sub PackAppInfoBlock
   {
       my $self = shift;
       my $retval;
   
       if ($self->{version} == 4) {
           # Nothing to do for v4
   
       } elsif ($self->{version} == 5) {
           croak("Unsupported version!");
           #$self->{appinfo}{other} = <pack application-specific data>;
       } else {
           # XXX Unknown version
           return;
       }
       return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
   }
   
   # Encrypt
   
   sub Encrypt
   {
       my $self = shift;
     my $rec  = shift;      my $rec  = shift;
     my $data = shift;      my $data = shift;
     my $pass = shift || $self->{'password'};      my $pass = shift || $self->{password};
   
     if ( ! $pass) {      if ( ! $pass && ! $self->{key}) {
         croak("'password' not set!\n");          croak("password not set!\n");
     }      }
   
     if ( ! $rec) {      if ( ! $rec) {
Line 126 
Line 321 
         croak("Incorrect Password!\n");          croak("Incorrect Password!\n");
     }      }
   
     $self->{'digest'}   ||= _calc_keys( $pass );      if ($self->{version} == 4) {
           $self->{digest} ||= _calc_keys( $pass );
           my $acct = {};
           if ($rec->{encrypted}) {
               $acct = $self->Decrypt($rec, $pass);
           }
           my $encrypted = _encrypt_v4($data, $self->{digest}, $acct);
           if ($encrypted) {
               $rec->{attributes}{Dirty} = 1;
               $rec->{attributes}{dirty} = 1;
               $rec->{name}    ||= $data->{name};
               $rec->{encrypted} = $encrypted;
               return 1;
           }
       } elsif ($self->{version} == 5) {
           croak("Unsupported version!");
           return _encrypt_v5(
               $rec->{encrypted}, $rec->{ivec}, $self->{key},
               $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},
           );
       } else {
           # XXX Unsupported version!
       }
       return;
   }
   
     $data->{'account'}  ||= $EMPTY;  sub _encrypt_v4
     $data->{'password'} ||= $EMPTY;  {
     $data->{'notes'}    ||= $EMPTY;      my $data   = shift;
       my $digest = shift;
       my $acct   = shift;
   
       $data->{account}  ||= $EMPTY;
       $data->{password} ||= $EMPTY;
       $data->{notes}    ||= $EMPTY;
   
     my $changed      = 0;      my $changed      = 0;
     my $need_newdate = 0;      my $need_newdate = 0;
     my $acct = {};      if (%{ $acct }) {
     if ($rec->{'encrypted'}) {  
         $acct = $self->Decrypt($rec, $pass);  
         foreach my $key (keys %{ $data }) {          foreach my $key (keys %{ $data }) {
             next if $key eq 'lastchange';              next if $key eq 'lastchange';
             if ($data->{$key} ne $acct->{$key}) {              if ($data->{$key} ne $acct->{$key}) {
Line 144 
Line 367 
                 last;                  last;
             }              }
         }          }
         if ( exists $data->{'lastchange'} && exists $acct->{'lastchange'} && (          if ( exists $data->{lastchange} && exists $acct->{lastchange} && (
             $data->{'lastchange'}->{day}   != $acct->{'lastchange'}->{day}   ||              $data->{lastchange}->{day}   != $acct->{lastchange}->{day}   ||
             $data->{'lastchange'}->{month} != $acct->{'lastchange'}->{month} ||              $data->{lastchange}->{month} != $acct->{lastchange}->{month} ||
             $data->{'lastchange'}->{year}  != $acct->{'lastchange'}->{year}              $data->{lastchange}->{year}  != $acct->{lastchange}->{year}
         )) {          )) {
             $changed = 1;              $changed = 1;
             $need_newdate = 0;              $need_newdate = 0;
Line 164 
Line 387 
   
     my ($day, $month, $year);      my ($day, $month, $year);
   
     if ($data->{'lastchange'} && ! $need_newdate ) {      if ($data->{lastchange} && ! $need_newdate ) {
         $day   = $data->{'lastchange'}->{'day'}   || 1;          $day   = $data->{lastchange}->{day}   || 1;
         $month = $data->{'lastchange'}->{'month'} || 0;          $month = $data->{lastchange}->{month} || 0;
         $year  = $data->{'lastchange'}->{'year'}  || 0;          $year  = $data->{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 180 
Line 403 
     if ($need_newdate) {      if ($need_newdate) {
         ($day, $month, $year) = (localtime)[3,4,5];          ($day, $month, $year) = (localtime)[3,4,5];
     }      }
     $year -= 4;  
     $month++;  
   
       my $packeddate = _pack_keyring_date( {
               year  => $year,
               month => $month,
               day   => $day,
       });
   
     my $p = $day | ($month << 5) | ($year << 9);  
     my $packeddate = pack 'n', $p;  
   
     my $plaintext = join $NULL,      my $plaintext = join $NULL,
         $data->{'account'}, $data->{'password'}, $data->{'notes'}, $packeddate;          $data->{account}, $data->{password}, $data->{notes}, $packeddate;
   
     my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );      return _crypt3des( $plaintext, $digest, $ENCRYPT );
   
     return if ! $encrypted;  
   
     $rec->{'attributes'}{'Dirty'} = 1;  
     $rec->{'attributes'}{'dirty'} = 1;  
     $rec->{'name'}    ||= $data->{'name'};  
     $rec->{'encrypted'} = $encrypted;  
   
     return 1;  
 }  }
   
 sub Decrypt {  # Decrypt
   
   sub Decrypt
   {
     my $self = shift;      my $self = shift;
     my $rec  = shift;      my $rec  = shift;
     my $pass = shift || $self->{'password'};      my $pass = shift || $self->{password};
   
     if ( ! $pass) {      if ( ! $pass && ! $self->{key}) {
         croak("'password' not set!\n");          croak("password not set!\n");
     }      }
   
     if ( ! $rec) {      if ( ! $rec) {
Line 219 
Line 436 
         croak("Invalid Password!\n");          croak("Invalid Password!\n");
     }      }
   
     if ( ! $rec->{'encrypted'} ) {      if ( ! $rec->{encrypted} ) {
         croak("No encrypted content!");          croak("No encrypted content!");
     }      }
   
     $self->{'digest'} ||= _calc_keys( $pass );      if ($self->{version} == 4) {
           $self->{digest} ||= _calc_keys( $pass );
           my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
           $acct->{name} ||= $rec->{name};
           return $acct;
       } elsif ($self->{version} == 5) {
           my $fields = _decrypt_v5(
               $rec->{encrypted}, $rec->{ivec}, $self->{key},
               $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},
           );
           if ($self->{options}->{v4compatible}) {
               my %acct;
               foreach my $f (@{ $fields }) {
                   $acct{ $f->{label} } = $f->{data};
               }
               $acct{name} ||= $rec->{name};
               return \%acct;
           } else {
               return $fields;
           }
       } else {
           # XXX Unsupported version!
       }
       return;
   }
   
     my $decrypted =  sub _decrypt_v4
         _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );  {
     my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm,      my $encrypted = shift;
           $decrypted, 4;      my $digest    = shift;
   
     my %Modified;      my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );
     if ($packeddate) {      my ( $account, $password, $notes, $packeddate )
         my $u = unpack 'n', $packeddate;          = split /$NULL/xm, $decrypted, 4;
         my $year  = (($u & 0xFE00) >> 9) + 4; # since 1900  
         my $month = (($u & 0x01E0) >> 5) - 1; # 0-11  
         my $day   = (($u & 0x001F) >> 0);     # 1-31  
   
         %Modified = (      my $modified;
             year   => $year,      if ($packeddate) {
             month  => $month || 0,          $modified = _parse_keyring_date($packeddate);
             day    => $day   || 1,  
         );  
     }      }
   
     return {      return {
         name       => $rec->{'name'},  
         account    => $account,          account    => $account,
         password   => $password,          password   => $password,
         notes      => $notes,          notes      => $notes,
         lastchange => \%Modified,          lastchange => $modified,
     };      };
 }  }
   
 sub Password {  sub _decrypt_v5
   {
       my $encrypted = shift;
       my $ivec      = shift;
       my $key       = shift;
       my $keylen    = shift;
       my $cipher    = shift;
   
       my $decrypted;
   
       if ($cipher eq 'None') {
           # do nothing
           $decrypted = $encrypted;
   
       } elsif ($cipher eq 'DES_EDE3' or $cipher eq 'Rijndael') {
           my $c = _setup_cipher_v5($ivec, $key, $keylen, $cipher);
           if (! $c) {
               croak("Unable to set up encryption!");
           }
           $encrypted .= $NULL x $keylen; # pad out a keylen
           $decrypted  = $c->decrypt($encrypted);
   
       } else {
           # XXX Unknown encryption
           return;
       }
   
       my @fields;
       while ($decrypted) {
           my $field;
           ($field, $decrypted) = _parse_field($decrypted);
           if (! $field) {
               last;
           }
           push @fields, $field;
       }
   
       return \@fields;
   }
   
   # Password
   
   sub Password
   {
     my $self = shift;      my $self = shift;
     my $pass = shift;      my $pass = shift;
     my $new_pass = shift;      my $new_pass = shift;
   
     if (! $pass) {      if (! $pass) {
         delete $self->{password};          delete $self->{password};
         return 1;          return 1;
     }      }
   
     if (! exists $self->{'records'}) {      if (! exists $self->{records}) {
         # Give the PDB the first record that will hold the encrypted password          # Give the PDB the first record that will hold the encrypted password
         $self->{'records'} = [ $self->new_Record ];          $self->{records} = [ $self->new_Record ];
   
         return $self->_password_update($pass);          return $self->_password_update($pass);
     }      }
   
     if ($new_pass) {      if ($new_pass) {
         my @accts = ();          my @accts = ();
         foreach my $i (0..$#{ $self->{'records'} }) {          foreach my $i (0..$#{ $self->{records} }) {
             if ($i == 0) {              if ($i == 0) {
                 push @accts, undef;                  push @accts, undef;
                 next;                  next;
             }              }
             my $acct = $self->Decrypt($self->{'records'}->[$i], $pass);              my $acct = $self->Decrypt($self->{records}->[$i], $pass);
             if ( ! $acct ) {              if ( ! $acct ) {
                 croak("Couldn't decrypt $self->{'records'}->[$i]->{'name'}");                  croak("Couldn't decrypt $self->{records}->[$i]->{name}");
             }              }
             push @accts, $acct;              push @accts, $acct;
         }          }
Line 291 
Line 569 
   
         foreach my $i (0..$#accts) {          foreach my $i (0..$#accts) {
             next if $i == 0;              next if $i == 0;
             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);
         }          }
     }      }
   
     return $self->_password_verify($pass);      if (defined $self->{password} && $pass eq $self->{password}) {
           # already verified this password
           return 1;
       }
   
       if ($self->{version} == 4) {
           # AFAIK the thing we use to test the password is
           #     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
           if ($valid) {
               $self->{digest} = _calc_keys($pass);
               if ($self->{digest} ) {
                   $self->{password} = $pass;
                   return 1;
               }
           }
       } elsif ($self->{version} == 5) {
           $self->{key} = _password_verify_v5($pass, $self->{appinfo});
           return 1 if $self->{key};
       } else {
           # XXX unsupported version
       }
   
       return;
 }  }
   
 sub _calc_keys {  sub _password_verify_v4
   {
     my $pass = shift;      my $pass = shift;
       my $data = shift;
   
       if (! $pass) { croak('No password specified!'); };
   
       # XXX die "No encrypted password in file!" unless defined $data;
       if ( ! defined $data) { return; };
   
       $data =~ s/$NULL$//xm;
   
       my $salt = substr $data, 0, $kSalt_Size;
   
       my $msg = $salt . $pass;
       $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
   
       my $digest = md5($msg);
   
       if (! $data eq $salt . $digest ) {
           return;
       }
   
       return 1;
   }
   
   sub _password_verify_v5
   {
       my $pass    = shift;
       my $appinfo = shift;
   
       my $salt = pack("H*", $appinfo->{salt});
   
       my $key = _pbkdf2(
           $pass, $salt, $appinfo->{iter}, $appinfo->{keylen}, \&hmac_sha1
       );
       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 "Hash: '". $newhash . "'\n";
       #print "Hash: '". $appinfo->{masterhash} . "'\n";
   
       if ($appinfo->{masterhash} eq $newhash) {
           $appinfo->{key} = $key;
       } else {
           return;
       }
       return $key;
   }
   
   # V4 helpers
   
   sub _calc_keys
   {
       my $pass = shift;
     if (! defined $pass) { croak('No password defined!'); };      if (! defined $pass) { croak('No password defined!'); };
   
     my $digest = md5($pass);      my $digest = md5($pass);
Line 322 
Line 682 
     return $digest;      return $digest;
 }  }
   
 sub _password_verify {  sub _crypt3des
     my $self = shift;  {
     my $pass = shift;      my ( $plaintext, $passphrase, $flag ) = @_;
   
     if (! $pass) { croak('No password specified!'); };      $passphrase   .= $SPACE x ( 16 * 3 );
       my $cyphertext = $EMPTY;
   
     if (defined $self->{'password'} && $pass eq $self->{'password'}) {      my $size = length $plaintext;
         # already verified this password  
         return 1;      #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
   
       my @C;
       for ( 0 .. 2 ) {
           $C[$_] =
             new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
     }      }
   
     # AFAIK the thing we use to test the password is      for ( 0 .. ( ($size) / 8 ) ) {
     #     always in the first entry          my $pt = substr $plaintext, $_ * 8, 8;
     my $data = $self->{'records'}->[0]->{'data'};  
   
     #die "No encrypted password in file!" unless defined $data;          #print "PT: '$pt' - Length: " . length($pt) . "\n";
     if ( ! defined $data) { return; };          if (! length $pt) { next; };
           if ( (length $pt) < 8 ) {
               if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
               my $len = 8 - (length $pt);
               $pt .= ($NULL x $len);
           }
           if ( $flag == $ENCRYPT ) {
               $pt = $C[0]->encrypt($pt);
               $pt = $C[1]->decrypt($pt);
               $pt = $C[2]->encrypt($pt);
           }
           else {
               $pt = $C[0]->decrypt($pt);
               $pt = $C[1]->encrypt($pt);
               $pt = $C[2]->decrypt($pt);
           }
   
     $data =~ s/$NULL$//xm;          #print "PT: '$pt' - Length: " . length($pt) . "\n";
           $cyphertext .= $pt;
       }
   
     my $salt = substr $data, 0, $kSalt_Size;      $cyphertext =~ s/$NULL+$//xm;
   
     my $msg = $salt . $pass;      #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
   
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );      return $cyphertext;
   }
   
     my $digest = md5($msg);  # V5 helpers
   
     if ( $data eq $salt . $digest ) {  sub _setup_cipher_v5
   {
       my $ivec   = shift;
       my $key    = shift;
       my $keylen = shift;
       my $cipher = shift;
   
 # May as well generate the keys we need now, since we know the password is right      return Crypt::CBC->new(
         $self->{'digest'} = _calc_keys($pass);          -literal_key => 1,
         if ( $self->{'digest'} ) {          -key         => $key,
             $self->{'password'} = $pass;          -iv          => $ivec,
             return 1;          -cipher      => $cipher,
         }          -keysize     => $keylen,
           -header      => 'none',
           -padding     => 'oneandzeroes',
       );
   }
   
   sub _parse_field
   {
       my $field = shift;
   
       my @labels;
       $labels[0]   = 'name';
       $labels[1]   = 'account';
       $labels[2]   = 'password';
       $labels[3]   = 'lastchange';
       $labels[255] = 'notes';
   
       my ($len) = unpack "S1", $field;
       if ($len + 4 > length $field) {
           return undef, $field;
     }      }
     return;      my $unpackstr = "S1 C1 C1 A$len";
       if ($len % 2) {
           # trim the 0/1 byte padding for next even address.
           $unpackstr .= ' x'
       }
       $unpackstr .= ' A*';
   
       my (undef, $label, $font, $data, $leftover)
           = unpack $unpackstr, $field;
   
       if ($label == 3) {
           $data = _parse_keyring_date($data);
       }
       return {
           #len      => $len,
           label    => $labels[ $label ] || $label,
           label_id => $label,
           font     => $font,
           data     => $data,
       }, $leftover;
 }  }
   
 sub _password_update {  # All version helpers
   
   sub _password_update
   {
   
     # It is very important to Encrypt after calling this      # It is very important to Encrypt after calling this
     #     (Although it is generally only called by Encrypt)      #     (Although it is generally only called by Encrypt)
     # because otherwise the data will be out of sync with the      # because otherwise the data will be out of sync with the
Line 371 
Line 800 
     my $self = shift;      my $self = shift;
     my $pass = shift;      my $pass = shift;
   
       # XXX have to separate this out to v4 and v5 sections.
       die "Unsupported version" unless $self->{version} == 4;
   
     if (! defined $pass) { croak('No password specified!'); };      if (! defined $pass) { croak('No password specified!'); };
   
     my $salt;      my $salt;
Line 388 
Line 820 
   
     # 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->{records}->[0]->{data} = $data;
   
     $self->{'password'} = $pass;      $self->{password} = $pass;
     $self->{'digest'}   = _calc_keys( $self->{'password'} );      $self->{digest}   = _calc_keys( $self->{password} );
   
     return 1;      return 1;
 }  }
   
 sub _crypt3des {  sub _hexdump
     my ( $plaintext, $passphrase, $flag ) = @_;  {
       my $prefix = shift;   # What to print in front of each line
       my $data = shift;     # The data to dump
       my $maxlines = shift; # Max # of lines to dump
       my $offset;           # Offset of current chunk
   
     $passphrase   .= $SPACE x ( 16 * 3 );      for ($offset = 0; $offset < length($data); $offset += 16)
     my $cyphertext = $EMPTY;      {
           my $hex;   # Hex values of the data
           my $ascii; # ASCII values of the data
           my $chunk; # Current chunk of data
   
     my $size = length $plaintext;          last if defined($maxlines) && ($offset >= ($maxlines * 16));
   
     #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";          $chunk = substr($data, $offset, 16);
   
     my @C;          ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;
     for ( 0 .. 2 ) {  
         $C[$_] =          ($ascii = $chunk) =~ y/\040-\176/./c;
           new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));  
           printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
     }      }
   }
   
     for ( 0 .. ( ($size) / 8 ) ) {  sub _bindump
         my $pt = substr $plaintext, $_ * 8, 8;  {
       my $prefix = shift;   # What to print in front of each line
       my $data = shift;     # The data to dump
       my $maxlines = shift; # Max # of lines to dump
       my $offset;           # Offset of current chunk
   
         #print "PT: '$pt' - Length: " . length($pt) . "\n";      for ($offset = 0; $offset < length($data); $offset += 8)
         if (! length $pt) { next; };      {
         if ( (length $pt) < 8 ) {          my $bin;   # binary values of the data
             if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };          my $ascii; # ASCII values of the data
             my $len = 8 - (length $pt);          my $chunk; # Current chunk of data
   
             #print "LENGTH: $len\n";          last if defined($maxlines) && ($offset >= ($maxlines * 8));
             #print "Binary:    '" . unpack("b*", $pt) . "'\n";  
             $pt .= ($NULL x $len);  
   
             #print "PT: '$pt' - Length: " . length($pt) . "\n";          $chunk = substr($data, $offset, 8);
             #print "Binary:    '" . unpack("b*", $pt) . "'\n";  
         }  
         if ( $flag == $ENCRYPT ) {  
             $pt = $C[0]->encrypt($pt);  
             $pt = $C[1]->decrypt($pt);  
             $pt = $C[2]->encrypt($pt);  
         }  
         else {  
             $pt = $C[0]->decrypt($pt);  
             $pt = $C[1]->encrypt($pt);  
             $pt = $C[2]->decrypt($pt);  
         }  
   
         #print "PT: '$pt' - Length: " . length($pt) . "\n";          ($bin = $chunk) =~ s/./sprintf "%08b ", ord($&)/ges;
         $cyphertext .= $pt;  
           ($ascii = $chunk) =~ y/\040-\176/./c;
   
           printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
     }      }
   }
   
     $cyphertext =~ s/$NULL+$//xm;  # Thanks to Jochen Hoenicke <hoenicke@gmail.com>
   # (one of the authors of Palm Keyring)
   # for these next two subs.
   
     #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";  # Usage pbkdf2(password, salt, iter, keylen, prf)
   # iter is number of iterations
   # keylen is length of generated key in bytes
   # prf is the pseudo random function (e.g. hmac_sha1)
   # returns the key.
   sub _pbkdf2($$$$$)
   {
       my ($password, $salt, $iter, $keylen, $prf) = @_;
       my ($k, $t, $u, $ui, $i);
       $t = "";
       for ($k = 1; length($t) <  $keylen; $k++) {
       $u = $ui = &$prf($salt.pack('N', $k), $password);
       for ($i = 1; $i < $iter; $i++) {
           $ui = &$prf($ui, $password);
           $u ^= $ui;
       }
       $t .= $u;
       }
       return substr($t, 0, $keylen);
   }
   
     return $cyphertext;  sub DES_odd_parity($) {
       my $key = $_[0];
       my ($r, $i);
       my @odd_parity = (
     1,  1,  2,  2,  4,  4,  7,  7,  8,  8, 11, 11, 13, 13, 14, 14,
    16, 16, 19, 19, 21, 21, 22, 22, 25, 25, 26, 26, 28, 28, 31, 31,
    32, 32, 35, 35, 37, 37, 38, 38, 41, 41, 42, 42, 44, 44, 47, 47,
    49, 49, 50, 50, 52, 52, 55, 55, 56, 56, 59, 59, 61, 61, 62, 62,
    64, 64, 67, 67, 69, 69, 70, 70, 73, 73, 74, 74, 76, 76, 79, 79,
    81, 81, 82, 82, 84, 84, 87, 87, 88, 88, 91, 91, 93, 93, 94, 94,
    97, 97, 98, 98,100,100,103,103,104,104,107,107,109,109,110,110,
   112,112,115,115,117,117,118,118,121,121,122,122,124,124,127,127,
   128,128,131,131,133,133,134,134,137,137,138,138,140,140,143,143,
   145,145,146,146,148,148,151,151,152,152,155,155,157,157,158,158,
   161,161,162,162,164,164,167,167,168,168,171,171,173,173,174,174,
   176,176,179,179,181,181,182,182,185,185,186,186,188,188,191,191,
   193,193,194,194,196,196,199,199,200,200,203,203,205,205,206,206,
   208,208,211,211,213,213,214,214,217,217,218,218,220,220,223,223,
   224,224,227,227,229,229,230,230,233,233,234,234,236,236,239,239,
   241,241,242,242,244,244,247,247,248,248,251,251,253,253,254,254);
       for ($i = 0; $i< length($key); $i++) {
       $r .= chr($odd_parity[ord(substr($key, $i, 1))]);
       }
       return $r;
 }  }
   
 1;  1;
Line 482 
Line 961 
     my $pdb  = new Palm::PDB;      my $pdb  = new Palm::PDB;
     $pdb->Load($file);      $pdb->Load($file);
   
     foreach (0..$#{ $pdb->{'records'} }) {      foreach (0..$#{ $pdb->{records} }) {
         next if $_ = 0; # skip the password record          next if $_ = 0; # skip the password record
         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";
     }      }
   
 =head1 SUBROUTINES/METHODS  =head1 SUBROUTINES/METHODS
Line 511 
Line 990 
 Encrypts an account into a record, either with the password previously  Encrypts an account into a record, either with the password previously
 used, or with a password that is passed.  used, or with a password that is passed.
   
 $rec is a record from $pdb->{'records'} or a new_Record().  $rec is a record from $pdb->{records} or a new_Record().
 $acct is a hashref in the format below.  $acct is a hashref in the format below.
   
     my $acct = {      my $acct = {
         name       => $rec->{'name'},          name       => $rec->{name},
         account    => $account,          account    => $account,
         password   => $password,          password   => $password,
         notes      => $notes,          notes      => $notes,
Line 532 
Line 1011 
 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'}.  Encrypt() only uses the $acct->{name} if there is not already a $rec->{name}.
   
 =head2 Decrypt  =head2 Decrypt
   
Line 541 
Line 1020 
 Decrypts the record and returns a hashref for the account as described  Decrypts the record and returns a hashref for the account as described
 under Encrypt().  under Encrypt().
   
     foreach (0..$#{ $pdb->{'records'}) {      foreach (0..$#{ $pdb->{records}) {
         next if $_ == 0;          next if $_ == 0;
         my $rec = $pdb->{'records'}->[$_];          my $rec = $pdb->{records}->[$_];
         my $acct = $pdb->Decrypt($rec[, $password]);          my $acct = $pdb->Decrypt($rec[, $password]);
         # do something with $acct          # do something with $acct
     }      }
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>