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

1.14      andrew      1: package Palm::Keyring;
                      2:
1.18    ! andrew      3: # $RedRiver: Keyring.pm,v 1.17 2007/01/30 05:16:16 andrew Exp $
1.1       andrew      4: #
1.14      andrew      5: # Perl class for dealing with Keyring for Palm OS databases.
1.1       andrew      6: #
                      7: #   This started as Memo.pm, I just made it work for Keyring.
                      8:
                      9: use strict;
1.14      andrew     10: use warnings;
                     11: use Carp;
                     12:
                     13: use base qw/ Palm::StdAppInfo /;
1.1       andrew     14:
                     15: use Digest::MD5 qw(md5);
1.2       andrew     16: use Crypt::DES;
1.14      andrew     17: use Readonly;
                     18:
                     19: Readonly my $ENCRYPT    => 1;
                     20: Readonly my $DECRYPT    => 0;
                     21: Readonly my $MD5_CBLOCK => 64;
                     22: Readonly my $kSalt_Size => 4;
                     23: Readonly my $EMPTY      => q{};
                     24: Readonly my $SPACE      => q{ };
                     25: Readonly my $NULL       => chr 0;
                     26:
                     27: # One liner, to allow MakeMaker to work.
1.16      andrew     28: our $VERSION = 0.91;
1.1       andrew     29:
1.14      andrew     30: sub new {
                     31:     my $classname = shift;
                     32:     my $pass      = shift;
1.1       andrew     33:
1.14      andrew     34:     # Create a generic PDB. No need to rebless it, though.
                     35:     my $self = $classname->SUPER::new(@_);
1.1       andrew     36:
1.14      andrew     37:     $self->{'name'}    = 'Keys-Gtkr';    # Default
                     38:     $self->{'creator'} = 'Gtkr';
                     39:     $self->{'type'}    = 'Gkyr';
                     40:
                     41:     # The PDB is not a resource database by
                     42:     # default, but it's worth emphasizing,
                     43:     # since MemoDB is explicitly not a PRC.
                     44:     $self->{'attributes'}{'resource'} = 0;
1.1       andrew     45:
1.14      andrew     46:     # Initialize the AppInfo block
                     47:     $self->{'appinfo'} = {};
1.1       andrew     48:
1.14      andrew     49:     # Add the standard AppInfo block stuff
                     50:     Palm::StdAppInfo::seed_StdAppInfo( $self->{'appinfo'} );
1.1       andrew     51:
1.14      andrew     52:     # Set the version
                     53:     $self->{'version'} = 4;
1.1       andrew     54:
1.14      andrew     55:     if ( defined $pass ) {
1.16      andrew     56:         $self->Password($pass);
1.14      andrew     57:     }
1.1       andrew     58:
1.14      andrew     59:     return $self;
                     60: }
1.1       andrew     61:
1.14      andrew     62: sub import {
                     63:     Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
                     64:     return 1;
                     65: }
