=================================================================== RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v retrieving revision 1.20 retrieving revision 1.27 diff -u -r1.20 -r1.27 --- palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/01/31 04:29:08 1.20 +++ palm/Palm-Keyring/lib/Palm/Keyring.pm 2007/02/10 16:21:28 1.27 @@ -1,31 +1,36 @@ package Palm::Keyring; - -# $RedRiver: Keyring.pm,v 1.19 2007/01/31 04:17:15 andrew Exp $ +# $RedRiver: Keyring.pm,v 1.26 2007/02/06 02:58:50 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. - +# +# 2006.01.26 #*#*# andrew fresh +######################################################################## +# 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 warnings; + use Carp; use base qw/ Palm::StdAppInfo /; use Digest::MD5 qw(md5); use Crypt::DES; -use Readonly; -Readonly my $ENCRYPT => 1; -Readonly my $DECRYPT => 0; -Readonly my $MD5_CBLOCK => 64; -Readonly my $kSalt_Size => 4; -Readonly my $EMPTY => q{}; -Readonly my $SPACE => q{ }; -Readonly my $NULL => chr 0; +my $ENCRYPT = 1; +my $DECRYPT = 0; +my $MD5_CBLOCK = 64; +my $kSalt_Size = 4; +my $EMPTY = q{}; +my $SPACE = q{ }; +my $NULL = chr 0; -# One liner, to allow MakeMaker to work. -our $VERSION = 0.92; +our $VERSION = 0.94; sub new { my $classname = shift; @@ -87,9 +92,10 @@ my $self = shift; my $rec = shift; - my $rec0_id = $self->{'records'}->[0]->{'id'}; - - if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) { + if ($rec->{'encrypted'}) { + if (! defined $rec->{'name'}) { + $rec->{'name'} = $EMPTY; + } $rec->{'data'} = join $NULL, $rec->{'name'}, $rec->{'encrypted'}; delete $rec->{'name'}; delete $rec->{'encrypted'}; @@ -120,17 +126,64 @@ croak("Incorrect Password!\n"); } - $self->{'digest'} ||= _calc_keys( $pass ); + $self->{'digest'} ||= _calc_keys( $pass ); $data->{'account'} ||= $EMPTY; $data->{'password'} ||= $EMPTY; $data->{'notes'} ||= $EMPTY; - my %Modified; - my ($day, $month, $year) = (localtime)[3,4,5]; + 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; @@ -202,9 +255,14 @@ sub Password { my $self = shift; - my $pass = shift || $self->{'password'}; + my $pass = shift; my $new_pass = shift; + if (! $pass) { + delete $self->{password}; + return 1; + } + if (! exists $self->{'records'}) { # Give the PDB the first record that will hold the encrypted password $self->{'records'} = [ $self->new_Record ]; @@ -233,6 +291,7 @@ foreach my $i (0..$#accts) { next if $i == 0; + delete $self->{'records'}->[$i]->{'encrypted'}; $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass); } } @@ -442,14 +501,17 @@ Use this method if you're creating a Keyring PDB from scratch otherwise you 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 - $pdb->Encrypt($rec, $acct, [$password]); + $pdb->Encrypt($rec, $acct[, $password]); Encrypts an account into a record, either with the password previously 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. my $acct = { @@ -460,18 +522,24 @@ lastchange => { year => 107, # years since 1900 month => 0, # 0-11, 0 = January, 11 = December - day => 30, # 1-31, same as l + 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 my $acct = $pdb->Decrypt($rec[, $password]); Decrypts the record and returns a hashref for the account as described under Encrypt(). -However, it ignores the "lastchange" field and generates its own. -It also only uses the "name" field if there is not already a $rec->{'name'}. foreach (0..$#{ $pdb->{'records'}) { next if $_ == 0; @@ -491,8 +559,7 @@ called new(), you only need to pass one password and it will set that as the password. -If nothing is passed, and there has been a password used before, -it just verifies that the password was correct. +If nothing is passed, it forgets the password that it was remembering. =head1 DEPENDENCIES @@ -504,9 +571,22 @@ 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 + +I would also like to thank +Johan Vromans +Ejvromans@squirrel.nlE -- +L. +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 -Once this module is uploaded, you can Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be @@ -514,7 +594,7 @@ =head1 AUTHOR -Andrew Fresh Eandrew@mad-techies.orgE +Andrew Fresh Eandrew@cpan.orgE =head1 LICENSE AND COPYRIGHT @@ -531,3 +611,6 @@ The Keyring for Palm OS website: L + +Johan Vromans also has a wxkeyring app that now uses this module, available +from his website at L