[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.15 and 1.24

version 1.15, 2007/01/29 02:49:41 version 1.24, 2007/02/03 00:52:43
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
   
 # $RedRiver: Keyring.pm,v 1.14 2007/01/28 22:24:17 andrew Exp $  # $RedRiver: Keyring.pm,v 1.23 2007/02/02 01:51:46 andrew Exp $
 #  #
 # Perl class for dealing with Keyring for Palm OS databases.  # Perl class for dealing with Keyring for Palm OS databases.
 #  #
Line 14 
Line 14 
   
 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.  our $VERSION = 0.93;
 our ($VERSION) = q$Revision$ =~ m{ Revision: \s+ (\S+) }xm;  
   
 #@ISA = qw( Palm::StdAppInfo Palm::Raw );  
   
 sub new {  sub new {
     my $classname = shift;      my $classname = shift;
     my $pass      = shift;      my $pass      = shift;
Line 54 
Line 50 
     # Set the version      # Set the version
     $self->{'version'} = 4;      $self->{'version'} = 4;
   
     # Give the PDB the first record that will hold the encrypted password  
     $self->{'records'} = [ $self->new_Record ];  
   
     if ( defined $pass ) {      if ( defined $pass ) {
         $self->Encrypt($pass);          $self->Password($pass);
     }      }
   
     return $self;      return $self;
Line 69 
Line 62 
     return 1;      return 1;
 }  }
   
 sub Load {  sub ParseRecord {
     my $self     = shift;      my $self     = shift;
     my $filename = shift;  
     my $password = shift;  
   
     $self->{'appinfo'} = {};      my $rec = $self->SUPER::ParseRecord(@_);
     $self->{'records'} = [];  
     $self->SUPER::Load($filename);  
   
     foreach my $rec ( @{ $self->{'records'} } ) {      # skip the 0 record that holds the password
         if ( ! exists $rec->{'data'}) { next; };      return $rec if ! exists $self->{'records'};
         my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;      return $rec if ! exists $rec->{'data'};
         if ( ! $encrypted ) { next };  
         $rec->{'plaintext'}->{'name'} = $name;  
         $rec->{'encrypted'} = $encrypted;  
     }  
   
     return $self->Decrypt($password) if defined $password;      my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
   
     return 1;      return $rec if ! $encrypted;
       delete $rec->{'data'};
       $rec->{'name'} = $name;
       $rec->{'encrypted'} = $encrypted;
   
       return $rec;
 }  }
   
 sub Write {  sub PackRecord {
     my $self     = shift;      my $self = shift;
     my $filename = shift;      my $rec  = shift;
     my $password = shift;  
   
     $self->Encrypt($password) || return;      if ($rec->{'encrypted'}) {
     return $self->SUPER::Write($filename);          if (! defined $rec->{'name'}) {
               $rec->{'name'} = $EMPTY;
           }
           $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'};
           delete $rec->{'name'};
           delete $rec->{'encrypted'};
       }
   
       return $self->SUPER::PackRecord($rec, @_);
 }  }
   
 sub Encrypt {  sub Encrypt {
     my $self = shift;      my $self = shift;
     my $pass = shift;      my $rec  = shift;
       my $data = shift;
       my $pass = shift || $self->{'password'};
   
     if ($pass) {      if ( ! $pass) {
         if (          croak("'password' not set!\n");
             !( exists $self->{'records'}->[0]->{'data'}      }
                 && $self->_keyring_verify($pass) )  
           )  
         {  
   
             # This would encrypt with a new password.      if ( ! $rec) {
             # First decrypting everything with the old password of course.          croak("Needed parameter 'record' not passed!\n");
             $self->_keyring_update($pass) || return;  
             $self->_keyring_verify($pass) || return;  
         }  
     }      }
   
     $self->{'digest'} ||= _calc_keys( $self->{'password'} );      if ( ! $data) {
           croak("Needed parameter 'data' not passed!\n");
       }
   
     foreach my $rec ( @{ $self->{'records'} } ) {      if ( ! $self->Password($pass)) {
         if (!defined $rec->{'plaintext'}) { next; };          croak("Incorrect Password!\n");
       }
   
         my $name =      $self->{'digest'}   ||= _calc_keys( $pass );
           defined $rec->{'plaintext'}->{'name'}  
           ? $rec->{'plaintext'}->{'name'}  
           : $EMPTY;  
         my $account =  
           defined $rec->{'plaintext'}->{'account'}  
           ? $rec->{'plaintext'}->{'account'}  
           : $EMPTY;  
         my $password =  
           defined $rec->{'plaintext'}->{'password'}  
           ? $rec->{'plaintext'}->{'password'}  
           : $EMPTY;  
         my $description =  
           defined $rec->{'plaintext'}->{'description'}  
           ? $rec->{'plaintext'}->{'description'}  
           : $EMPTY;  
         my $extra = $EMPTY;  
   
         my $plaintext = join "$NULL", $account, $password, $description, $extra;      $data->{'account'}  ||= $EMPTY;
       $data->{'password'} ||= $EMPTY;
       $data->{'notes'}    ||= $EMPTY;
   
         my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );      my $changed      = 0;
       my $need_newdate = 0;
       my $acct = {};
       if ($rec->{'encrypted'}) {
           $acct = $self->Decrypt($rec, $pass);
           foreach my $key (keys %{ $data }) {
               next if $key eq 'lastchange';
               if ($data->{$key} ne $acct->{$key}) {
                   $changed = 1;
                   last;
               }
           }
           if ( exists $data->{'lastchange'} && exists $acct->{'lastchange'} && (
               $data->{'lastchange'}->{day}   != $acct->{'lastchange'}->{day}   ||
               $data->{'lastchange'}->{month} != $acct->{'lastchange'}->{month} ||
               $data->{'lastchange'}->{year}  != $acct->{'lastchange'}->{year}
           )) {
               $changed = 1;
               $need_newdate = 0;
           } else {
               $need_newdate = 1;
           }
   
         $rec->{'data'} = join "$NULL", $name, $encrypted;      } else {
           $changed = 1;
     }      }
   
       # no need to re-encrypt if it has not changed.
       return 1 if ! $changed;
   
       my ($day, $month, $year);
   
       if ($data->{'lastchange'} && ! $need_newdate ) {
           $day   = $data->{'lastchange'}->{'day'}   || 1;
           $month = $data->{'lastchange'}->{'month'} || 0;
           $year  = $data->{'lastchange'}->{'year'}  || 0;
   
           # XXX Need to actually validate the above information somehow
           if ($year >= 1900) {
               $year -= 1900;
           }
       } else {
           $need_newdate = 1;
       }
   
       if ($need_newdate) {
           ($day, $month, $year) = (localtime)[3,4,5];
       }
       $year -= 4;
       $month++;
   
   
       my $p = $day | ($month << 5) | ($year << 9);
       my $packeddate = pack 'n', $p;
   
       my $plaintext = join $NULL,
           $data->{'account'}, $data->{'password'}, $data->{'notes'}, $packeddate;
   
       my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );
   
       return if ! $encrypted;
   
       $rec->{'attributes'}{'Dirty'} = 1;
       $rec->{'attributes'}{'dirty'} = 1;
       $rec->{'name'}    ||= $data->{'name'};
       $rec->{'encrypted'} = $encrypted;
   
     return 1;      return 1;
 }  }
   
 sub Decrypt {  sub Decrypt {
     my $self = shift;      my $self = shift;
     my $pass = shift;      my $rec  = shift;
       my $pass = shift || $self->{'password'};
   
     if ($pass) {      if ( ! $pass) {
         $self->_keyring_verify($pass) || return;          croak("'password' not set!\n");
     }      }
   
     $self->{'digest'} ||= _calc_keys( $self->{'password'} );      if ( ! $rec) {
           croak("Needed parameter 'record' not passed!\n");
       }
   
     my $reccount = 0;      if ( ! $self->Password($pass)) {
     foreach my $rec ( @{ $self->{'records'} } ) {          croak("Invalid Password!\n");
         $reccount++;      }
   
         # always skip the first record that has the password in it.      if ( ! $rec->{'encrypted'} ) {
         next if $reccount <= 1;          croak("No encrypted content!");
         if ( ! defined $rec->{'data'} ) {      }
             warn 'Invalid record ' . ( $reccount - 1 ) . "\n";  
             next;  
         }  
   
         my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;      $self->{'digest'} ||= _calc_keys( $pass );
         if (! $encrypted) { next; };  
   
         $rec->{'plaintext'}->{'name'} = $name;      my $decrypted =
           _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );
         my $decrypted = _crypt3des( $encrypted, $self->{'digest'}, $DECRYPT );      my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm,
         my ( $account, $password, $description, $extra ) = split /$NULL/xm,  
           $decrypted, 4;            $decrypted, 4;
   
         $rec->{'plaintext'}->{'account'} = defined $account ? $account : $EMPTY;      my %Modified;
         $rec->{'plaintext'}->{'password'} =      if ($packeddate) {
           defined $password ? $password : $EMPTY;          my $u = unpack 'n', $packeddate;
         $rec->{'plaintext'}->{'description'} =          my $year  = (($u & 0xFE00) >> 9) + 4; # since 1900
           defined $description ? $description : $EMPTY;          my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
           my $day   = (($u & 0x001F) >> 0);     # 1-31
   
         #print "Name:      '$name'\n";          %Modified = (
         #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";              year   => $year,
         #print "    Hex:   '" . unpack("H*", $encrypted) . "'\n";              month  => $month || 0,
         #print "    Binary:'" . unpack("b*", $encrypted) . "'\n";              day    => $day   || 1,
         #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";          );
         #print "    Hex:   '" . unpack("H*", $decrypted) . "'\n";      }
         #print "    Binary:'" . unpack("b*", $decrypted) . "'\n";  
         #print "\n";  
         #print "Extra: $extra\n";  
         #exit;  
         #--------------------------------------------------  
         # print "Account:     $account\n";  
         # print "Password:    $password\n";  
         # print "Description: $description\n";  
         #--------------------------------------------------  
   
       return {
           name       => $rec->{'name'},
           account    => $account,
           password   => $password,
           notes      => $notes,
           lastchange => \%Modified,
       };
   }
   
   sub Password {
       my $self = shift;
       my $pass = shift;
       my $new_pass = shift;
   
       if (! $pass) {
           delete $self->{password};
           return 1;
     }      }
   
     return 1;      if (! exists $self->{'records'}) {
           # Give the PDB the first record that will hold the encrypted password
           $self->{'records'} = [ $self->new_Record ];
   
           return $self->_password_update($pass);
       }
   
       if ($new_pass) {
           my @accts = ();
           foreach my $i (0..$#{ $self->{'records'} }) {
               if ($i == 0) {
                   push @accts, undef;
                   next;
               }
               my $acct = $self->Decrypt($self->{'records'}->[$i], $pass);
               if ( ! $acct ) {
                   croak("Couldn't decrypt $self->{'records'}->[$i]->{'name'}");
               }
               push @accts, $acct;
           }
   
           if ( ! $self->_password_update($new_pass)) {
               croak("Couldn't set new password!");
           }
           $pass = $new_pass;
   
           foreach my $i (0..$#accts) {
               next if $i == 0;
               delete $self->{'records'}->[$i]->{'encrypted'};
               $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);
           }
       }
   
       return $self->_password_verify($pass);
 }  }
   
 sub _calc_keys {  sub _calc_keys {
Line 231 
Line 315 
     return $digest;      return $digest;
 }  }
   
 sub _keyring_verify {  sub _password_verify {
     my $self = shift;      my $self = shift;
     my $pass = shift;      my $pass = shift;
   
     if (! $pass) { croak('No password specified!'); };      if (! $pass) { croak('No password specified!'); };
   
       if (defined $self->{'password'} && $pass eq $self->{'password'}) {
           # already verified this password
           return 1;
       }
   
     # 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
     my $data = $self->{'records'}->[0]->{'data'};      my $data = $self->{'records'}->[0]->{'data'};
   
     #die "No encrypted password in file!" unless defined $data;      #die "No encrypted password in file!" unless defined $data;
     if (! defined $data) { return; };      if ( ! defined $data) { return; };
   
     $data =~ s/$NULL$//xm;      $data =~ s/$NULL$//xm;
   
Line 266 
Line 355 
     return;      return;
 }  }
   
 sub _keyring_update {  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)
