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

version 1.22, 2007/02/01 01:56:11 version 1.28, 2007/02/18 05:50:25
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.21 2007/01/31 05:32:20 andrew Exp $  ########################################################################
   # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #  #
 # Perl class for dealing with Keyring for Palm OS databases.  
 #  
 #   This started as Memo.pm, I just made it work for Keyring.  #   This started as Memo.pm, I just made it work for Keyring.
   #
   # 2006.01.26 #*#*# andrew fresh <andrew@cpan.org>
   ########################################################################
   # Copyright (C) 2006, 2007 by Andrew Fresh
   #
   # This program is free software; you can redistribute it and/or modify
   # it under the same terms as Perl itself.
   ########################################################################
 use strict;  use strict;
 use warnings;  use warnings;
   
 use Carp;  use Carp;
   
 use base qw/ Palm::StdAppInfo /;  use base qw/ Palm::StdAppInfo /;
   
   use Digest::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;
 use Readonly;  
   
 Readonly my $ENCRYPT    => 1;  my $ENCRYPT    = 1;
 Readonly my $DECRYPT    => 0;  my $DECRYPT    = 0;
 Readonly my $MD5_CBLOCK => 64;  my $MD5_CBLOCK = 64;
 Readonly my $kSalt_Size => 4;  my $kSalt_Size = 4;
 Readonly my $EMPTY      => q{};  my $EMPTY      = q{};
 Readonly my $SPACE      => q{ };  my $SPACE      = q{ };
 Readonly my $NULL       => chr 0;  my $NULL       = chr 0;
   
 # One liner, to allow MakeMaker to work.  my @CRYPTS = (
 our $VERSION = 0.92;      { # 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;
   
     my $rec0_id = $self->{'records'}->[0]->{'id'};      if ($self->{version} == 4) {
           if ($rec->{encrypted}) {
     if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) {              if (! defined $rec->{name}) {
         if (! defined $rec->{'name'}) {                  $rec->{name} = $EMPTY;
             $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 123 
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 141 
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 161 
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 177 
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 216 
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 || $self->{'password'};      my $pass = shift;
     my $new_pass = shift;      my $new_pass = shift;
   
     if (! exists $self->{'records'}) {      if (! $pass) {
           delete $self->{password};
           return 1;
       }
   
       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 283 
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 314 
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 363 
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 380 
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 474 
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 493 
Line 980 
 Use this method if you're creating a Keyring PDB from scratch otherwise you  Use this method if you're creating a Keyring PDB from scratch otherwise you
 can just use Palm::PDB::new() before calling Load().  can just use Palm::PDB::new() before calling Load().
   
   If you pass in a password, it will initalize the first record with the encrypted
   password.
   
 =head2 Encrypt  =head2 Encrypt
   
     $pdb->Encrypt($rec, $acct, [$password]);      $pdb->Encrypt($rec, $acct[, $password]);
   
 Encrypts an account into a record, either with the password previously  Encrypts an account into a record, either with the password previously
 used, or with a password that is passed.  used, or with a password that is passed.
   
 $rec is a record from $pdb->{'records'} or a newly generated record.  $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 516 
Line 1006 
     };      };
   
 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 record, Encrypt() will generate a new lastchange 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.
   
 It also 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 530 
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
     }      }
Line 548 
Line 1038 
 called new(), you only need to pass one password and it will set that as  called new(), you only need to pass one password and it will set that as
 the password.  the password.
   
 If nothing is passed, and there has been a password used before,  If nothing is passed, it forgets the password that it was remembering.
 it just verifies that the password was correct.  
   
 =head1 DEPENDENCIES  =head1 DEPENDENCIES
   
Line 561 
Line 1050 
   
 Readonly  Readonly
   
   =head1 THANKS
   
   I would like to thank the helpful Perlmonk shigetsu who gave me some great advice
   and helped me get my first module posted.  L<http://perlmonks.org/?node_id=596998>
   
   I would also like to thank
   Johan Vromans
   E<lt>jvromans@squirrel.nlE<gt> --
   L<http://www.squirrel.nl/people/jvromans>.
   He had his own Palm::KeyRing module that he posted a couple of days before
   mine was ready and he was kind enough to let me have the namespace as well
   as giving me some very helpful hints about doing a few things that I was
   unsure of.  He is really great.
   
 =head1 BUGS AND LIMITATIONS  =head1 BUGS AND LIMITATIONS
   
 Once this module is uploaded, you can  
 Please report any bugs or feature requests to  Please report any bugs or feature requests to
 C<bug-palm-keyring at rt.cpan.org>, or through the web interface at  C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
 L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be  L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
Line 571 
Line 1073 
   
 =head1 AUTHOR  =head1 AUTHOR
   
 Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>  Andrew Fresh E<lt>andrew@cpan.orgE<gt>
   
 =head1 LICENSE AND COPYRIGHT  =head1 LICENSE AND COPYRIGHT
   
Line 588 
Line 1090 
   
 The Keyring for Palm OS website:  The Keyring for Palm OS website:
 L<http://gnukeyring.sourceforge.net/>  L<http://gnukeyring.sourceforge.net/>
   
   Johan Vromans also has a wxkeyring app that now uses this module, available
   from his website at L<http://www.vromans.org/johan/software/sw_palmkeyring.html>
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.28
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>