[BACK]Return to Keyring.pm CVS log [TXT][DIR] Up to [local] / palm / Palm-Keyring / lib / Palm

Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.9

1.1       andrew      1: # Palm::Keyring.pm
                      2: #
                      3: # Perl class for dealing with Keyring for Palm OS databases.
                      4: #
                      5: #      Copyright (C) 2004, Andrew Fresh
                      6: #      You may distribute this file under the terms of the Artistic
                      7: #      License, as specified in the README file distributed with the p5-Palm distribution.
                      8: #
                      9: #   This started as Memo.pm, I just made it work for Keyring.
                     10: #
1.9     ! andrew     11: # $Id: Keyring.pm,v 1.8 2006/11/10 17:31:38 andrew Exp $
        !            12: # $RedRiver: Keyring.pm,v 1.8 2006/11/10 17:31:38 andrew Exp $
1.1       andrew     13:
                     14: use strict;
                     15: package Palm::Keyring;
                     16: use Palm::Raw();
                     17: use Palm::StdAppInfo();
                     18: use vars qw( $VERSION @ISA );
                     19:
                     20: use Digest::MD5 qw(md5);
1.2       andrew     21: use Crypt::DES;
1.1       andrew     22:
                     23: use constant ENCRYPT    =>  1;
                     24: use constant DECRYPT    =>  0;
                     25: use constant MD5_CBLOCK => 64;
                     26: my $kSaltSize = 4;
                     27:
                     28:
                     29: # One liner, to allow MakeMaker to work.
1.9     ! andrew     30: $VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
1.1       andrew     31:
                     32: @ISA = qw( Palm::StdAppInfo Palm::Raw );
                     33:
                     34: =head1 NAME
                     35:
                     36: Palm::Keyring - Handler for Palm Keyring databases.
                     37:
                     38: =head1 SYNOPSIS
                     39:
                     40:     use Palm::Keyring;
                     41:        $pdb->Decrypt('mypassword');
                     42:
                     43: =head1 DESCRIPTION
                     44:
                     45: The Keyring PDB handler is a helper class for the Palm::PDB package. It
                     46: parses Keyring databases.  See
                     47: L<http://gnukeyring.sourceforge.net/>.
                     48:
                     49: It is just the standard Palm::Raw with 2 additional public methods.  Decrypt and Encrypt.
                     50:
                     51: =cut
                     52: =head2 new
                     53:
                     54:   $pdb = new Palm::Keyring ('password');
                     55:
                     56: Create a new PDB, initialized with the various Palm::Keyring fields
                     57: and an empty record list.
                     58:
                     59: Use this method if you're creating a Keyring PDB from scratch.
                     60:
                     61: =cut
                     62: #'
                     63: sub new
                     64: {
                     65:        my $classname   = shift;
                     66:        my $pass = shift;
                     67:
1.5       andrew     68:        # Create a generic PDB. No need to rebless it, though.
1.1       andrew     69:        my $self        = $classname->SUPER::new(@_);
                     70:
                     71:        $self->{name} = "Keys-Gtkr";    # Default
                     72:        $self->{creator} = "Gtkr";
                     73:        $self->{type} = "Gkyr";
1.5       andrew     74:        # The PDB is not a resource database by
                     75:        # default, but it's worth emphasizing,
                     76:        # since MemoDB is explicitly not a PRC.
1.1       andrew     77:        $self->{attributes}{resource} = 0;
                     78:
                     79:        # Initialize the AppInfo block
                     80:        $self->{appinfo} = {};
                     81:
                     82:        # Add the standard AppInfo block stuff
                     83:        &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo});
                     84:
                     85:        # Set the version
                     86:        $self->{version} = 4;
                     87:
                     88:        # Give the PDB the first record that will hold the encrypted password
