[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.4

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.4     ! andrew     11: # $Id: Keyring.pm,v 1.3 2006/02/02 00:59:08 andrew Exp $
        !            12: # $RedRiver: Keyring.pm,v 1.3 2006/02/02 00:59:08 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.4     ! andrew     30: $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\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:
                     68:        my $self        = $classname->SUPER::new(@_);
                     69:                        # Create a generic PDB. No need to rebless it,
                     70:                        # though.
                     71:
                     72:        $self->{name} = "Keys-Gtkr";    # Default
                     73:        $self->{creator} = "Gtkr";
                     74:        $self->{type} = "Gkyr";
                     75:        $self->{attributes}{resource} = 0;
                     76:                                # The PDB is not a resource database by
                     77:                                # default, but it's worth emphasizing,
                     78:                                # since MemoDB is explicitly not a PRC.
                     79:
                     80:        # Initialize the AppInfo block
                     81:        $self->{appinfo} = {};
                     82:
                     83:        # Add the standard AppInfo block stuff
                     84:        &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo});
                     85:
                     86:        # Set the version
                     87:        $self->{version} = 4;
                     88:
                     89:        # Give the PDB the first record that will hold the encrypted password
                     90:        $self->{records} = [
                     91:                {
                     92:                  'category' => 0,
                     93:                  'attributes' => {
                     94:                                                        'private' => 1,
                     95:                                                        'Secret' => 1,
                     96:                                                        'Dirty' => 1,
                     97:                                                        'dirty' => 1
                     98:                                                  },
                     99:                },
                    100:        ];
                    101:
                    102:        if ($pass) {
                    103:                $self->Encrypt($pass);
                    104:        }
                    105:
                    106:        return $self;
                    107: }
                    108:
                    109: sub import
                    110: {
                    111:        &Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
                    112:                [ "Gtkr", "Gkyr" ],
                    113:                );
