===================================================================
RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v
retrieving revision 1.54
retrieving revision 1.64
diff -u -r1.54 -r1.64
--- palm/Palm-Keyring/lib/Palm/Keyring.pm	2007/12/05 05:42:29	1.54
+++ palm/Palm-Keyring/lib/Palm/Keyring.pm	2011/09/19 04:05:11	1.64
@@ -1,5 +1,5 @@
 package Palm::Keyring;
-# $RedRiver: Keyring.pm,v 1.53 2007/12/04 03:34:17 andrew Exp $
+# $RedRiver: Keyring.pm,v 1.61 2008/09/19 05:55:35 andrew Exp $
 ########################################################################
 # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #
@@ -59,6 +59,13 @@
         blocksize => 16,
         default_iter => 250,
     },
+    { 
+        alias     => 'TESTING',
+        name      => 'Testing',
+        keylen    => 8,
+        blocksize => 1,
+        default_iter => 1,
+    },
 );
 
 my %LABELS = (
@@ -110,6 +117,7 @@
         else {
             $options->{password} = shift;
             $options->{version}  = shift;
+            $options->{cipher}   = shift;
         }
     }
 
@@ -141,6 +149,10 @@
         $self->{appinfo}->{iter}   ||= $self->{options}->{iterations};
     };
 
+    if ( defined $options->{file} ) {
+        $self->Load($options->{file});
+    }
+
     if ( defined $options->{password} ) {
         $self->Password($options->{password});
     }
@@ -219,13 +231,13 @@
         }
     }
 
-    my $rc = $self->SUPER::Write(@_);
+    my @rc = $self->SUPER::Write(@_);
 
     if ($self->{version} == 4) {
         shift @{ $self->{records} };
     }
 
-    return $rc;
+    return @rc;
 }
 
 # ParseRecord
@@ -235,7 +247,7 @@
     my $self     = shift;
 
     my $rec = $self->SUPER::ParseRecord(@_);
-    return $rec if ! exists $rec->{data};
+    return $rec if !(defined $rec->{data} && length $rec->{data} );
 
     if ($self->{version} == 4) {
         # skip the first record because it contains the password.
@@ -243,7 +255,7 @@
             $self->{encpassword} = $rec->{data};
             return '__DELETE_ME__';
         }
-
+ 
         if ($self->{records}->[0] eq '__DELETE_ME__') {
             shift @{ $self->{records} };
         }
@@ -272,8 +284,9 @@
         $rec->{encrypted} = substr $extra, $blocksize;
 
     } else {
+        # XXX Can never get here to test, ParseAppInfoBlock is always run
+        # XXX first by Load().
         croak "Unsupported Version $self->{version}";
-        return;
     }
 
     return $rec;
@@ -290,11 +303,12 @@
         if ($rec->{encrypted}) {
             my $name = $rec->{plaintext}->{0}->{data} || $EMPTY;
             $rec->{data} = join $NULL, $name, $rec->{encrypted};
-            delete $rec->{plaintext};
-            delete $rec->{encrypted};
         }
 
     } elsif ($self->{version} == 5) {
+        croak 'No encrypted data in record' if !defined $rec->{encrypted};
+        croak 'No ivec!' if !$rec->{ivec};
+
         my $field;
         if ($rec->{plaintext}->{0}) {
             $field = $rec->{plaintext}->{0};
@@ -313,7 +327,12 @@
     } else {
         croak "Unsupported Version $self->{version}";
     }
+    # XXX Should I?
+    #delete $rec->{plaintext};
+    #delete $rec->{encrypted};
 
+    croak 'No data in record to pack' if !$rec->{data};
+
     return $self->SUPER::PackRecord($rec, @_);
 }
 
