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

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.12    ! andrew     11: # $RedRiver: Keyring.pm,v 1.11 2007/01/27 23:59:29 andrew Exp $
1.1       andrew     12:
                     13: use strict;
                     14: package Palm::Keyring;
                     15: use Palm::Raw();
                     16: use Palm::StdAppInfo();
                     17: use vars qw( $VERSION @ISA );
                     18:
                     19: use Digest::MD5 qw(md5);
1.2       andrew     20: use Crypt::DES;
1.1       andrew     21:
                     22: use constant ENCRYPT    =>  1;
                     23: use constant DECRYPT    =>  0;
                     24: use constant MD5_CBLOCK => 64;
                     25: my $kSaltSize = 4;
                     26:
                     27:
                     28: # One liner, to allow MakeMaker to work.
1.12    ! andrew     29: $VERSION = do { my @r = (q$Revision: 1.11 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
1.1       andrew     30:
                     31: @ISA = qw( Palm::StdAppInfo Palm::Raw );
                     32:
                     33: =head1 NAME
                     34:
                     35: Palm::Keyring - Handler for Palm Keyring databases.
                     36:
                     37: =head1 SYNOPSIS
                     38:
1.12    ! andrew     39:        use Palm::PDB;
1.11      andrew     40:        use Palm::Keyring;
1.12    ! andrew     41:        my $pdb = new Palm::PDB;
1.11      andrew     42:        $pdb->Load($file);
1.12    ! andrew     43:        foreach my $record (@{ $pdb->{'records'} }) {
        !            44:                print "$record->{'plaintext'}->{'name'}\n";
        !            45:        }
        !            46:        $pdb->Decrypt($password);
        !            47:        # do something with the decrypted parts
1.1       andrew     48:
                     49: =head1 DESCRIPTION
                     50:
                     51: The Keyring PDB handler is a helper class for the Palm::PDB package. It
1.11      andrew     52: parses Keyring for Palm OS databases.  See
1.1       andrew     53: L<http://gnukeyring.sourceforge.net/>.
                     54:
1.12    ! andrew     55: It has the standard Palm::PDB methods with 2 additional public methods.
1.11      andrew     56: Decrypt and Encrypt.
1.1       andrew     57:
1.12    ! andrew     58: It currently supports the v4 Keyring databases.  The v5 databases from the pre-release keyring-2.0 are not supported.
        !            59:
1.1       andrew     60: =cut
1.11      andrew     61:
1.1       andrew     62: =head2 new
                     63:
1.12    ! andrew     64:        $pdb = new Palm::Keyring([$password]);
1.1       andrew     65:
                     66: Create a new PDB, initialized with the various Palm::Keyring fields
                     67: and an empty record list.
                     68:
1.12    ! andrew     69: Use this method if you're creating a Keyring PDB from scratch otherwise you
        !            70: can just use Palm::PDB::new().
1.1       andrew     71:
                     72: =cut
1.11      andrew     73:
1.1       andrew     74: sub new
                     75: {
                     76:        my $classname   = shift;
                     77:        my $pass = shift;
                     78:
1.5       andrew     79:        # Create a generic PDB. No need to rebless it, though.
1.1       andrew     80:        my $self        = $classname->SUPER::new(@_);
                     81:
                     82:        $self->{name} = "Keys-Gtkr";    # Default
                     83:        $self->{creator} = "Gtkr";
                     84:        $self->{type} = "Gkyr";
1.5       andrew     85:        # The PDB is not a resource database by
                     86:        # default, but it's worth emphasizing,
                     87:        # since MemoDB is explicitly not a PRC.
1.1       andrew     88:        $self->{attributes}{resource} = 0;
                     89:
                     90:        # Initialize the AppInfo block
                     91:        $self->{appinfo} = {};
                     92:
                     93:        # Add the standard AppInfo block stuff
                     94:        &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo});
                     95:
                     96:        # Set the version
                     97:        $self->{version} = 4;
                     98:
                     99:        # Give the PDB the first record that will hold the encrypted password
1.10      andrew    100:        $self->{records} = [ $self->new_Record ];
1.1       andrew    101:
1.11      andrew    102:        if (defined $pass) {
1.1       andrew    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:
1.11      andrew    116: =pod
                    117:
                    118: =head2 Load
                    119:
                    120:        $pdb->Load($filename[, $password]);
                    121:
                    122: Overrides the standard Palm::Raw Load() to add
                    123: $record->{'plaintext'}->{'name'} and
                    124: $record->{'encrypted'} fields.
                    125: $record->{'plaintext'}->{'name'} holds the name of the record,
                    126: $record->{'encrypted'} is the encrypted information in the PDB.
                    127:
                    128: It also takes an additional optional parameter, which is the password to use to
                    129: decrypt the database.
                    130:
                    131: See Decrypt() for the additional fields that are available after decryption.
                    132:
                    133: =cut
                    134:
1.3       andrew    135: sub Load
                    136: {
1.11      andrew    137:        my $self     = shift;
                    138:        my $filename = shift;
                    139:        my $password = shift;
                    140:
1.10      andrew    141:        $self->{'appinfo'} = {};
                    142:        $self->{'records'} = [];
1.11      andrew    143:        $self->SUPER::Load($filename);
1.3       andrew    144:
                    145:        foreach my $record (@{ $self->{records} }) {
1.7       andrew    146:                next unless exists $record->{data};
1.3       andrew    147:                my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7       andrew    148:                next unless $encrypted;
1.3       andrew    149:                $record->{plaintext}->{name} = $name;
                    150:         $record->{encrypted} = $encrypted;
                    151:        }
1.11      andrew    152:
                    153:        return $self->Decrypt($password) if defined $password;
                    154:
1.3       andrew    155:        1;
1.6       andrew    156: }
                    157:
1.11      andrew    158: =pod
                    159:
                    160: =head2 Write
                    161:
                    162:        $pdb->Write($filename[, $password]);
                    163:
                    164: Just like the Palm::Raw::Write() but encrypts everything before saving.
                    165:
                    166: Also takes an optional password to encrypt with a new password, not needed
                    167: unless you are changing the password.
                    168:
                    169: =cut
                    170:
1.6       andrew    171: sub Write
                    172: {
                    173:        my $self = shift;
1.11      andrew    174:        my $filename = shift;
                    175:        my $password = shift;
                    176:
                    177:        $self->Encrypt($password) || return undef;
                    178:        return $self->SUPER::Write($filename);
1.1       andrew    179: }
                    180:
1.11      andrew    181: =pod
                    182:
                    183: =head2 Encrypt
                    184:
                    185:        $pdb->Encrypt([$password]);
                    186:
                    187: Encrypts the PDB, either with the password used to decrypt or create it, or
                    188: optionally with a password that is passed.
                    189:
                    190: See Decrypt() for an what plaintext fields are available to be encrypted.
                    191:
                    192: =cut
                    193:
1.1       andrew    194: sub Encrypt
                    195: {
                    196:        my $self = shift;
                    197:        my $pass = shift;
                    198:
                    199:        if ($pass) {
1.11      andrew    200:                unless (exists $self->{'records'}->[0]->{'data'} &&
                    201:                    $self->_keyring_verify($pass) ) {
1.1       andrew    202:                        # This would encrypt with a new password.
                    203:                        # First decrypting everything with the old password of course.
                    204:                        $self->_keyring_update($pass) || return undef;
                    205:                        $self->_keyring_verify($pass) || return undef;
                    206:                }
                    207:        }
                    208:
1.7       andrew    209:        $self->{digest} ||= _calc_keys($self->{password});
                    210:
1.1       andrew    211:        foreach my $record (@{ $self->{records} }) {
                    212:                next unless defined $record->{plaintext};
                    213:
1.7       andrew    214:                my $name        = defined $record->{plaintext}->{name}        ?
                    215:                        $record->{plaintext}->{name}        : '';
                    216:                my $account     = defined $record->{plaintext}->{account}     ?
                    217:                        $record->{plaintext}->{account}     : '';
                    218:                my $password    = defined $record->{plaintext}->{password}    ?
                    219:                        $record->{plaintext}->{password}    : '';
                    220:                my $description = defined $record->{plaintext}->{description} ?
                    221:                        $record->{plaintext}->{description} : '';
1.1       andrew    222:                my $extra       = '';
                    223:
1.2       andrew    224:                my $plaintext = join("\000", $account, $password, $description, $extra);
1.1       andrew    225:
1.7       andrew    226:                my $encrypted = _crypt3des($plaintext, $self->{digest}, ENCRYPT);
1.1       andrew    227:
1.2       andrew    228:                $record->{data} = join("\000", $name, $encrypted);
1.1       andrew    229:        }
                    230:
1.11      andrew    231:        1;
1.1       andrew    232: }
                    233:
1.11      andrew    234: =head2 Decrypt
                    235:
                    236:        $pdb->Decrypt([$password]);
                    237:
                    238: Decrypts the PDB and fills out the rest of the fields available in
                    239: $record->{'plaintext'}.
                    240:
                    241: The plaintext should now be this, before encryption or after decryption:
                    242:
                    243:        $record->{'plaintext'} = {
                    244:                name        => $name,
                    245:                account     => $account,
                    246:                password    => $account_password,
                    247:                description => $description,
                    248:        };
                    249:
                    250: =cut
                    251:
1.1       andrew    252: sub Decrypt
                    253: {
                    254:        my $self = shift;
                    255:        my $pass = shift;
                    256:
                    257:        if ($pass) {
                    258:                $self->_keyring_verify($pass) || return undef;
                    259:        }
                    260:
1.7       andrew    261:        $self->{digest} ||= _calc_keys($self->{password});
                    262:
1.1       andrew    263:        foreach my $record (@{ $self->{records} }) {
                    264:                next unless defined $record->{data};
                    265:
1.2       andrew    266:                my ($name, $encrypted) = split /\000/, $record->{data}, 2;
1.7       andrew    267:                next unless $encrypted;
                    268:
1.1       andrew    269:                $record->{plaintext}->{name} = $name;
                    270:
1.7       andrew    271:                my $decrypted = _crypt3des($encrypted, $self->{digest}, DECRYPT);
1.1       andrew    272:                my ($account, $password, $description, $extra)
1.2       andrew    273:                      = split /\000/, $decrypted, 4;
1.1       andrew    274:
1.7       andrew    275:                $record->{plaintext}->{account}     = defined $account     ?
                    276:                        $account     : '';
                    277:                $record->{plaintext}->{password}    = defined $password    ?
                    278:                        $password    : '';
                    279:                $record->{plaintext}->{description} = defined $description ?
                    280:                        $description : '';
                    281:
                    282:                #print "Name:      '$name'\n";
                    283:                #print "Encrypted: '$encrypted' - Length: " . length($encrypted) . "\n";
                    284:                #print "    Hex:   '" . unpack("H*", $encrypted) . "'\n";
                    285:                #print "    Binary:'" . unpack("b*", $encrypted) . "'\n";
                    286:                #print "Decrypted: '$decrypted' - Length: " . length($decrypted) . "\n";
                    287:                #print "    Hex:   '" . unpack("H*", $decrypted) . "'\n";
                    288:                #print "    Binary:'" . unpack("b*", $decrypted) . "'\n";
                    289:                #print "\n";
1.1       andrew    290:                #print "Extra: $extra\n";
1.7       andrew    291:                #exit;
1.1       andrew    292:                #--------------------------------------------------
                    293:                # print "Account:     $account\n";
                    294:                # print "Password:    $password\n";
                    295:                # print "Description: $description\n";
                    296:                #--------------------------------------------------
                    297:
                    298:        }
                    299:
1.11      andrew    300:        1;
1.1       andrew    301: }
                    302:
                    303: sub _calc_keys
                    304: {
1.7       andrew    305:        my $pass = shift;
1.1       andrew    306:        die "No password defined!" unless defined $pass;
                    307:
                    308:        my $digest = md5($pass);
                    309:
                    310:        my ($key1, $key2) = unpack('a8a8', $digest);
                    311:        #--------------------------------------------------
                    312:        # print "key1: $key1: ", length $key1, "\n";
                    313:        # print "key2: $key2: ", length $key2, "\n";
                    314:        #--------------------------------------------------
                    315:
                    316:        $digest = unpack('H*', $key1 . $key2 . $key1);
                    317:        #--------------------------------------------------
                    318:        # print "Digest: ", $digest, "\n";
                    319:        # print length $digest, "\n";
                    320:        #--------------------------------------------------
                    321:
                    322:        return $digest;
                    323: }
                    324:
                    325: sub _keyring_verify
                    326: {
                    327:        my $self = shift;
                    328:        my $pass = shift;
                    329:
1.4       andrew    330:        die "No password specified!" unless $pass;
1.1       andrew    331:
                    332:        # AFAIK the thing we use to test the password is
                    333:        #     always in the first entry
1.10      andrew    334:        my $data = $self->{records}->[0]->{data};
1.1       andrew    335:        #die "No encrypted password in file!" unless defined $data;
                    336:        return undef unless defined $data;
                    337:
                    338:        $data =~ s/\0$//;
                    339:
                    340:        my $salt = substr($data, 0, $kSaltSize);
                    341:
                    342:        my $msg = $salt . $pass;
                    343:
                    344:        $msg .= "\0" x (MD5_CBLOCK - length($msg));
                    345:
                    346:        my $digest = md5($msg);
                    347:
                    348:        if ($data eq $salt . $digest) {
                    349:                # May as well generate the keys we need now, since we know the password is right
1.11      andrew    350:                $self->{digest} = _calc_keys($pass);
1.7       andrew    351:                if ($self->{digest}) {
1.11      andrew    352:                        $self->{password} = $pass;
1.1       andrew    353:                        return 1;
                    354:                } else {
                    355:                        return undef;
                    356:                }
                    357:        } else {
                    358:                return undef;
                    359:        }
                    360: }
                    361:
                    362: sub _keyring_update
                    363: {
                    364:        # It is very important to Encrypt after calling this
                    365:        #     (Although it is generally only called by Encrypt)
                    366:        # because otherwise the data will be out of sync with the
                    367:        # password, and that would suck!
                    368:        my $self = shift;
                    369:        my $pass = shift;
                    370:
1.4       andrew    371:        die "No password specified!" unless $pass;
1.1       andrew    372:
                    373:        # if the database already has a password in it
1.10      andrew    374:        if ($self->{records}->[0]->{data}) {
1.1       andrew    375:                # Make sure everything is decrypted before we update the keyring
                    376:                $self->Decrypt() || return undef;
                    377:        }
                    378:
                    379:        my $salt;
                    380:        for (1..$kSaltSize) {
                    381:                $salt .= chr(int(rand(255)));
                    382:        }
                    383:
                    384:        my $msg = $salt . $pass;
                    385:
                    386:        $msg .= "\0" x (MD5_CBLOCK - length($msg));
                    387:
                    388:        my $digest = md5($msg);
                    389:
                    390:        my $data = $salt . $digest;# . "\0";
                    391:
                    392:        # AFAIK the thing we use to test the password is
                    393:        #     always in the first entry
1.10      andrew    394:        $self->{records}->[0]->{data} = $data;
1.1       andrew    395:
                    396:        $self->{password} = $pass;
1.7       andrew    397:        $self->{digest}   = _calc_keys($self->{password});
1.1       andrew    398:
                    399:        return 1;
                    400: }
                    401:
1.2       andrew    402: sub _crypt3des {
1.7       andrew    403:        my ( $plaintext, $passphrase, $flag ) = @_;
1.10      andrew    404:        my $NULL = chr(0);
1.2       andrew    405:
1.4       andrew    406:        $passphrase .= ' ' x (16*3);
                    407:        my $cyphertext = "";
1.2       andrew    408:
1.4       andrew    409:        my $size = length ( $plaintext );
                    410:        #print "STRING: '$plaintext' - Length: " . length($plaintext) . "\n";
1.2       andrew    411:
1.5       andrew    412:        my @C;
1.4       andrew    413:        for ( 0..2 ) {
1.5       andrew    414:                $C[$_] = new Crypt::DES( pack( "H*", substr($passphrase, 16*$_, 16 )));
1.4       andrew    415:        }
1.9       andrew    416:
1.10      andrew    417:        for ( 0 .. (($size)/8)) {
1.4       andrew    418:                my $pt = substr( $plaintext, $_*8, 8 );
                    419:                #print "PT: '$pt' - Length: " . length($pt) . "\n";
1.10      andrew    420:                next unless length($pt);
1.4       andrew    421:                if (length($pt) < 8) {
1.8       andrew    422:                        die "record not 8 byte padded" if  $flag == DECRYPT;
1.4       andrew    423:                        my $len = 8 - length($pt);
1.8       andrew    424:                        #print "LENGTH: $len\n";
                    425:                        #print "Binary:    '" . unpack("b*", $pt) . "'\n";
1.10      andrew    426:                        $pt .= ($NULL x $len);
                    427:                        #print "PT: '$pt' - Length: " . length($pt) . "\n";
1.8       andrew    428:                        #print "Binary:    '" . unpack("b*", $pt) . "'\n";
1.4       andrew    429:                }
1.10      andrew    430:                if ($flag == ENCRYPT) {
                    431:                        $pt = $C[0]->encrypt( $pt );
                    432:                        $pt = $C[1]->decrypt( $pt );
                    433:                        $pt = $C[2]->encrypt( $pt );
                    434:                } else {
                    435:                        $pt = $C[0]->decrypt( $pt );
                    436:                        $pt = $C[1]->encrypt( $pt );
                    437:                        $pt = $C[2]->decrypt( $pt );
                    438:                }
1.4       andrew    439:                #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    440:                $cyphertext .= $pt;
                    441:        }
                    442:
1.10      andrew    443:        $cyphertext =~ s/$NULL+$//;
                    444:        #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
                    445:
                    446:        return $cyphertext;
1.2       andrew    447: }
1.1       andrew    448:
                    449: 1;
                    450: __END__
                    451:
                    452: =head1 AUTHOR
                    453:
1.12    ! andrew    454: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1       andrew    455:
                    456: =head1 SEE ALSO
                    457:
                    458: Palm::PDB(3)
                    459:
                    460: Palm::StdAppInfo(3)
1.11      andrew    461:
                    462: The Keyring for Palm OS website:
                    463: L<http://gnukeyring.sourceforge.net/>
1.1       andrew    464:
                    465: =cut

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