Line 275 
Line 364 
     my $self = shift;      my $self = shift;
     my $pass = shift;      my $pass = shift;
   
     if (! $pass) { croak('No password specified!'); };      if (! defined $pass) { croak('No password specified!'); };
   
     # if the database already has a password in it  
     if ( $self->{'records'}->[0]->{'data'} ) {  
   
         # Make sure everything is decrypted before we update the keyring  
         $self->Decrypt() || return;  
     }  
   
     my $salt;      my $salt;
     for ( 1 .. $kSalt_Size ) {      for ( 1 .. $kSalt_Size ) {
         $salt .= chr int rand 255;          $salt .= chr int rand 255;
Line 329 
Line 411 
         #print "PT: '$pt' - Length: " . length($pt) . "\n";          #print "PT: '$pt' - Length: " . length($pt) . "\n";
         if (! length $pt) { next; };          if (! length $pt) { next; };
         if ( (length $pt) < 8 ) {          if ( (length $pt) < 8 ) {
                         if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };              if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
             my $len = 8 - (length $pt);              my $len = 8 - (length $pt);
   
             #print "LENGTH: $len\n";              #print "LENGTH: $len\n";
Line 377 
Line 459 
 It has the standard Palm::PDB methods with 2 additional public methods.  It has the standard Palm::PDB methods with 2 additional public methods.
 Decrypt and Encrypt.  Decrypt and Encrypt.
   
 It currently supports the v4 Keyring databases.  The v5 databases from the pre-release keyring-2.0 are not supported.  It currently supports the v4 Keyring databases.  The v5 databases from
   the pre-release keyring-2.0 are not supported.
   
   This module doesn't store the decrypted content.  It only keeps it until it
   returns it to you or encrypts it.
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
         use Palm::PDB;      use Palm::PDB;
         use Palm::Keyring;      use Palm::Keyring;
         my $pdb = new Palm::PDB;  
         $pdb->Load($file);      my $pass = 'password';
         foreach my $rec (@{ $pdb->{'records'} }) {      my $file = 'Keys-Gtkr.pdb';
                 print "$rec->{'plaintext'}->{'name'}\n";      my $pdb  = new Palm::PDB;
         }      $pdb->Load($file);
         $pdb->Decrypt($password);  
         # do something with the decrypted parts      foreach (0..$#{ $pdb->{'records'} }) {
           next if $_ = 0; # skip the password record
           my $rec  = $pdb->{'records'}->[$_];
           my $acct = $pdb->Decrypt($rec, $pass);
           print $rec->{'name'}, ' - ', $acct->{'account'}, "\n";
       }
   
 =head1 SUBROUTINES/METHODS  =head1 SUBROUTINES/METHODS
   
 =head2 new  =head2 new
   
         $pdb = new Palm::Keyring([$password]);      $pdb = new Palm::Keyring([$password]);
   
 Create a new PDB, initialized with the various Palm::Keyring fields  Create a new PDB, initialized with the various Palm::Keyring fields
 and an empty record list.  and an empty record list.
   
 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().  can just use Palm::PDB::new() before calling Load().
   
 =head2 Load  If you pass in a password, it will initalize the first record with the encrypted
   password.
   
         $pdb->Load($filename[, $password]);  =head2 Encrypt
   
 Overrides the standard Palm::Raw Load() to add      $pdb->Encrypt($rec, $acct[, $password]);
 $rec->{'plaintext'}->{'name'} and  
 $rec->{'encrypted'} fields.  
 $rec->{'plaintext'}->{'name'} holds the name of the record,  
 $rec->{'encrypted'} is the encrypted information in the PDB.  
   
 It also takes an additional optional parameter, which is the password to use to  Encrypts an account into a record, either with the password previously
 decrypt the database.  used, or with a password that is passed.
   
 See Decrypt() for the additional fields that are available after decryption.  $rec is a record from $pdb->{'records'} or a new_Record().
   $acct is a hashref in the format below.
   
 =head2 Write      my $acct = {
           name       => $rec->{'name'},
           account    => $account,
           password   => $password,
           notes      => $notes,
           lastchange => {
               year  => 107, # years since 1900
               month =>   0, # 0-11, 0 = January, 11 = December
               day   =>  30, # 1-31, same as localtime
           },
       };
   
         $pdb->Write($filename[, $password]);  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.
   
 Just like the Palm::Raw::Write() but encrypts everything before saving.  If you pass in a lastchange field that is different than the one in the
   record, it will honor what you passed in.
   
 Also takes an optional password to encrypt with a new password, not needed  Encrypt() only uses the $acct->{'name'} if there is not already a $rec->{'name'}.
 unless you are changing the password.  
   
 =head2 Encrypt  =head2 Decrypt
   
         $pdb->Encrypt([$password]);      my $acct = $pdb->Decrypt($rec[, $password]);
   
 Encrypts the PDB, either with the password used to decrypt or create it, or  Decrypts the record and returns a hashref for the account as described
 optionally with a password that is passed.  under Encrypt().
   
 See Decrypt() for an what plaintext fields are available to be encrypted.      foreach (0..$#{ $pdb->{'records'}) {
           next if $_ == 0;
           my $rec = $pdb->{'records'}->[$_];
           my $acct = $pdb->Decrypt($rec[, $password]);
           # do something with $acct
       }
   
 =head2 Decrypt  =head2 Password
   
         $pdb->Decrypt([$password]);      $pdb->Password([$password[, $new_password]]);
   
 Decrypts the PDB and fills out the rest of the fields available in  Either sets the password to be used to crypt, or if you pass $new_password,
 $rec->{'plaintext'}.  changes the password on the database.
   
 The plaintext should now be this, before encryption or after decryption:  If you have created a new $pdb, and you didn't set a password when you
   called new(), you only need to pass one password and it will set that as
   the password.
   
         $rec->{'plaintext'} = {  If nothing is passed, it forgets the password that it was remembering.
                 name        => $name,  
                 account     => $account,  
                 password    => $account_password,  
                 description => $description,  
         };  
   
 =head1 DEPENDENCIES  =head1 DEPENDENCIES
   
Line 462 
Line 564 
   
 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 489 
Line 604 
   
 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_wxkeyring.html>
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.24
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>