@@ -340,7 +359,7 @@
         # Nothing extra for version 4
 
     } elsif ($self->{version} == 5) {
-        _parse_appinfo_v5($appinfo) || return;
+        _parse_appinfo_v5($appinfo);
 
     } else {
         croak "Unsupported Version $self->{version}";
@@ -353,10 +372,7 @@
 {
     my $appinfo = shift;
 
-    if (! exists $appinfo->{other}) {
-        # XXX Corrupt appinfo?
-        return;
-    }
+    croak 'Corrupt appinfo? no {other}' if ! $appinfo->{other};
 
     my $unpackstr
         = ("C1" x 8)  # 8 uint8s in an array for the salt
@@ -423,27 +439,15 @@
 sub Encrypt 
 {
     my $self = shift;
-    my $rec  = shift;
+    my $rec  = shift || croak('Needed parameter [record] not passed!');
     my $pass = shift || $self->{password};
     my $data = shift || $rec->{plaintext};
     my $ivec = shift;
 
-    if ( ! $pass && ! $self->{appinfo}->{key}) {
-        croak("password not set!\n");
-    }
+    $self->_password_verify($pass);
 
-    if ( ! $rec) {
-        croak("Needed parameter 'record' not passed!\n");
-    }
+    if ( !$data ) { croak('Needed parameter [plaintext] not passed!'); }
 
-    if ( ! $data) {
-        croak("Needed 'plaintext' not passed!\n");
-    }
-
-    if ( $pass && ! $self->Password($pass)) {
-        croak("Incorrect Password!\n");
-    }
-
     my $acct;
     if ($rec->{encrypted}) {
         $acct = $self->Decrypt($rec, $pass);
@@ -475,9 +479,7 @@
             $self->{appinfo}->{cipher},
             $ivec,
         );
-        if (defined $ivec) {
-            $rec->{ivec} = $ivec;
-        }
+        $rec->{ivec} = $ivec if $ivec;
 
     } else {
         croak "Unsupported Version $self->{version}";
@@ -485,19 +487,13 @@
 
     $rec->{plaintext}->{0} = $data->{0};
 
-    if ($encrypted) { 
-        if ($encrypted eq '1') {
-            return 1;
-        }
-
+    if ($encrypted ne '1') {
         $rec->{attributes}{Dirty} = 1;
         $rec->{attributes}{dirty} = 1;
         $rec->{encrypted} = $encrypted;
-
-        return 1;
-    } else {
-        return;
     }
+
+    return 1;
 }
 
 sub _encrypt_v4 
@@ -580,7 +576,14 @@
     my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
 
     if (! defined $ivec) { 
-        $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});
+        if (!$c->{blocksize}) {
+            $ivec = $EMPTY;
+        }
+        else {
+            while (! $ivec) {
+                $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});
+            }
+        }
     }
 
     my $changed = 0;
@@ -588,29 +591,59 @@
     if ($new->{3}->{data}) {
         $need_newdate = 0;
     }
