Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.1
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: #
! 11: # $Id$
! 12: # $RedRiver$
! 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);
! 21: use Crypt::TripleDES;
! 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.
! 30: $VERSION = do { my @r = (q$Revision: 0.01 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
! 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: );
! 114: }
! 115:
! 116: sub Encrypt
! 117: {
! 118: my $self = shift;
! 119: my $pass = shift;
! 120:
! 121: if ($pass) {
! 122: unless ($self->_keyring_verify($pass) ) {
! 123: # This would encrypt with a new password.
! 124: # First decrypting everything with the old password of course.
! 125: $self->_keyring_update($pass) || return undef;
! 126: $self->_keyring_verify($pass) || return undef;
! 127: }
! 128: }
! 129:
! 130: my $seen_enc_pass = 0;
! 131: foreach my $record (@{ $self->{records} }) {
! 132: unless ($seen_enc_pass) {
! 133: $seen_enc_pass = 1;
! 134: next;
! 135: }
! 136:
! 137: next unless defined $record->{plaintext};
! 138:
! 139: my $name = defined $record->{plaintext}->{name} ? $record->{plaintext}->{name} : '';
! 140: my $account = defined $record->{plaintext}->{account} ? $record->{plaintext}->{account} : '';
! 141: my $password = defined $record->{plaintext}->{password} ? $record->{plaintext}->{password} : '';
! 142: my $description = defined $record->{plaintext}->{description} ? $record->{plaintext}->{description} : '';
! 143: my $extra = '';
! 144:
! 145: my $plaintext = join("\0", $account, $password, $description, $extra);
! 146:
! 147: my $encrypted = $self->_crypt($plaintext, ENCRYPT);
! 148:
! 149: $record->{data} = join("\0", $name, $encrypted);
! 150: }
! 151:
! 152: return 1;
! 153: }
! 154:
! 155: sub Decrypt
! 156: {
! 157: my $self = shift;
! 158: my $pass = shift;
! 159:
! 160: if ($pass) {
! 161: $self->_keyring_verify($pass) || return undef;
! 162: }
! 163:
! 164: my $seen_enc_pass = 0;
! 165: foreach my $record (@{ $self->{records} }) {
! 166: unless ($seen_enc_pass) {
! 167: # need to skip the first record because it is the encrypted password
! 168: $seen_enc_pass = 1;
! 169: next;
! 170: }
! 171:
! 172: next unless defined $record->{data};
! 173:
! 174: my ($name, $encrypted) = split /\0/, $record->{data};
! 175: $record->{plaintext}->{name} = $name;
! 176:
! 177: my $decrypted = $self->_crypt($encrypted, DECRYPT);
! 178: my ($account, $password, $description, $extra)
! 179: = split /\0/, $decrypted, 4;
! 180:
! 181: $record->{plaintext}->{account} = defined $account ? $account : '';
! 182: $record->{plaintext}->{password} = defined $password ? $password : '';
! 183: $record->{plaintext}->{description} = defined $description ? $description : '';
! 184:
! 185: #print "Extra: $extra\n";
! 186: #--------------------------------------------------
! 187: # print "Account: $account\n";
! 188: # print "Password: $password\n";
! 189: # print "Description: $description\n";
! 190: #--------------------------------------------------
! 191:
! 192: }
! 193:
! 194: return 1;
! 195: }
! 196:
! 197: sub _crypt
! 198: {
! 199: my $self = shift;
! 200: my $original = shift;
! 201: my $flag = shift;
! 202:
! 203: my $digest = $self->{digest} || $self->_calc_keys();
! 204: #print "DIGEST: $digest\n";
! 205:
! 206: my $des = new Crypt::TripleDES;
! 207:
! 208: if ($flag == ENCRYPT) {
! 209: return $des->encrypt3($original, $digest);
! 210: } else {
! 211: return $des->decrypt3($original, $digest);
! 212: }
! 213: }
! 214:
! 215: sub _calc_keys
! 216: {
! 217: my $self = shift;
! 218:
! 219: my $pass = $self->{'password'};
! 220: die "No password defined!" unless defined $pass;
! 221:
! 222: my $digest = md5($pass);
! 223:
! 224: my ($key1, $key2) = unpack('a8a8', $digest);
! 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: # print "Digest: ", $digest, "\n";
! 233: # print length $digest, "\n";
! 234: #--------------------------------------------------
! 235:
! 236: $self->{digest} = $digest;
! 237: return $digest;
! 238: }
! 239:
! 240: sub _keyring_verify
! 241: {
! 242: my $self = shift;
! 243: my $pass = shift;
! 244:
! 245: die "No password specified!" unless defined $pass;
! 246: $self->{password} = $pass;
! 247:
! 248: # AFAIK the thing we use to test the password is
! 249: # always in the first entry
! 250: my $data = $self->{records}->[0]->{data};
! 251: #die "No encrypted password in file!" unless defined $data;
! 252: return undef unless defined $data;
! 253:
! 254: $data =~ s/\0$//;
! 255:
! 256: my $salt = substr($data, 0, $kSaltSize);
! 257:
! 258: my $msg = $salt . $pass;
! 259:
! 260: $msg .= "\0" x (MD5_CBLOCK - length($msg));
! 261:
! 262: my $digest = md5($msg);
! 263:
! 264: if ($data eq $salt . $digest) {
! 265: # May as well generate the keys we need now, since we know the password is right
! 266: if ($self->_calc_keys()) {
! 267: return 1;
! 268: } else {
! 269: return undef;
! 270: }
! 271: } else {
! 272: return undef;
! 273: }
! 274: }
! 275:
! 276: sub _keyring_update
! 277: {
! 278: # It is very important to Encrypt after calling this
! 279: # (Although it is generally only called by Encrypt)
! 280: # because otherwise the data will be out of sync with the
! 281: # password, and that would suck!
! 282: my $self = shift;
! 283: my $pass = shift;
! 284:
! 285: die "No password specified!" unless defined $pass;
! 286:
! 287: # if the database already has a password in it
! 288: if ($self->{records}->[0]->{data}) {
! 289: # Make sure everything is decrypted before we update the keyring
! 290: $self->Decrypt() || return undef;
! 291: }
! 292:
! 293: my $salt;
! 294: for (1..$kSaltSize) {
! 295: $salt .= chr(int(rand(255)));
! 296: }
! 297:
! 298: my $msg = $salt . $pass;
! 299:
! 300: $msg .= "\0" x (MD5_CBLOCK - length($msg));
! 301:
! 302: my $digest = md5($msg);
! 303:
! 304: my $data = $salt . $digest;# . "\0";
! 305:
! 306: # AFAIK the thing we use to test the password is
! 307: # always in the first entry
! 308: $self->{records}->[0]->{data} = $data;
! 309:
! 310: $self->{password} = $pass;
! 311: $self->_calc_keys();
! 312:
! 313: return 1;
! 314: }
! 315:
! 316:
! 317: 1;
! 318: __END__
! 319:
! 320: =head1 AUTHOR
! 321:
! 322: Andrew Fresh E<lt>andrew@mad-techies.org<gt>
! 323:
! 324: =head1 SEE ALSO
! 325:
! 326: Palm::PDB(3)
! 327:
! 328: Palm::StdAppInfo(3)
! 329:
! 330: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to Keyring.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / palm / Palm-Keyring / lib / Palm