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

version 1.17, 2007/01/30 05:16:16 version 1.24, 2007/02/03 00:52:43
Line 1 
Line 1 
 package Palm::Keyring;  package Palm::Keyring;
   
 # $RedRiver: Keyring.pm,v 1.16 2007/01/30 04:59:55 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 = 0.91;  
   
 sub new {  sub new {
     my $classname = shift;      my $classname = shift;
Line 71 
Line 69 
   
     # skip the 0 record that holds the password      # skip the 0 record that holds the password
     return $rec if ! exists $self->{'records'};      return $rec if ! exists $self->{'records'};
   
     # skip records with no data (There shouldn't be any)  
     return $rec if ! exists $rec->{'data'};      return $rec if ! exists $rec->{'data'};
   
     my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;      my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
   
     return $rec if ! $encrypted;      return $rec if ! $encrypted;
     $rec->{'data'} = $name;      delete $rec->{'data'};
       $rec->{'name'} = $name;
     $rec->{'encrypted'} = $encrypted;      $rec->{'encrypted'} = $encrypted;
   
     return $rec;      return $rec;
Line 88 
Line 85 
     my $self = shift;      my $self = shift;
     my $rec  = shift;      my $rec  = shift;
   
     my $rec0_id = $self->{'records'}->[0]->{'id'};      if ($rec->{'encrypted'}) {
           if (! defined $rec->{'name'}) {
     if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) {              $rec->{'name'} = $EMPTY;
         $rec->{'data'} = join $NULL, $rec->{'data'}, $rec->{'encrypted'};          }
           $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'};
           delete $rec->{'name'};
         delete $rec->{'encrypted'};          delete $rec->{'encrypted'};
     }      }
   
Line 120 
Line 119 
         croak("Incorrect Password!\n");          croak("Incorrect Password!\n");
     }      }
   
     $self->{'digest'} ||= _calc_keys( $pass );      $self->{'digest'}   ||= _calc_keys( $pass );
   
     $data->{'account'}  ||= $EMPTY;      $data->{'account'}  ||= $EMPTY;
     $data->{'password'} ||= $EMPTY;      $data->{'password'} ||= $EMPTY;
     $data->{'notes'}    ||= $EMPTY;      $data->{'notes'}    ||= $EMPTY;
   
       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;
           }
   
       } 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,      my $plaintext = join $NULL,
         $data->{'account'}, $data->{'password'}, $data->{'notes'};          $data->{'account'}, $data->{'password'}, $data->{'notes'}, $packeddate;
   
     my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );      my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );
   
     return if ! $encrypted;      return if ! $encrypted;
   
     $rec->{'data'} ||= $data->{'name'};      $rec->{'attributes'}{'Dirty'} = 1;
       $rec->{'attributes'}{'dirty'} = 1;
       $rec->{'name'}    ||= $data->{'name'};
     $rec->{'encrypted'} = $encrypted;      $rec->{'encrypted'} = $encrypted;
   
     return 1;      return 1;
 }  }
   
Line 148 
Line 205 
     }      }
   
     if ( ! $rec) {      if ( ! $rec) {
         carp("Needed parameter 'record' not passed!\n");          croak("Needed parameter 'record' not passed!\n");
         return;  
     }      }
   
     if ( ! $self->Password($pass)) {      if ( ! $self->Password($pass)) {
Line 164 
Line 220 
   
     my $decrypted =      my $decrypted =
         _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );          _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );
     my ( $account, $password, $notes, $extra ) = split /$NULL/xm,      my ( $account, $password, $notes, $packeddate ) = split /$NULL/xm,
           $decrypted, 4;            $decrypted, 4;
   
       my %Modified;
       if ($packeddate) {
           my $u = unpack 'n', $packeddate;
           my $year  = (($u & 0xFE00) >> 9) + 4; # since 1900
           my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
           my $day   = (($u & 0x001F) >> 0);     # 1-31
   
           %Modified = (
               year   => $year,
               month  => $month || 0,
               day    => $day   || 1,
           );
       }
   
     return {      return {
         account  => $account,          name       => $rec->{'name'},
         password => $password,          account    => $account,
         notes    => $notes,          password   => $password,
           notes      => $notes,
           lastchange => \%Modified,
     };      };
 }  }
   
 sub 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 (! $pass) {
           delete $self->{password};
           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 ];
Line 195 
Line 272 
             }              }
             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]->{'data'}");                  croak("Couldn't decrypt $self->{'records'}->[$i]->{'name'}");
             }              }
             push @accts, $acct;              push @accts, $acct;
         }          }
Line 207 
Line 284 
   
         foreach my $i (0..$#accts) {          foreach my $i (0..$#accts) {
             next if $i == 0;              next if $i == 0;
               delete $self->{'records'}->[$i]->{'encrypted'};
             $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);              $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);
         }          }
     }      }
Line 393 
Line 471 
     use Palm::Keyring;      use Palm::Keyring;
   
     my $pass = 'password';      my $pass = 'password';
     my $pdb = new Palm::PDB;      my $file = 'Keys-Gtkr.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->{'data'}, ' - ', $acct->{'account'}, "\n";          print $rec->{'name'}, ' - ', $acct->{'account'}, "\n";
     }      }
   
 =head1 SUBROUTINES/METHODS  =head1 SUBROUTINES/METHODS
Line 415 
Line 494 
 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 = {
         account  => $account,          name       => $rec->{'name'},
         password => $password,          account    => $account,
         notes    => $notes,          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
           },
     };      };
   
   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.
   
   If you pass in a lastchange field that is different than the one in the
   record, it will honor what you passed in.
   
   Encrypt() only uses the $acct->{'name'} if there is not already a $rec->{'name'}.
   
 =head2 Decrypt  =head2 Decrypt
   
     my $acct = $pdb->Decrypt($rec[, $password]);      my $acct = $pdb->Decrypt($rec[, $password]);
   
 Decrypts the record and returns a hashref for the account as described  Decrypts the record and returns a hashref for the account as described
 under Encrypt();  under Encrypt().
   
     foreach (0..$#{ $pdb->{'records'}) {      foreach (0..$#{ $pdb->{'records'}) {
         next if $_ == 0;          next if $_ == 0;
Line 456 
Line 552 
 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 469 
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 496 
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.17  
changed lines
  Added in v.1.24
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>