1.1       andrew     66:
1.16      andrew     67: sub ParseRecord {
1.14      andrew     68:     my $self     = shift;
                     69:
1.16      andrew     70:     my $rec = $self->SUPER::ParseRecord(@_);
                     71:
                     72:     # skip the 0 record that holds the password
                     73:     return $rec if ! exists $self->{'records'};
                     74:
                     75:     # skip records with no data (There shouldn't be any)
                     76:     return $rec if ! exists $rec->{'data'};
1.14      andrew     77:
1.16      andrew     78:     my ( $name, $encrypted ) = split /$NULL/xm, $rec->{'data'}, 2;
1.1       andrew     79:
1.16      andrew     80:     return $rec if ! $encrypted;
                     81:     $rec->{'data'} = $name;
                     82:     $rec->{'encrypted'} = $encrypted;
1.12      andrew     83:
1.16      andrew     84:     return $rec;
1.14      andrew     85: }
1.11      andrew     86:
1.16      andrew     87: sub PackRecord {
                     88:     my $self = shift;
                     89:     my $rec  = shift;
                     90:
                     91:     my $rec0_id = $self->{'records'}->[0]->{'id'};
                     92:
                     93:     if ($rec->{'encrypted'} && ! $rec->{'id'} == $rec0_id) {
                     94:         $rec->{'data'} = join $NULL, $rec->{'data'}, $rec->{'encrypted'};
                     95:         delete $rec->{'encrypted'};
                     96:     }
1.1       andrew     97:
1.16      andrew     98:     return $self->SUPER::PackRecord($rec, @_);
1.14      andrew     99: }
1.1       andrew    100:
1.14      andrew    101: sub Encrypt {
                    102:     my $self = shift;
1.16      andrew    103:     my $rec  = shift;
                    104:     my $data = shift;
                    105:     my $pass = shift || $self->{'password'};
                    106:
                    107:     if ( ! $pass) {
                    108:         croak("'password' not set!\n");
                    109:     }
                    110:
                    111:     if ( ! $rec) {
                    112:         croak("Needed parameter 'record' not passed!\n");
                    113:     }
1.14      andrew    114:
1.16      andrew    115:     if ( ! $data) {
                    116:         croak("Needed parameter 'data' not passed!\n");
1.14      andrew    117:     }
                    118:
1.16      andrew    119:     if ( ! $self->Password($pass)) {
                    120:         croak("Incorrect Password!\n");
                    121:     }
1.14      andrew    122:
1.16      andrew    123:     $self->{'digest'} ||= _calc_keys( $pass );
1.14      andrew    124:
1.16      andrew    125:     $data->{'account'}  ||= $EMPTY;
                    126:     $data->{'password'} ||= $EMPTY;
                    127:     $data->{'notes'}    ||= $EMPTY;
1.1       andrew    128:
1.16      andrew    129:     my $plaintext = join $NULL,
                    130:         $data->{'account'}, $data->{'password'}, $data->{'notes'};
1.1       andrew    131:
1.16      andrew    132:     my $encrypted = _crypt3des( $plaintext, $self->{'digest'}, $ENCRYPT );
1.11      andrew    133:
1.16      andrew    134:     return if ! $encrypted;
1.1       andrew    135:
1.16      andrew    136:     $rec->{'data'} ||= $data->{'name'};
                    137:     $rec->{'encrypted'} = $encrypted;
1.14      andrew    138:     return 1;
                    139: }
1.1       andrew    140:
1.14      andrew    141: sub Decrypt {
                    142:     my $self = shift;
1.16      andrew    143:     my $rec  = shift;
                    144:     my $pass = shift || $self->{'password'};
                    145:
                    146:     if ( ! $pass) {
                    147:         croak("'password' not set!\n");
                    148:     }
                    149:
                    150:     if ( ! $rec) {
                    151:         carp("Needed parameter 'record' not passed!\n");
                    152:         return;
                    153:     }
1.14      andrew    154:
1.16      andrew    155:     if ( ! $self->Password($pass)) {
                    156:         croak("Invalid Password!\n");
1.14      andrew    157:     }
                    158:
1.16      andrew    159:     if ( ! $rec->{'encrypted'} ) {
                    160:         croak("No encrypted content!");
                    161:     }
1.14      andrew    162:
1.16      andrew    163:     $self->{'digest'} ||= _calc_keys( $pass );
1.14      andrew    164:
1.16      andrew    165:     my $decrypted =
                    166:         _crypt3des( $rec->{'encrypted'}, $self->{'digest'}, $DECRYPT );
                    167:     my ( $account, $password, $notes, $extra ) = split /$NULL/xm,
                    168:           $decrypted, 4;
1.14      andrew    169:
1.16      andrew    170:     return {
                    171:         account  => $account,
                    172:         password => $password,
                    173:         notes    => $notes,
                    174:     };
                    175: }
1.14      andrew    176:
1.16      andrew    177: sub Password {
                    178:     my $self = shift;
                    179:     my $pass = shift || $self->{'password'};
                    180:     my $new_pass = shift;
1.14      andrew    181:
1.16      andrew    182:     if (! exists $self->{'records'}) {
                    183:         # Give the PDB the first record that will hold the encrypted password
                    184:         $self->{'records'} = [ $self->new_Record ];
                    185:
                    186:         return $self->_password_update($pass);
                    187:     }
                    188:
                    189:     if ($new_pass) {
                    190:         my @accts = ();
                    191:         foreach my $i (0..$#{ $self->{'records'} }) {
                    192:             if ($i == 0) {
                    193:                 push @accts, undef;
                    194:                 next;
                    195:             }
                    196:             my $acct = $self->Decrypt($self->{'records'}->[$i], $pass);
                    197:             if ( ! $acct ) {
                    198:                 croak("Couldn't decrypt $self->{'records'}->[$i]->{'data'}");
                    199:             }
                    200:             push @accts, $acct;
                    201:         }
1.14      andrew    202:
1.16      andrew    203:         if ( ! $self->_password_update($new_pass)) {
                    204:             croak("Couldn't set new password!");
                    205:         }
                    206:         $pass = $new_pass;
1.1       andrew    207:
1.16      andrew    208:         foreach my $i (0..$#accts) {
                    209:             next if $i == 0;
                    210:             $self->Encrypt($self->{'records'}->[$i], $accts[$i], $pass);
                    211:         }
1.14      andrew    212:     }
1.1       andrew    213:
1.16      andrew    214:     return $self->_password_verify($pass);
1.1       andrew    215: }
                    216:
1.14      andrew    217: sub _calc_keys {
                    218:     my $pass = shift;
                    219:     if (! defined $pass) { croak('No password defined!'); };
                    220:
                    221:     my $digest = md5($pass);
                    222:
                    223:     my ( $key1, $key2 ) = unpack 'a8a8', $digest;
                    224:
                    225:     #--------------------------------------------------
                    226:     # print "key1: $key1: ", length $key1, "\n";
                    227:     # print "key2: $key2: ", length $key2, "\n";
                    228:     #--------------------------------------------------
                    229:
                    230:     $digest = unpack 'H*', $key1 . $key2 . $key1;
                    231:
                    232:     #--------------------------------------------------
                    233:     # print "Digest: ", $digest, "\n";
                    234:     # print length $digest, "\n";
                    235:     #--------------------------------------------------
                    236:
                    237:     return $digest;
1.3       andrew    238: }
                    239:
1.16      andrew    240: sub _password_verify {
1.14      andrew    241:     my $self = shift;
                    242:     my $pass = shift;
                    243:
                    244:     if (! $pass) { croak('No password specified!'); };
1.11      andrew    245:
1.16      andrew    246:     if (defined $self->{'password'} && $pass eq $self->{'password'}) {
                    247:         # already verified this password
                    248:         return 1;
                    249:     }
                    250:
1.14      andrew    251:     # AFAIK the thing we use to test the password is
                    252:     #     always in the first entry
                    253:     my $data = $self->{'records'}->[0]->{'data'};
1.11      andrew    254:
1.14      andrew    255:     #die "No encrypted password in file!" unless defined $data;
1.16      andrew    256:     if ( ! defined $data) { return; };
1.11      andrew    257:
1.14      andrew    258:     $data =~ s/$NULL$//xm;
1.11      andrew    259:
1.14      andrew    260:     my $salt = substr $data, 0, $kSalt_Size;
1.11      andrew    261:
1.14      andrew    262:     my $msg = $salt . $pass;
1.11      andrew    263:
1.14      andrew    264:     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11      andrew    265:
1.14      andrew    266:     my $digest = md5($msg);
1.11      andrew    267:
1.14      andrew    268:     if ( $data eq $salt . $digest ) {
1.11      andrew    269:
1.14      andrew    270: # May as well generate the keys we need now, since we know the password is right
                    271:         $self->{'digest'} = _calc_keys($pass);
                    272:         if ( $self->{'digest'} ) {
                    273:             $self->{'password'} = $pass;
                    274:             return 1;
                    275:         }
                    276:     }
                    277:     return;
1.6       andrew    278: }
                    279:
1.16      andrew    280: sub _password_update {
1.14      andrew    281:
                    282:     # It is very important to Encrypt after calling this
                    283:     #     (Although it is generally only called by Encrypt)
                    284:     # because otherwise the data will be out of sync with the
                    285:     # password, and that would suck!
                    286:     my $self = shift;
                    287:     my $pass = shift;
                    288:
1.16      andrew    289:     if (! defined $pass) { croak('No password specified!'); };
1.14      andrew    290:
                    291:     my $salt;
                    292:     for ( 1 .. $kSalt_Size ) {
                    293:         $salt .= chr int rand 255;
                    294:     }
                    295:
                    296:     my $msg = $salt . $pass;
1.11      andrew    297:
1.14      andrew    298:     $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11      andrew    299:
1.14      andrew    300:     my $digest = md5($msg);
1.11      andrew    301:
1.14      andrew    302:     my $data = $salt . $digest;    # . "\0";
1.11      andrew    303:
1.14      andrew    304:     # AFAIK the thing we use to test the password is
                    305:     #     always in the first entry
                    306:     $self->{'records'}->[0]->{'data'} = $data;
1.11      andrew    307:
1.14      andrew    308:     $self->{'password'} = $pass;
                    309:     $self->{'digest'}   = _calc_keys( $self->{'password'} );
1.11      andrew    310:
1.14      andrew    311:     return 1;
1.1       andrew    312: }
                    313:
1.14      andrew    314: sub _crypt3des {
                    315:     my ( $plaintext, $passphrase, $flag ) = @_;
                    316:
                    317:     $passphrase   .= $SPACE x ( 16 * 3 );
                    318:     my $cyphertext = $EMPTY;
                    319:
                    320:     my $size = length $plaintext;
1.11      andrew    321:
1.14      andrew    322:     #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
                    323:
                    324:     my @C;
                    325:     for ( 0 .. 2 ) {
                    326:         $C[$_] =
                    327:           new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
                    328:     }
                    329:
                    330:     for ( 0 .. ( ($size) / 8 ) ) {
                    331:         my $pt = substr $plaintext, $_ * 8, 8;
                    332:
                    333:         #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    334:         if (! length $pt) { next; };
                    335:         if ( (length $pt) < 8 ) {
1.16      andrew    336:             if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
1.14      andrew    337:             my $len = 8 - (length $pt);
                    338:
                    339:             #print "LENGTH: $len\n";
                    340:             #print "Binary:    '" . unpack("b*", $pt) . "'\n";
                    341:             $pt .= ($NULL x $len);
                    342:
                    343:             #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    344:             #print "Binary:    '" . unpack("b*", $pt) . "'\n";
                    345:         }
                    346:         if ( $flag == $ENCRYPT ) {
                    347:             $pt = $C[0]->encrypt($pt);
                    348:             $pt = $C[1]->decrypt($pt);
                    349:             $pt = $C[2]->encrypt($pt);
                    350:         }
                    351:         else {
                    352:             $pt = $C[0]->decrypt($pt);
                    353:             $pt = $C[1]->encrypt($pt);
                    354:             $pt = $C[2]->decrypt($pt);
                    355:         }
                    356:
                    357:         #print "PT: '$pt' - Length: " . length($pt) . "\n";
                    358:         $cyphertext .= $pt;
                    359:     }
                    360:
                    361:     $cyphertext =~ s/$NULL+$//xm;
1.11      andrew    362:
1.14      andrew    363:     #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11      andrew    364:
1.14      andrew    365:     return $cyphertext;
                    366: }
1.11      andrew    367:
1.14      andrew    368: 1;
                    369: __END__
1.11      andrew    370:
1.14      andrew    371: =head1 NAME
1.11      andrew    372:
1.14      andrew    373: Palm::Keyring - Handler for Palm Keyring databases.
1.1       andrew    374:
1.14      andrew    375: =head1 DESCRIPTION
1.7       andrew    376:
1.14      andrew    377: The Keyring PDB handler is a helper class for the Palm::PDB package. It
                    378: parses Keyring for Palm OS databases.  See
                    379: L<http://gnukeyring.sourceforge.net/>.
1.1       andrew    380:
1.14      andrew    381: It has the standard Palm::PDB methods with 2 additional public methods.
                    382: Decrypt and Encrypt.
1.1       andrew    383:
1.16      andrew    384: It currently supports the v4 Keyring databases.  The v5 databases from
                    385: the pre-release keyring-2.0 are not supported.
                    386:
                    387: This module doesn't store the decrypted content.  It only keeps it until it
                    388: returns it to you or encrypts it.
1.1       andrew    389:
1.14      andrew    390: =head1 SYNOPSIS
1.1       andrew    391:
1.16      andrew    392:     use Palm::PDB;
                    393:     use Palm::Keyring;
1.17      andrew    394:
                    395:     my $pass = 'password';
1.18    ! andrew    396:     my $file = 'Keys-Gtkr.pdb';
        !           397:     my $pdb  = new Palm::PDB;