-    foreach my $k (keys %{ $new }) {
-        if (! $old) {
-            $changed = 1;
-        } elsif ($k == 3) {
-            if ($old && (
-                    $new->{$k}{data}{day}   == $old->{$k}{data}{day}   &&
-                    $new->{$k}{data}{month} == $old->{$k}{data}{month} &&
-                    $new->{$k}{data}{year}  == $old->{$k}{data}{year}
-                )) {
-                $changed      = 1;
-                $need_newdate = 1;
-            }
 
-        } else {
-            my $n = join ':', sort %{ $new->{$k} };
-            my $o = join ':', sort %{ $old->{$k} };
-            if ($n ne $o) {
+    if ($old) {
+        foreach my $k (keys %{ $new }) {
+            if (! $old->{$k} ) {
                 $changed = 1;
+                last;
+            } 
+            if (! $new->{$k}) {
+                $changed = 1;
+                last;
             }
+            elsif ($k == 3) {
+                if (! $new->{$k}->{data} && $old->{$k}->{data} ) {
+                    $changed = 1;
+                    last;
+                }
+
+                my %n = %{ $new->{$k}->{data} };
+                my %o = %{ $old->{$k}->{data} };
+
+                foreach (qw( day month year )) {
+                    $n{$_} ||= 0;
+                    $o{$_} ||= 0;
+                }
+
+                if (
+                    $n{day}   == $o{day}   &&
+                    $n{month} == $o{month} &&
+                    $n{year}  == $o{year}
+                ) {
+                    $need_newdate = 1;
+                }
+                else {
+                    $changed = 1;
+                    last;
+                }
+
+            } 
+            else {
+                my $n = join ':', sort %{ $new->{$k} };
+                my $o = join ':', sort %{ $old->{$k} };
+                if ($n ne $o) {
+                    $changed = 1;
+                    last;
+                }
+            }
         }
     }
+    else {
+        $changed = 1;
+    }
 
-    return 1, 0 if $changed == 0;
+    return 1 if $changed == 0;
 
     if ($need_newdate) {
         my ($day, $month, $year) = (localtime)[3,4,5];
@@ -654,12 +687,8 @@
             -blocksize   => $c->{blocksize},
             -header      => 'none',
             -padding     => 'oneandzeroes',
-        );
+        ) || croak("Unable to set up encryption!");
 
-        if (! $c) {
-            croak("Unable to set up encryption!");
-        }
-
         $encrypted = $cbc->encrypt($plaintext);
 
     } else {
@@ -677,22 +706,11 @@
     my $rec  = shift;
     my $pass = shift || $self->{password};
 
-    if ( ! $pass && ! $self->{appinfo}->{key}) {
-        croak("password not set!\n");
-    }
+    if ( ! $rec) { croak('Needed parameter [record] not passed!'); } 
+    if ( ! $rec->{encrypted} ) { croak('No encrypted content!'); }
 
-    if ( ! $rec) {
-        croak("Needed parameter 'record' not passed!\n");
-    }
+    $self->_password_verify($pass);
 
-    if ( $pass && ! $self->Password($pass)) {
-        croak("Invalid Password!\n");
-    }
-
-    if ( ! $rec->{encrypted} ) {
-        croak("No encrypted content!");
-    }
-
     my $plaintext;
     if ($self->{version} == 4) {
         $self->{digest} ||= _calc_keys( $pass );
@@ -792,11 +810,8 @@
             -blocksize   => $c->{blocksize},
             -header      => 'none',
             -padding     => 'oneandzeroes',
-        );
+        ) || croak("Unable to set up encryption!");
 
-        if (! $c) {
-            croak("Unable to set up encryption!");
-        }
         my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};
         $encrypted .= $NULL x $len;
         $plaintext  = $cbc->decrypt($encrypted);
@@ -861,30 +876,41 @@
         }
     }
 
+    return $self->_password_verify($pass);
+}
+
+sub _password_verify {
+    my $self = shift;
+    my $pass = shift;
+    if (!defined $pass) {
+        $pass = $self->{password};
+    }
+
+    if ( !$pass ) {
+        croak("Password not set!\n");
+    }
+
     if (defined $self->{password} && $pass eq $self->{password}) {
         # already verified this password
         return 1;
     }
 
     if ($self->{version} == 4) {
-        my $valid = _password_verify_v4($pass, $self->{encpassword});
+        _password_verify_v4($pass, $self->{encpassword});
 
         # 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;
-            }
-        }
+        $self->{digest} = _calc_keys($pass);
+        $self->{password} = $pass;
+        return 1;
+
     } elsif ($self->{version} == 5) {
-        return _password_verify_v5($self->{appinfo}, $pass);
-    } else {
-        croak "Unsupported version $self->{version}";
+        _password_verify_v5($self->{appinfo}, $pass);
+        $self->{password} = $pass;
+        return 1;
     }
 
-    return;
+    croak "Unsupported Version $self->{version}";
 }
 
 sub _password_verify_v4 
@@ -895,11 +921,9 @@
     my $pass = shift;
     my $data = shift;
 
-    if (! $pass) { croak('No password specified!'); };
+    if (! $pass) { croak('No password specified!'); }
+    if (! $data) { croak('No encrypted password in file!'); }
 
-    # 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;
@@ -910,7 +934,7 @@
     my $digest = md5($msg);
 
     if ($data ne $salt . $digest ) {
-        return;
+        croak("Incorrect Password!");
     }
 
     return 1;
@@ -937,13 +961,12 @@
     #print "Hash: '". $hash . "'\n";
     #print "Hash: '". $appinfo->{masterhash} . "'\n";
 
-    if ($appinfo->{masterhash} eq $hash) {
-        $appinfo->{key} = $key;
-    } else {
-        return;
+    if ($appinfo->{masterhash} ne $hash) {
+        croak("Incorrect Password!");
     }
 
-    return $key;
+    $appinfo->{key} = $key;
+    return 1;
 }
 
 
