===================================================================
RCS file: /cvs/palm/Palm-Keyring/lib/Palm/Keyring.pm,v
retrieving revision 1.52
retrieving revision 1.65
diff -u -r1.52 -r1.65
--- palm/Palm-Keyring/lib/Palm/Keyring.pm	2007/12/04 03:33:34	1.52
+++ palm/Palm-Keyring/lib/Palm/Keyring.pm	2011/09/19 04:23:37	1.65
@@ -1,5 +1,5 @@
 package Palm::Keyring;
-# $RedRiver: Keyring.pm,v 1.51 2007/09/13 15:46:09 andrew Exp $
+# $RedRiver: Keyring.pm,v 1.62 2008/09/19 06:01:00 andrew Exp $
 ########################################################################
 # Keyring.pm *** Perl class for Keyring for Palm OS databases.
 #
@@ -15,6 +15,8 @@
 use strict;
 use warnings;
 
+require 5.006_001;
+
 use Carp;
 
 use base qw/ Palm::StdAppInfo /;
@@ -57,6 +59,13 @@
         blocksize => 16,
         default_iter => 250,
     },
+    {   # Only for testing
+        alias     => 'TESTING',
+        name      => 'Testing',
+        keylen    => 0,
+        blocksize => 0,
+        default_iter => 0,
+    },
 );
 
 my %LABELS = (
@@ -83,7 +92,7 @@
 );
 
 
-our $VERSION = '0.96_06';
+our $VERSION = '0.96_07';
 
 sub new 
 {
@@ -108,6 +117,7 @@
         else {
             $options->{password} = shift;
             $options->{version}  = shift;
+            $options->{cipher}   = shift;
         }
     }
 
@@ -139,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});
     }
@@ -217,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
@@ -233,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.
@@ -241,7 +255,7 @@
             $self->{encpassword} = $rec->{data};
             return '__DELETE_ME__';
         }
-
+ 
         if ($self->{records}->[0] eq '__DELETE_ME__') {
             shift @{ $self->{records} };
         }
@@ -270,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;
@@ -288,11 +303,13 @@
         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) {
+    } 
+    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};
@@ -308,10 +325,16 @@
 
         $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};
 
-    } else {
+    } 
+    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, @_);
 }
 
@@ -338,7 +361,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}";
@@ -351,10 +374,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
@@ -421,27 +441,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);
@@ -457,13 +465,16 @@
             lastchange => $data->{3}->{data},
             notes      => $data->{255}->{data},
         };
-        my $acctv4 = {
-            name       => $acct->{0}->{data},
-            account    => $acct->{1}->{data},
-            password   => $acct->{2}->{data},
-            lastchange => $acct->{3}->{data},
-            notes      => $acct->{255}->{data},
-        };
+        my $acctv4 = {};
+        if ($acct) {
+            $acctv4 = {
+                name       => $acct->{0}->{data},
+                account    => $acct->{1}->{data},
+                password   => $acct->{2}->{data},
+                lastchange => $acct->{3}->{data},
+                notes      => $acct->{255}->{data},
+            };
+        }
         $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});
 
     } elsif ($self->{version} == 5) {
@@ -473,29 +484,21 @@
             $self->{appinfo}->{cipher},
             $ivec,
         );
-        if (defined $ivec) {
-            $rec->{ivec} = $ivec;
-        }
+        $rec->{ivec} = $ivec if $ivec;
 
     } else {
         croak "Unsupported Version $self->{version}";
     }
 
-    $rec->{plaintext}->{0} = $data->{0};
+    $rec->{plaintext} = $data;
 
-    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 
@@ -578,7 +581,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;
@@ -586,29 +596,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];
@@ -634,8 +674,9 @@
         next if $new->{$k}->{label_id} == 0;
         $plaintext .= _pack_field($new->{$k});
     }
-	#$plaintext .= chr(0xff) x 2;
+    $plaintext .= chr(0xff) x 2;
 
+    #print "CRYPT(e): $c->{name} [$cipher]\n";
     my $encrypted;
     if ($c->{name} eq 'None') {
         # do nothing
@@ -652,12 +693,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 {
@@ -675,22 +712,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 );
@@ -734,11 +760,8 @@
         croak "Unsupported Version $self->{version}";
     }
 
-    if ($plaintext) {
-        $rec->{plaintext} = $plaintext;
-        return $plaintext;
-    }
-    return;
+    $rec->{plaintext} = $plaintext;
+    return $plaintext;
 }
 
 sub _decrypt_v4
@@ -752,6 +775,7 @@
 
     my $modified;
     if ($packed_date) {
+        #print _hexdump('DATE:', $packed_date);
         $modified = _parse_keyring_date($packed_date);
     }
 
@@ -775,11 +799,13 @@
 
     my $plaintext;
 
+    #print "CRYPT(d): $c->{name} [$cipher]\n";
     if ($c->{name} eq 'None') {
         # do nothing
         $plaintext = $encrypted;
 
-    } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
+    } 
+    elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
         require Crypt::CBC;
         my $cbc = Crypt::CBC->new( 
             -key         => $key,
@@ -790,26 +816,23 @@
             -blocksize   => $c->{blocksize},
             -header      => 'none',
             -padding     => 'oneandzeroes',
-        );
+        ) || croak("Unable to set up decryption!");
 