1.5       andrew     89:        $self->{records} = [ {
                     90:                'category'   => 0,
                     91:                'attributes' => {
                     92:                        'private' => 1,
                     93:                        'Secret'  => 1,
                     94:                        'Dirty'   => 1,
1.7       andrew     95:                        'dirty'   => 1,
1.1       andrew     96:                },
1.5       andrew     97:        }, ];
1.1       andrew     98:
                     99:        if ($pass) {
                    100:                $self->Encrypt($pass);
                    101:        }
                    102:
                    103:        return $self;
                    104: }
                    105:
                    106: sub import
                    107: {
                    108:        &Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
                    109:                [ "Gtkr", "Gkyr" ],
                    110:                );
1.3       andrew    111: }
                    112:
                    113: sub Load
                    114: {
                    115:        my $self = shift;
                    116:        $self->SUPER::Load(@_);
                    117:
                    118:        foreach my $record (@{ $self->{records} }) {
1.7       andrew    119:                next unless exists $record->{data};
1.3       andrew    120:                my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7       andrew    121:                next unless $encrypted;
1.3       andrew    122:                $record->{plaintext}->{name} = $name;
                    123:         $record->{encrypted} = $encrypted;
                    124:        }
                    125:        1;
1.6       andrew    126: }
                    127:
                    128: sub Write
                    129: {
                    130:        my $self = shift;
                    131:        $self->Encrypt() || return undef;
                    132:        return $self->SUPER::Load(@_);
1.1       andrew    133: }
                    134:
                    135: sub Encrypt
                    136: {
                    137:        my $self = shift;
                    138:        my $pass = shift;
                    139:
1.7       andrew    140:
1.1       andrew    141:        if ($pass) {
                    142:                unless ($self->_keyring_verify($pass) ) {
                    143:                        # This would encrypt with a new password.
                    144:                        # First decrypting everything with the old password of course.
                    145:                        $self->_keyring_update($pass) || return undef;
                    146:                        $self->_keyring_verify($pass) || return undef;
                    147:                }
                    148:        }
                    149:
1.7       andrew    150:        $self->{digest} ||= _calc_keys($self->{password});
                    151:
1.1       andrew    152:        foreach my $record (@{ $self->{records} }) {
                    153:                next unless defined $record->{plaintext};
                    154:
1.7       andrew    155:                my $name        = defined $record->{plaintext}->{name}        ?
                    156:                        $record->{plaintext}->{name}        : '';
                    157:                my $account     = defined $record->{plaintext}->{account}     ?
                    158:                        $record->{plaintext}->{account}     : '';
                    159:                my $password    = defined $record->{plaintext}->{password}    ?
                    160:                        $record->{plaintext}->{password}    : '';
                    161:                my $description = defined $record->{plaintext}->{description} ?
                    162:                        $record->{plaintext}->{description} : '';
1.1       andrew    163:                my $extra       = '';
                    164:
1.2       andrew    165:                my $plaintext = join("\000", $account, $password, $description, $extra);
1.1       andrew    166:
1.7       andrew    167:                my $encrypted = _crypt3des($plaintext, $self->{digest}, ENCRYPT);
1.1       andrew    168:
1.2       andrew    169:                $record->{data} = join("\000", $name, $encrypted);
1.1       andrew    170:        }
                    171:
                    172:        return 1;
                    173: }
                    174:
                    175: sub Decrypt
                    176: {
                    177:        my $self = shift;
                    178:        my $pass = shift;
                    179:
                    180:        if ($pass) {
                    181:                $self->_keyring_verify($pass) || return undef;
                    182:        }
                    183:
1.7       andrew    184:        $self->{digest} ||= _calc_keys($self->{password});
                    185:
1.1       andrew    186:        foreach my $record (@{ $self->{records} }) {
                    187:                next unless defined $record->{data};
                    188:
1.2       andrew    189:                my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7       andrew    190:                next unless $encrypted;
                    191:
1.1       andrew    192:                $record->{plaintext}->{name} = $name;
                    193:
1.7       andrew    194:                my $decrypted = _crypt3des($encrypted, $self->{digest}, DECRYPT);
1.1       andrew    195:                my ($account, $password, $description, $extra)
1.2       andrew    196:                      = split /\000/, $decrypted, 4;
1.1       andrew    197:
1.7       andrew    198:                $record->{plaintext}->{account}     = defined $account     ?
                    199:                        $account     : '';
                    200:                $record->{plaintext}->{password}    = defined $password    ?
                    201:                        $password    : '';
                    202:                $record->{plaintext}->{description} = defined $description ?
                    203:                        $description : '';
                    204:
                    205:                #print "Name:      '$name'\n";
                    206:                #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
                    207:                #print "    Hex:   '" . unpack("H*", $encrypted) . "'\n";
                    208:                #print "    Binary:'" . unpack("b*", $encrypted) . "'\n";
                    209:                #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
                    210:                #print "    Hex:   '" . unpack("H*", $decrypted) . "'\n";
                    211:                #print "    Binary:'" . unpack("b*", $decrypted) . "'\n";
                    212:                #print "\n";
1.1       andrew    213:                #print "Extra: $extra\n";
1.7       andrew    214:                #exit;
1.1       andrew    215:                #--------------------------------------------------
                    216:                # print "Account:     $account\n";
                    217:                # print "Password:    $password\n";
                    218:                # print "Description: $description\n";
                    219:                #--------------------------------------------------
                    220:
                    221:        }
                    222:
                    223:        return 1;
                    224: }
                    225:
                    226: sub _calc_keys
                    227: {
1.7       andrew    228:        my $pass = shift;
1.1       andrew    229:        die "No password defined!" unless defined $pass;
                    230:
                    231:        my $digest = md5($pass);
                    232:
                    233:        my ($key1, $key2) = unpack('a8a8', $digest);
                    234:        #--------------------------------------------------
                    235:        # print "key1: $key1: ", length $key1, "\n";
                    236:        # print "key2: $key2: ", length $key2, "\n";
                    237:        #--------------------------------------------------
                    238:
                    239:        $digest = unpack('H*', $key1 . $key2 . $key1);
                    240:        #--------------------------------------------------
                    241:        # print "Digest: ", $digest, "\n";
                    242:        # print length $digest, "\n";
                    243:        #--------------------------------------------------
                    244:
                    245:        return $digest;
                    246: }
                    247:
                    248: sub _keyring_verify
                    249: {
                    250:        my $self = shift;
                    251:        my $pass = shift;
                    252:
1.4       andrew    253:        die "No password specified!" unless $pass;
1.1       andrew    254:        $self->{password} = $pass;
                    255:
                    256:        # AFAIK the thing we use to test the password is
                    257:        #     always in the first entry
1.7       andrew    258:        my $data = $self->{records}->[1]->{data};
1.1       andrew    259:        #die "No encrypted password in file!" unless defined $data;
                    260:        return undef unless defined $data;
                    261:
                    262:        $data =~ s/\0$//;
                    263:
                    264:        my $salt = substr($data, 0, $kSaltSize);
                    265:
                    266:        my $msg = $salt . $pass;
                    267:
                    268:        $msg .= "\0" x (MD5_CBLOCK - length($msg));
                    269:
                    270:        my $digest = md5($msg);
                    271:
                    272:        if ($data eq $salt . $digest) {
                    273:                # May as well generate the keys we need now, since we know the password is right
1.7       andrew    274:                $self->{digest} = _calc_keys($self->{password});
                    275:                if ($self->{digest}) {
1.1       andrew    276:                        return 1;
                    277:                } else {
                    278:                        return undef;
                    279:                }
                    280:        } else {
                    281:                return undef;
                    282:        }
                    283: }
                    284:
                    285: sub _keyring_update
                    286: {
                    287:        # It is very important to Encrypt after calling this
                    288:        #     (Although it is generally only called by Encrypt)
                    289:        # because otherwise the data will be out of sync with the
                    290:        # password, and that would suck!
                    291:        my $self = shift;
                    292:        my $pass = shift;
                    293:
1.4       andrew    294:        die "No password specified!" unless $pass;
1.1       andrew    295:
                    296:        # if the database already has a password in it
1.7       andrew    297:        if ($self->{records}->[1]->{data}) {
1.1       andrew    298:                # Make sure everything is decrypted before we update the keyring
                    299:                $self->Decrypt() || return undef;
                    300:        }
                    301:
                    302:        my $salt;
                    303:        for (1..$kSaltSize) {
                    304:                $salt .= chr(int(rand(255)));
                    305:        }
                    306:
                    307:        my $msg = $salt . $pass;
                    308:
                    309:        $msg .= "\0" x (MD5_CBLOCK - length($msg));
                    310:
                    311:        my $digest = md5($msg);
                    312:
                    313:        my $data = $salt . $digest;# . "\0";
                    314:
                    315:        # AFAIK the thing we use to test the password is
                    316:        #     always in the first entry
1.7       andrew    317:        $self->{records}->[1]->{data} = $data;
1.1       andrew    318:
                    319:        $self->{password} = $pass;
1.7       andrew    320:        $self->{digest}   = _calc_keys($self->{password});
1.1       andrew    321:
                    322:        return 1;
                    323: }
                    324:
1.2       andrew    325:
1.8       andrew    326: # XXX It looks like they are using des_ecb2_encrypt so I dunno if that is different
1.2       andrew    327: sub _crypt3des {
1.7       andrew    328:        my ( $plaintext, $passphrase, $flag ) = @_;
1.2       andrew    329:
1.4       andrew    330:        $passphrase .= ' ' x (16*3);
                    331:        my $cyphertext = "";
1.2       andrew    332:
1.4       andrew    333:        my $size = length ( $plaintext );
                    334:        #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
1.2       andrew    335:
1.5       andrew    336:        my @C;
1.4       andrew    337:        for ( 0..2 ) {
1.5       andrew    338:                $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
1.4       andrew    339:        }
1.9     ! andrew    340:
        !           341:
        !           342: # XXX From Crypt::TripleDES
        !           343: # http://search.cpan.org/src/VIPUL/Crypt-TripleDES-0.24/lib/Crypt/TripleDES.pm
        !           344: #
        !           345: #    for ( 0 .. (($size)/8) -1 ) {
        !           346: #     my $pt = substr( $plaintext, $_*8, 8 );
        !           347: #        $pt = Crypt::PPDES::des_ecb_encrypt( $flag ? $keyvecs{0} : $keyvecs{2}, $flag, $pt );
        !           348: #        $pt = Crypt::PPDES::des_ecb_encrypt( $keyvecs{1}, (not $flag), $pt );
        !           349: #        $pt = Crypt::PPDES::des_ecb_encrypt( $flag ? $keyvecs{2} : $keyvecs{0}, $flag, $pt );
        !           350: #        $cyphertext .= $pt;
        !           351: #    }
1.4       andrew    352:
                    353:        for ( 0 .. (($size)/8) - 1) {
                    354:                my $pt = substr( $plaintext, $_*8, 8 );
                    355:                #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    356:                if (length($pt) < 8) {
1.8       andrew    357:                        die "record not 8 byte padded" if  $flag == DECRYPT;
1.4       andrew    358:                        my $len = 8 - length($pt);
1.8       andrew    359:                        #print "LENGTH: $len\n";
                    360:                        #print "Binary:    '" . unpack("b*", $pt) . "'\n";
1.4       andrew    361:                        $pt .= (chr(0) x $len);# . $pt;
1.8       andrew    362:                        #print "Binary:    '" . unpack("b*", $pt) . "'\n";
1.4       andrew    363:                        #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    364:                }
1.5       andrew    365:                $pt = $C[0]->decrypt( $pt );
                    366:                $pt = $C[1]->encrypt( $pt );
                    367:                $pt = $C[2]->decrypt( $pt );
1.4       andrew    368:                #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    369:                $cyphertext .= $pt;
                    370:        }
                    371:
                    372:        return substr ( $cyphertext, 0, $size );
1.2       andrew    373: }
1.1       andrew    374:
                    375: 1;
                    376: __END__
                    377:
                    378: =head1 AUTHOR
                    379:
                    380: Andrew Fresh E<lt>andrew@mad-techies.org<gt>
                    381:
                    382: =head1 SEE ALSO
                    383:
                    384: Palm::PDB(3)
                    385:
                    386: Palm::StdAppInfo(3)
                    387:
                    388: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>