@@ -959,10 +982,7 @@
     if ($self->{version} == 4) {
         my $data = _password_update_v4($pass, @_);
 
-        if (! $data) {
-            carp("Failed  to update password!");
-            return;
-        }
+        if (! $data) { croak "Failed to update password!"; }
 
         # AFAIK the thing we use to test the password is
         #     always in the first entry
@@ -981,17 +1001,14 @@
             $self->{appinfo}, $pass, $cipher, $iter, $salt
         );
 
-        if (! $hash) {
-            carp("Failed  to update password!");
-            return;
-        }
+        if (! $hash) { croak "Failed to update password!"; }
 
+        $self->{password} = $pass;
+
         return 1;
-    } else {
-        croak("Unsupported version ($self->{version})");
     }
 
-    return;
+    croak "Unsupported Version $self->{version}";
 }
 
 sub _password_update_v4
@@ -1053,9 +1070,7 @@
     my ($pass) = @_;
     $pass ||= $self->{password};
 
-    if ( $pass && ! $self->Password($pass)) {
-        croak("Invalid Password!\n");
-    }
+    $self->_password_verify($pass);
 
     foreach my $rec (@{ $self->{records} }) {
         $self->Decrypt($rec);
@@ -1084,6 +1099,9 @@
 
 sub _calc_keys 
 {
+    require Digest::MD5;
+    import Digest::MD5 qw(md5);
+
     my $pass = shift;
     if (! defined $pass) { croak('No password defined!'); };
 
@@ -1180,7 +1198,7 @@
 
     my ($len) = unpack "n", $field;
     if ($len + 4 > length $field) {
-        return undef, $field;
+        return (undef, $field);
     }
     my $unpackstr = "x2 C1 C1 A$len";
     my $offset    =   2 +1 +1 +$len;
@@ -1289,6 +1307,8 @@
     my $maxlines = shift; # Max # of lines to dump
     my $offset;           # Offset of current chunk
 
+    my @lines;
+
     for ($offset = 0; $offset < length($data); $offset += 16)
     {
         my $hex;   # Hex values of the data
@@ -1303,8 +1323,9 @@
 
         ($ascii = $chunk) =~ y/\040-\176/./c;
 
-        printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
+        push @lines, sprintf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
     }
+    return wantarray ? @lines : \@lines;
 }
 
 sub _bindump
@@ -1314,6 +1335,8 @@
     my $maxlines = shift; # Max # of lines to dump
     my $offset;           # Offset of current chunk
 
+    my @lines;
+
     for ($offset = 0; $offset < length($data); $offset += 8)
     {
         my $bin;   # binary values of the data
@@ -1328,8 +1351,9 @@
 
         ($ascii = $chunk) =~ y/\040-\176/./c;
 
-        printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
+        push @lines, sprintf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
     }
+    return wantarray ? @lines : \@lines;
 }
 
 # Thanks to Jochen Hoenicke <hoenicke@gmail.com> 
@@ -1341,7 +1365,7 @@
 # keylen is length of generated key in bytes
 # prf is the pseudo random function (e.g. hmac_sha1)
 # returns the key.
-sub _pbkdf2($$$$$)
+sub _pbkdf2
 {
     my ($password, $salt, $iter, $keylen, $prf) = @_;
     my ($k, $t, $u, $ui, $i);
@@ -1357,7 +1381,7 @@
     return substr($t, 0, $keylen);
 }
 
-sub _DES_odd_parity($) {
+sub _DES_odd_parity {
     my $key = $_[0];
     my ($r, $i);
     my @odd_parity = (
@@ -1422,7 +1446,7 @@
 
 =head2 new
 
-    $pdb = new Palm::Keyring([$password[, $version]]);
+    $pdb = new Palm::Keyring([$password[, $version[, $cipher]]]);
 
 Create a new PDB, initialized with the various Palm::Keyring fields
 and an empty record list.
@@ -1464,6 +1488,10 @@
 =item iterations
 
 The number of iterations to encrypt with.  Only used by somy crypts in v5 databases.
+
+=item file
+
+The name of a file to Load().  This will override many of the other options.
 
 =back