-        if (! $c) {
-            croak("Unable to set up encryption!");
-        }
         my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};
         $encrypted .= $NULL x $len;
+
         $plaintext  = $cbc->decrypt($encrypted);
 
-    } else {
-        croak "Unsupported Crypt $c->{name}";
     } 
+    else {
+        croak "Unsupported Crypt $c->{name} in decrypt";
+    } 
 
     my %fields;
     while ($plaintext) {
         my $field;
         ($field, $plaintext) = _parse_field($plaintext);
-        if (! $field) {
-            last;
-        }
+        last if ! $field;
         $fields{ $field->{label_id} } = $field;
     }
 
@@ -840,16 +863,12 @@
     if ($new_pass) {
         my @accts = ();
         foreach my $rec (@{ $self->{records} }) {
-            my $acct = $self->Decrypt($rec, $pass);
-            if ( ! $acct ) {
-                croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");
-            }
+            my $acct = $self->Decrypt($rec, $pass)
+                || croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");
             push @accts, $acct;
         }
 
-        if ( ! $self->_password_update($new_pass)) {
-            croak("Couldn't set new password!");
-        }
+        $self->_password_update($new_pass);
         $pass = $new_pass;
 
         foreach my $i (0..$#accts) {
@@ -859,30 +878,42 @@
         }
     }
 
+    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;
-            }
-        }
-    } elsif ($self->{version} == 5) {
-        return _password_verify_v5($self->{appinfo}, $pass);
-    } else {
-        croak "Unsupported version $self->{version}";
+        $self->{digest}   = _calc_keys($pass);
+        $self->{password} = $pass;
+
+        return 1;
+    } 
+    elsif ($self->{version} == 5) {
+        _password_verify_v5($self->{appinfo}, $pass);
+        $self->{password} = $pass;
+        return 1;
     }
 
-    return;
+    croak "Unsupported Version $self->{version}";
 }
 
 sub _password_verify_v4 
@@ -893,11 +924,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;
@@ -905,10 +934,10 @@
     my $msg = $salt . $pass; 
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
 
-    my $digest = md5($msg);
+    my $digest = md5($msg) || croak('MD5 Failed');
 
     if ($data ne $salt . $digest ) {
-        return;
+        croak("Incorrect Password!");
     }
 
     return 1;
@@ -935,13 +964,11 @@
     #print "Hash: '". $hash . "'\n";
     #print "Hash: '". $appinfo->{masterhash} . "'\n";
 
-    if ($appinfo->{masterhash} eq $hash) {
-        $appinfo->{key} = $key;
-    } else {
-        return;
+    if ($appinfo->{masterhash} && $appinfo->{masterhash} ne $hash) {
+        croak('Incorrect Password');
     }
-
-    return $key;
+    $appinfo->{key} = $key;
+    return 1;
 }
 
 
@@ -957,10 +984,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
@@ -969,8 +993,8 @@
         $self->{digest}   = _calc_keys( $self->{password} );
 
         return 1;
-
-    } elsif ($self->{version} == 5) {
+    } 
+    elsif ($self->{version} == 5) {
         my $cipher  = shift || $self->{appinfo}->{cipher};
         my $iter    = shift || $self->{appinfo}->{iter};
         my $salt    = shift || 0;
@@ -979,17 +1003,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
@@ -999,7 +1020,7 @@
 
     my $pass = shift;
     
-    if (! defined $pass) { croak('No password specified!'); };
+    croak('No password specified!') if ! defined $pass;
 
     my $salt;
     for ( 1 .. $kSalt_Size ) {
@@ -1010,7 +1031,7 @@
 
     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
 
-    my $digest = md5($msg);
+    my $digest = md5($msg) || croak('MD5 failed');
 
     my $data = $salt . $digest;    # . "\0";
 
@@ -1024,7 +1045,7 @@
     my $cipher  = shift;
     my $iter    = shift;
 
-    # I thought this needed to be 'blocksize', but apparently not.
+    # I thought $length needed to be 'blocksize', but apparently not.
     #my $length  = $CRYPTS[ $cipher ]{blocksize};
     my $length  = 8;
     my $salt    = shift || pack("C*",map {rand(256)} 1..$length);
@@ -1051,9 +1072,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);
@@ -1082,6 +1101,9 @@
 
 sub _calc_keys 
 {
+    require Digest::MD5;
+    import Digest::MD5 qw(md5);
+
     my $pass = shift;
     if (! defined $pass) { croak('No password defined!'); };
 
@@ -1114,7 +1136,7 @@
     import  Digest::SHA1 qw(sha1);
 
     my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );
-    if ($dop) { $key = _DES_odd_parity($key); }
+    $key = _DES_odd_parity($key) if $dop;
 
     my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
 
@@ -1178,7 +1200,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;
@@ -1287,6 +1309,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
@@ -1301,8 +1325,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
@@ -1312,6 +1337,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
@@ -1326,8 +1353,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> 
@@ -1339,7 +1367,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);
@@ -1355,7 +1383,7 @@
     return substr($t, 0, $keylen);
 }
 
-sub _DES_odd_parity($) {
+sub _DES_odd_parity {
     my $key = $_[0];
     my ($r, $i);
     my @odd_parity = (
@@ -1420,7 +1448,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.
@@ -1462,6 +1490,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