1.3       andrew    114: }
                    115:
                    116: sub Load
                    117: {
                    118:        my $self = shift;
                    119:        $self->SUPER::Load(@_);
                    120:
                    121:        # Skip the first 2 records because they are special
                    122:        # and don't have any plaintext
                    123:        my $skip = 0;
                    124:        foreach my $record (@{ $self->{records} }) {
                    125:                if ($skip < 2) {
                    126:                        $skip++;
                    127:                        next;
                    128:                }
                    129:                my ($name, $encrypted) = split /\000/, $record->{data}, 2;
                    130:                $record->{plaintext}->{name} = $name;
                    131:         $record->{encrypted} = $encrypted;
                    132:        }
                    133:        1;
1.1       andrew    134: }
                    135:
                    136: sub Encrypt
                    137: {
                    138:        my $self = shift;
                    139:        my $pass = shift;
                    140:
                    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:
                    150:        my $seen_enc_pass = 0;
                    151:        foreach my $record (@{ $self->{records} }) {
                    152:                unless ($seen_enc_pass) {
                    153:                        $seen_enc_pass = 1;
                    154:                        next;
                    155:                }
                    156:
                    157:                next unless defined $record->{plaintext};
                    158:
                    159:                my $name        = defined $record->{plaintext}->{name}        ? $record->{plaintext}->{name}        : '';
                    160:                my $account     = defined $record->{plaintext}->{account}     ? $record->{plaintext}->{account}     : '';
                    161:                my $password    = defined $record->{plaintext}->{password}    ? $record->{plaintext}->{password}    : '';
                    162:                my $description = defined $record->{plaintext}->{description} ? $record->{plaintext}->{description} : '';
                    163:                my $extra       = '';
                    164:
1.2       andrew    165:                my $plaintext = join("\000", $account, $password, $description, $extra);
1.1       andrew    166:
1.2       andrew    167:                my $encrypted = $self->_crypt3des($plaintext, 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:
                    184:        my $seen_enc_pass = 0;
                    185:        foreach my $record (@{ $self->{records} }) {
                    186:                unless ($seen_enc_pass) {
                    187:                        # need to skip the first record because it is the encrypted password
                    188:                        $seen_enc_pass = 1;
                    189:                        next;
                    190:                }
                    191:
                    192:                next unless defined $record->{data};
                    193:
1.2       andrew    194:                my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.1       andrew    195:                $record->{plaintext}->{name} = $name;
                    196:
1.2       andrew    197:                my $decrypted = $self->_crypt3des($encrypted, DECRYPT);
1.1       andrew    198:                my ($account, $password, $description, $extra)
1.2       andrew    199:                      = split /\000/, $decrypted, 4;
1.1       andrew    200:
                    201:                $record->{plaintext}->{account}     = defined $account     ? $account     : '';
                    202:                $record->{plaintext}->{password}    = defined $password    ? $password    : '';
                    203:                $record->{plaintext}->{description} = defined $description ? $description : '';
                    204:
1.4     ! andrew    205:         #print "Name:      '$name'\n";
        !           206:         #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
1.2       andrew    207:         #print "Hex:       '" . unpack("H*", $encrypted) . "'\n";
                    208:         #print "Binary:    '" . unpack("b*", $encrypted) . "'\n";
1.4     ! andrew    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";
                    214:                #--------------------------------------------------
                    215:                # print "Account:     $account\n";
                    216:                # print "Password:    $password\n";
                    217:                # print "Description: $description\n";
                    218:                #--------------------------------------------------
                    219:
                    220:        }
                    221:
                    222:        return 1;
                    223: }
                    224:
                    225: sub _calc_keys
                    226: {
                    227:        my $self = shift;
                    228:
                    229:        my $pass = $self->{'password'};
                    230:        die "No password defined!" unless defined $pass;
                    231:
                    232:        my $digest = md5($pass);
                    233:
                    234:        my ($key1, $key2) = unpack('a8a8', $digest);
                    235:        #--------------------------------------------------
                    236:        # print "key1: $key1: ", length $key1, "\n";
                    237:        # print "key2: $key2: ", length $key2, "\n";
                    238:        #--------------------------------------------------
                    239:
                    240:        $digest = unpack('H*', $key1 . $key2 . $key1);
                    241:        #--------------------------------------------------
                    242:        # print "Digest: ", $digest, "\n";
                    243:        # print length $digest, "\n";
                    244:        #--------------------------------------------------
                    245:
                    246:        $self->{digest} = $digest;
                    247:        return $digest;
                    248: }
                    249:
                    250: sub _keyring_verify
                    251: {
                    252:        my $self = shift;
                    253:        my $pass = shift;
                    254:
1.4     ! andrew    255:        die "No password specified!" unless $pass;
1.1       andrew    256:        $self->{password} = $pass;
                    257:
                    258:        # AFAIK the thing we use to test the password is
                    259:        #     always in the first entry
                    260:        my $data = $self->{records}->[0]->{data};
                    261:        #die "No encrypted password in file!" unless defined $data;
                    262:        return undef unless defined $data;
                    263:
                    264:        $data =~ s/\0$//;
                    265:
                    266:        my $salt = substr($data, 0, $kSaltSize);
                    267:
                    268:        my $msg = $salt . $pass;
                    269:
                    270:        $msg .= "\0" x (MD5_CBLOCK - length($msg));
                    271:
                    272:        my $digest = md5($msg);
                    273:
                    274:        if ($data eq $salt . $digest) {
                    275:                # May as well generate the keys we need now, since we know the password is right
                    276:                if ($self->_calc_keys()) {
                    277:                        return 1;
                    278:                } else {
                    279:                        return undef;
                    280:                }
                    281:        } else {
                    282:                return undef;
                    283:        }
                    284: }
                    285:
                    286: sub _keyring_update
                    287: {
                    288:        # It is very important to Encrypt after calling this
                    289:        #     (Although it is generally only called by Encrypt)
                    290:        # because otherwise the data will be out of sync with the
                    291:        # password, and that would suck!
                    292:        my $self = shift;
                    293:        my $pass = shift;
                    294:
1.4     ! andrew    295:        die "No password specified!" unless $pass;
1.1       andrew    296:
                    297:        # if the database already has a password in it
                    298:        if ($self->{records}->[0]->{data}) {
                    299:                # Make sure everything is decrypted before we update the keyring
                    300:                $self->Decrypt() || return undef;
                    301:        }
                    302:
                    303:        my $salt;
                    304:        for (1..$kSaltSize) {
                    305:                $salt .= chr(int(rand(255)));
                    306:        }
                    307:
                    308:        my $msg = $salt . $pass;
                    309:
                    310:        $msg .= "\0" x (MD5_CBLOCK - length($msg));
                    311:
                    312:        my $digest = md5($msg);
                    313:
                    314:        my $data = $salt . $digest;# . "\0";
                    315:
                    316:        # AFAIK the thing we use to test the password is
                    317:        #     always in the first entry
                    318:        $self->{records}->[0]->{data} = $data;
                    319:
                    320:        $self->{password} = $pass;
                    321:        $self->_calc_keys();
                    322:
                    323:        return 1;
                    324: }
                    325:
1.2       andrew    326:
                    327: # XXX Have to make this encrypt as well as decrypting, but w00 h00!
                    328: # do null padding on the end of a cleartext if we are going to encrypt it
                    329: sub _crypt3des {
1.4     ! andrew    330:        my ( $self, $plaintext, $flag ) = @_;
1.2       andrew    331:
                    332:        my $passphrase = $self->{digest} || $self->_calc_keys();
1.4     ! andrew    333:        $passphrase .= ' ' x (16*3);
        !           334:        my $cyphertext = "";
1.2       andrew    335:
                    336:
1.4     ! andrew    337:        my $size = length ( $plaintext );
        !           338:        #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
1.2       andrew    339:
1.4     ! andrew    340:        # This check should see if it is plaintext first, if it is,
        !           341:        #   pad it with \000
        !           342:        # if not, then die
        !           343:        die "record not 8 byte padded" if (length($plaintext) % 8) && ! $flag;
1.2       andrew    344:
1.4     ! andrew    345:        my %C;
        !           346:        for ( 0..2 ) {
        !           347:                $C{$_} = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
        !           348:        }
        !           349:
        !           350:        for ( 0 .. (($size)/8) - 1) {
        !           351:                my $pt = substr( $plaintext, $_*8, 8 );
        !           352:                #print "PT: '$pt' - Length: " . length($pt) . "\n";
        !           353:                if (length($pt) < 8) {
        !           354:                        my $len = 8 - length($pt);
        !           355:                        print "LENGTH: $len\n";
        !           356:                        print "Binary:    '" . unpack("b*", $pt) . "'\n";
        !           357:                        $pt .= (chr(0) x $len);# . $pt;
        !           358:                        print "Binary:    '" . unpack("b*", $pt) . "'\n";
        !           359:                        #print "PT: '$pt' - Length: " . length($pt) . "\n";
        !           360:                }
        !           361:                $pt = $C{0}->decrypt( $pt );
        !           362:                $pt = $C{1}->encrypt( $pt );
        !           363:                $pt = $C{2}->decrypt( $pt );
        !           364:                #print "PT: '$pt' - Length: " . length($pt) . "\n";
        !           365:                $cyphertext .= $pt;
        !           366:        }
        !           367:
        !           368:        return substr ( $cyphertext, 0, $size );
1.2       andrew    369: }
1.1       andrew    370:
                    371: 1;
                    372: __END__
                    373:
                    374: =head1 AUTHOR
                    375:
                    376: Andrew Fresh E<lt>andrew@mad-techies.org<gt>
                    377:
                    378: =head1 SEE ALSO
                    379:
                    380: Palm::PDB(3)
                    381:
                    382: Palm::StdAppInfo(3)
                    383:
                    384: =cut

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