1.16      andrew    398:     $pdb->Load($file);
1.17      andrew    399:
                    400:     foreach (0..$#{ $pdb->{'records'} }) {
                    401:         next if $_ = 0; # skip the password record
                    402:         my $rec  = $pdb->{'records'}->[$_];
                    403:         my $acct = $pdb->Decrypt($rec, $pass);
                    404:         print $rec->{'data'}, ' - ', $acct->{'account'}, "\n";
1.16      andrew    405:     }
1.1       andrew    406:
1.14      andrew    407: =head1 SUBROUTINES/METHODS
1.1       andrew    408:
1.14      andrew    409: =head2 new
1.11      andrew    410:
1.16      andrew    411:     $pdb = new Palm::Keyring([$password]);
1.11      andrew    412:
1.14      andrew    413: Create a new PDB, initialized with the various Palm::Keyring fields
                    414: and an empty record list.
1.11      andrew    415:
1.14      andrew    416: Use this method if you're creating a Keyring PDB from scratch otherwise you
1.16      andrew    417: can just use Palm::PDB::new() before calling Load().
1.11      andrew    418:
1.16      andrew    419: =head2 Encrypt
1.11      andrew    420:
1.16      andrew    421:     $pdb->Encrypt($rec, $acct, [$password]);
1.11      andrew    422:
1.16      andrew    423: Encrypts an account into a record, either with the password previously
                    424: used, or with a password that is passed.
1.1       andrew    425:
1.16      andrew    426: $rec is a record from $pdb->{'records'} or a newly generated record.
                    427: $acct is a hashref in the format below.
1.1       andrew    428:
1.16      andrew    429:     my $acct = {
                    430:         account  => $account,
                    431:         password => $password,
                    432:         notes    => $notes,
                    433:     };
1.7       andrew    434:
1.16      andrew    435: =head2 Decrypt
1.1       andrew    436:
1.16      andrew    437:     my $acct = $pdb->Decrypt($rec[, $password]);
1.1       andrew    438:
1.16      andrew    439: Decrypts the record and returns a hashref for the account as described
                    440: under Encrypt();
1.1       andrew    441:
1.16      andrew    442:     foreach (0..$#{ $pdb->{'records'}) {
                    443:         next if $_ == 0;
                    444:         my $rec = $pdb->{'records'}->[$_];
                    445:         my $acct = $pdb->Decrypt($rec[, $password]);
                    446:         # do something with $acct
                    447:     }
1.1       andrew    448:
1.16      andrew    449: =head2 Password
1.1       andrew    450:
1.16      andrew    451:     $pdb->Password([$password[, $new_password]]);
1.1       andrew    452:
1.16      andrew    453: Either sets the password to be used to crypt, or if you pass $new_password,
                    454: changes the password on the database.
1.1       andrew    455:
1.16      andrew    456: If you have created a new $pdb, and you didn't set a password when you
                    457: called new(), you only need to pass one password and it will set that as
                    458: the password.
1.1       andrew    459:
1.16      andrew    460: If nothing is passed, and there has been a password used before,
                    461: it just verifies that the password was correct.
1.1       andrew    462:
1.14      andrew    463: =head1 DEPENDENCIES
1.1       andrew    464:
1.14      andrew    465: Palm::StdAppInfo
1.1       andrew    466:
1.14      andrew    467: Digest::MD5
1.9       andrew    468:
1.14      andrew    469: Crypt::DES
1.4       andrew    470:
1.14      andrew    471: Readonly
1.10      andrew    472:
1.14      andrew    473: =head1 BUGS AND LIMITATIONS
1.1       andrew    474:
1.14      andrew    475: Once this module is uploaded, you can
                    476: Please report any bugs or feature requests to
                    477: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
                    478: L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
                    479: notified of progress on your bug as I make changes.
1.1       andrew    480:
                    481: =head1 AUTHOR
                    482:
1.12      andrew    483: Andrew Fresh E<lt>andrew@mad-techies.orgE<gt>
1.1       andrew    484:
1.14      andrew    485: =head1 LICENSE AND COPYRIGHT
                    486:
                    487: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
                    488:
1.15      andrew    489: This program is free software; you can redistribute it and/or
                    490: modify it under the same terms as Perl itself.
1.14      andrew    491:
1.1       andrew    492: =head1 SEE ALSO
                    493:
                    494: Palm::PDB(3)
                    495:
                    496: Palm::StdAppInfo(3)
1.11      andrew    497:
                    498: The Keyring for Palm OS website:
                    499: L<http://gnukeyring.sourceforge.net/>

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