Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.28
1.14 andrew 1: package Palm::Keyring;
1.28 ! andrew 2: # $RedRiver: Keyring.pm,v 1.27 2007/02/10 16:21:28 andrew Exp $
1.27 andrew 3: ########################################################################
4: # Keyring.pm *** Perl class for Keyring for Palm OS databases.
5: #
6: # This started as Memo.pm, I just made it work for Keyring.
1.1 andrew 7: #
1.27 andrew 8: # 2006.01.26 #*#*# andrew fresh <andrew@cpan.org>
9: ########################################################################
10: # Copyright (C) 2006, 2007 by Andrew Fresh
1.1 andrew 11: #
1.27 andrew 12: # This program is free software; you can redistribute it and/or modify
13: # it under the same terms as Perl itself.
14: ########################################################################
1.1 andrew 15: use strict;
1.14 andrew 16: use warnings;
1.27 andrew 17:
1.14 andrew 18: use Carp;
19:
20: use base qw/ Palm::StdAppInfo /;
1.1 andrew 21:
1.28 ! andrew 22: use Digest::HMAC_SHA1 qw(hmac_sha1);
! 23: use Digest::SHA1 qw(sha1);
! 24: use Crypt::CBC;
! 25:
1.1 andrew 26: use Digest::MD5 qw(md5);
1.2 andrew 27: use Crypt::DES;
1.14 andrew 28:
1.24 andrew 29: my $ENCRYPT = 1;
30: my $DECRYPT = 0;
31: my $MD5_CBLOCK = 64;
32: my $kSalt_Size = 4;
33: my $EMPTY = q{};
34: my $SPACE = q{ };
35: my $NULL = chr 0;
1.14 andrew 36:
1.28 ! andrew 37: my @CRYPTS = (
! 38: { # None
! 39: name => 'None',
! 40: keylen => 8,
! 41: blocksize => 1,
! 42: },
! 43: { # DES-EDE3
! 44: name => 'DES_EDE3',
! 45: keylen => 24,
! 46: blocksize => 8,
! 47: DES_odd_parity => 1,
! 48: },
! 49: { # AES128
! 50: name => 'Rijndael',
! 51: keylen => 16,
! 52: blocksize => 16,
! 53: },
! 54: { # AES256
! 55: name => 'Rijndael',
! 56: keylen => 32,
! 57: blocksize => 16,
! 58: },
! 59: );
! 60:
1.1 andrew 61:
1.28 ! andrew 62: our $VERSION = 0.95;
! 63:
! 64: sub new
! 65: {
1.14 andrew 66: my $classname = shift;
1.28 ! andrew 67: my $options = {};
! 68:
! 69: # hashref arguments
! 70: if (ref $_[0] eq 'HASH') {
! 71: $options = shift;
! 72: }
! 73:
! 74: # CGI style arguments
! 75: elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {
! 76: my %tmp = @_;
! 77: while ( my($key,$value) = each %tmp) {
! 78: $key =~ s/^-//;
! 79: $options->{lc $key} = $value;
! 80: }
! 81: }
! 82:
! 83: else {
! 84: $options->{password} = shift;
! 85: $options->{version} = shift;
! 86: }
1.1 andrew 87:
1.14 andrew 88: # Create a generic PDB. No need to rebless it, though.
1.28 ! andrew 89: my $self = $classname->SUPER::new();
1.1 andrew 90:
1.28 ! andrew 91: $self->{name} = 'Keys-Gtkr'; # Default
! 92: $self->{creator} = 'Gtkr';
! 93: $self->{type} = 'Gkyr';
1.14 andrew 94:
95: # The PDB is not a resource database by
96: # default, but it's worth emphasizing,
97: # since MemoDB is explicitly not a PRC.
1.28 ! andrew 98: $self->{attributes}{resource} = 0;
1.1 andrew 99:
1.28 ! andrew 100: # Set the version
! 101: $self->{version} = $options->{version} || 4;
1.1 andrew 102:
1.28 ! andrew 103: # Set options
! 104: $self->{options} = $options;
1.1 andrew 105:
1.28 ! andrew 106: if ( defined $options->{password} ) {
! 107: $self->Password($options->{password});
1.14 andrew 108: }
1.1 andrew 109:
1.14 andrew 110: return $self;
111: }
1.1 andrew 112:
1.28 ! andrew 113: sub import
! 114: {
1.14 andrew 115: Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
116: return 1;
117: }
1.1 andrew 118:
1.28 ! andrew 119: # PackRecord
! 120:
! 121: sub ParseRecord
! 122: {
1.14 andrew 123: my $self = shift;
124:
1.16 andrew 125: my $rec = $self->SUPER::ParseRecord(@_);
1.28 ! andrew 126: return $rec if ! exists $rec->{data};
! 127:
! 128: if ($self->{version} == 4) {
! 129: # skip the first record because it contains the password.
! 130: return $rec if ! exists $self->{records};
! 131:
! 132: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2;
! 133:
! 134: return $rec if ! $encrypted;
! 135: $rec->{name} = $name;
! 136: $rec->{encrypted} = $encrypted;
! 137: delete $rec->{data};
! 138:
! 139: } elsif ($self->{version} == 5) {
! 140: my $blocksize = $self->{appinfo}->{blocksize};
! 141: my ($field, $extra) = _parse_field($rec->{data});
! 142: my ($ivec, $encrypted) = unpack "A$blocksize A*", $extra;
1.16 andrew 143:
1.28 ! andrew 144: if ($self->{options}->{v4compatible}) {
! 145: $rec->{name} = $field->{data};
! 146: } else {
! 147: $rec->{name} = $field;
! 148: }
! 149: $rec->{ivec} = $ivec;
! 150: $rec->{encrypted} = $encrypted;
! 151:
! 152: } else {
! 153: # XXX Unsupported version!
! 154: return;
! 155: }
1.12 andrew 156:
1.16 andrew 157: return $rec;
1.14 andrew 158: }
1.11 andrew 159:
1.28 ! andrew 160: sub _parse_keyring_date
! 161: {
! 162: my $data = shift;
! 163:
! 164: my $u = unpack 'n', $data;
! 165: my $year = (($u & 0xFE00) >> 9) + 4; # since 1900
! 166: my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
! 167: my $day = (($u & 0x001F) >> 0); # 1-31
! 168:
! 169: return {
! 170: year => $year,
! 171: month => $month || 0,
! 172: day => $day || 1,
! 173: };
! 174: }
! 175:
! 176: # PackRecord
! 177:
! 178: sub PackRecord
! 179: {
1.16 andrew 180: my $self = shift;
181: my $rec = shift;
182:
1.28 ! andrew 183: if ($self->{version} == 4) {
! 184: if ($rec->{encrypted}) {
! 185: if (! defined $rec->{name}) {
! 186: $rec->{name} = $EMPTY;
! 187: }
! 188: $rec->{data} = join $NULL, $rec->{name}, $rec->{encrypted};
! 189: delete $rec->{name};
! 190: delete $rec->{encrypted};
! 191: }
! 192: } elsif ($self->{version} == 5) {
! 193: # XXX do something
! 194: } else {
! 195: # XXX Unsupported version!
! 196: return;
1.16 andrew 197: }
1.1 andrew 198:
1.16 andrew 199: return $self->SUPER::PackRecord($rec, @_);
1.14 andrew 200: }
1.1 andrew 201:
1.28 ! andrew 202: sub _pack_keyring_date
! 203: {
! 204: my $d = shift;
! 205: my $year = $d->{year};
! 206: my $month = $d->{month};
! 207: my $day = $d->{day};
! 208:
! 209: $year -= 4;
! 210: $month++;
! 211:
! 212: return pack 'n', $day | ($month << 5) | ($year << 9);
! 213: }
! 214:
! 215: # ParseAppInfoBlock
! 216:
! 217: sub ParseAppInfoBlock
! 218: {
! 219: my $self = shift;
! 220: my $data = shift;
! 221: my $appinfo = {};
! 222:
! 223: &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);
! 224:
! 225: # int8/uint8
! 226: # - Signed or Unsigned Byte (8 bits). C types: char, unsigned char
! 227: # int16/uint16
! 228: # - Signed or Unsigned Word (16 bits). C types: short, unsigned short
! 229: # int32/uint32
! 230: # - Signed or Unsigned Doubleword (32 bits). C types: int, unsigned int
! 231: # sz
! 232: # - Zero-terminated C-style string
! 233:
! 234: if ($self->{version} == 4) {
! 235: # Nothing extra for version 4
! 236:
! 237: } elsif ($self->{version} == 5) {
! 238: _parse_appinfo_v5($appinfo) || return;
! 239:
! 240: } else {
! 241: # XXX Unknown version
! 242: return;
! 243: }
! 244:
! 245: return $appinfo;
! 246: }
! 247:
! 248: sub _parse_appinfo_v5
! 249: {
! 250: my $appinfo = shift;
! 251:
! 252: if (! exists $appinfo->{other}) {
! 253: # XXX Corrupt appinfo?
! 254: return;
! 255: }
! 256:
! 257: my $unpackstr
! 258: = ("C1" x 8) # 8 uint8s in an array for the salt
! 259: . ("S1" x 2) # the iter (uint16) and the cipher (uint16)
! 260: . ("C1" x 8); # and finally 8 more uint8s for the hash
! 261:
! 262: my (@salt, $iter, $cipher, @hash);
! 263: (@salt[0..7], $iter, $cipher, @hash[0..7])
! 264: = unpack $unpackstr, $appinfo->{other};
! 265:
! 266: $appinfo->{salt} = sprintf "%02x" x 8, @salt;
! 267: $appinfo->{iter} = $iter;
! 268: $appinfo->{cipher} = $cipher;
! 269: $appinfo->{keylen} = $CRYPTS[$appinfo->{cipher}]{keylen};
! 270: $appinfo->{blocksize} = $CRYPTS[$appinfo->{cipher}]{blocksize};
! 271: $appinfo->{DES_odd_parity} = $CRYPTS[$appinfo->{cipher}]{DES_odd_parity};
! 272: $appinfo->{cipher_name} = $CRYPTS[$appinfo->{cipher}]{name};
! 273: $appinfo->{masterhash} = sprintf "%02x" x 8, @hash;
! 274: delete $appinfo->{other};
! 275:
! 276: return $appinfo
! 277: }
! 278:
! 279: # PackAppInfoBlock
! 280:
! 281: sub PackAppInfoBlock
! 282: {
! 283: my $self = shift;
! 284: my $retval;
! 285:
! 286: if ($self->{version} == 4) {
! 287: # Nothing to do for v4
! 288:
! 289: } elsif ($self->{version} == 5) {
! 290: croak("Unsupported version!");
! 291: #$self->{appinfo}{other} = <pack application-specific data>;
! 292: } else {
! 293: # XXX Unknown version
! 294: return;
! 295: }
! 296: return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
! 297: }
! 298:
! 299: # Encrypt
! 300:
! 301: sub Encrypt
! 302: {
1.14 andrew 303: my $self = shift;
1.16 andrew 304: my $rec = shift;
305: my $data = shift;
1.28 ! andrew 306: my $pass = shift || $self->{password};
1.16 andrew 307:
1.28 ! andrew 308: if ( ! $pass && ! $self->{key}) {
! 309: croak("password not set!\n");
1.16 andrew 310: }
311:
312: if ( ! $rec) {
313: croak("Needed parameter 'record' not passed!\n");
314: }
1.14 andrew 315:
1.16 andrew 316: if ( ! $data) {
317: croak("Needed parameter 'data' not passed!\n");
1.14 andrew 318: }
319:
1.16 andrew 320: if ( ! $self->Password($pass)) {
321: croak("Incorrect Password!\n");
322: }
1.14 andrew 323:
1.28 ! andrew 324: if ($self->{version} == 4) {
! 325: $self->{digest} ||= _calc_keys( $pass );
! 326: my $acct = {};
! 327: if ($rec->{encrypted}) {
! 328: $acct = $self->Decrypt($rec, $pass);
! 329: }
! 330: my $encrypted = _encrypt_v4($data, $self->{digest}, $acct);
! 331: if ($encrypted) {
! 332: $rec->{attributes}{Dirty} = 1;
! 333: $rec->{attributes}{dirty} = 1;
! 334: $rec->{name} ||= $data->{name};
! 335: $rec->{encrypted} = $encrypted;
! 336: return 1;
! 337: }
! 338: } elsif ($self->{version} == 5) {
! 339: croak("Unsupported version!");
! 340: return _encrypt_v5(
! 341: $rec->{encrypted}, $rec->{ivec}, $self->{key},
! 342: $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},
! 343: );
! 344: } else {
! 345: # XXX Unsupported version!
! 346: }
! 347: return;
! 348: }
1.14 andrew 349:
1.28 ! andrew 350: sub _encrypt_v4
! 351: {
! 352: my $data = shift;
! 353: my $digest = shift;
! 354: my $acct = shift;
! 355:
! 356: $data->{account} ||= $EMPTY;
! 357: $data->{password} ||= $EMPTY;
! 358: $data->{notes} ||= $EMPTY;
1.1 andrew 359:
1.22 andrew 360: my $changed = 0;
361: my $need_newdate = 0;
1.28 ! andrew 362: if (%{ $acct }) {
1.22 andrew 363: foreach my $key (keys %{ $data }) {
364: next if $key eq 'lastchange';
365: if ($data->{$key} ne $acct->{$key}) {
366: $changed = 1;
367: last;
368: }
369: }
1.28 ! andrew 370: if ( exists $data->{lastchange} && exists $acct->{lastchange} && (
! 371: $data->{lastchange}->{day} != $acct->{lastchange}->{day} ||
! 372: $data->{lastchange}->{month} != $acct->{lastchange}->{month} ||
! 373: $data->{lastchange}->{year} != $acct->{lastchange}->{year}
1.22 andrew 374: )) {
375: $changed = 1;
376: $need_newdate = 0;
377: } else {
378: $need_newdate = 1;
379: }
380:
381: } else {
382: $changed = 1;
383: }
384:
385: # no need to re-encrypt if it has not changed.
386: return 1 if ! $changed;
387:
1.21 andrew 388: my ($day, $month, $year);
389:
1.28 ! andrew 390: if ($data->{lastchange} && ! $need_newdate ) {
! 391: $day = $data->{lastchange}->{day} || 1;
! 392: $month = $data->{lastchange}->{month} || 0;
! 393: $year = $data->{lastchange}->{year} || 0;
1.22 andrew 394:
395: # XXX Need to actually validate the above information somehow
396: if ($year >= 1900) {
397: $year -= 1900;
398: }
399: } else {
400: $need_newdate = 1;
401: }
402:
403: if ($need_newdate) {
1.21 andrew 404: ($day, $month, $year) = (localtime)[3,4,5];
405: }
1.22 andrew 406:
1.28 ! andrew 407: my $packeddate = _pack_keyring_date( {
! 408: year => $year,
! 409: month => $month,
! 410: day => $day,
! 411: });
1.19 andrew 412:
1.16 andrew 413: my $plaintext = join $NULL,
1.28 ! andrew 414: $data->{account}, $data->{password}, $data->{notes}, $packeddate;
1.1 andrew 415:
1.28 ! andrew 416: return _crypt3des( $plaintext, $digest, $ENCRYPT );
! 417: }
1.11 andrew 418:
1.28 ! andrew 419: # Decrypt
1.1 andrew 420:
1.28 ! andrew 421: sub Decrypt
! 422: {
1.14 andrew 423: my $self = shift;
1.16 andrew 424: my $rec = shift;
1.28 ! andrew 425: my $pass = shift || $self->{password};
1.16 andrew 426:
1.28 ! andrew 427: if ( ! $pass && ! $self->{key}) {
! 428: croak("password not set!\n");
1.16 andrew 429: }
430:
431: if ( ! $rec) {
1.19 andrew 432: croak("Needed parameter 'record' not passed!\n");
1.16 andrew 433: }
1.14 andrew 434:
1.16 andrew 435: if ( ! $self->Password($pass)) {
436: croak("Invalid Password!\n");
1.14 andrew 437: }
438:
1.28 ! andrew 439: if ( ! $rec->{encrypted} ) {
1.16 andrew 440: croak("No encrypted content!");
441: }
1.14 andrew 442:
1.28 ! andrew 443: if ($self->{version} == 4) {
! 444: $self->{digest} ||= _calc_keys( $pass );
! 445: my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
! 446: $acct->{name} ||= $rec->{name};
! 447: return $acct;
! 448: } elsif ($self->{version} == 5) {
! 449: my $fields = _decrypt_v5(
! 450: $rec->{encrypted}, $rec->{ivec}, $self->{key},
! 451: $self->{appinfo}->{keylen}, $self->{appinfo}->{cipher_name},
! 452: );
! 453: if ($self->{options}->{v4compatible}) {
! 454: my %acct;
! 455: foreach my $f (@{ $fields }) {
! 456: $acct{ $f->{label} } = $f->{data};
! 457: }
! 458: $acct{name} ||= $rec->{name};
! 459: return \%acct;
! 460: } else {
! 461: return $fields;
! 462: }
! 463: } else {
! 464: # XXX Unsupported version!
! 465: }
! 466: return;
! 467: }
1.14 andrew 468:
1.28 ! andrew 469: sub _decrypt_v4
! 470: {
! 471: my $encrypted = shift;
! 472: my $digest = shift;
! 473:
! 474: my $decrypted = _crypt3des( $encrypted, $digest, $DECRYPT );
! 475: my ( $account, $password, $notes, $packeddate )
! 476: = split /$NULL/xm, $decrypted, 4;
1.14 andrew 477:
1.28 ! andrew 478: my $modified;
1.19 andrew 479: if ($packeddate) {
1.28 ! andrew 480: $modified = _parse_keyring_date($packeddate);
1.19 andrew 481: }
482:
1.16 andrew 483: return {
1.20 andrew 484: account => $account,
485: password => $password,
486: notes => $notes,
1.28 ! andrew 487: lastchange => $modified,
1.16 andrew 488: };
489: }
1.14 andrew 490:
1.28 ! andrew 491: sub _decrypt_v5
! 492: {
! 493: my $encrypted = shift;
! 494: my $ivec = shift;
! 495: my $key = shift;
! 496: my $keylen = shift;
! 497: my $cipher = shift;
! 498:
! 499: my $decrypted;
! 500:
! 501: if ($cipher eq 'None') {
! 502: # do nothing
! 503: $decrypted = $encrypted;
! 504:
! 505: } elsif ($cipher eq 'DES_EDE3' or $cipher eq 'Rijndael') {
! 506: my $c = _setup_cipher_v5($ivec, $key, $keylen, $cipher);
! 507: if (! $c) {
! 508: croak("Unable to set up encryption!");
! 509: }
! 510: $encrypted .= $NULL x $keylen; # pad out a keylen
! 511: $decrypted = $c->decrypt($encrypted);
! 512:
! 513: } else {
! 514: # XXX Unknown encryption
! 515: return;
! 516: }
! 517:
! 518: my @fields;
! 519: while ($decrypted) {
! 520: my $field;
! 521: ($field, $decrypted) = _parse_field($decrypted);
! 522: if (! $field) {
! 523: last;
! 524: }
! 525: push @fields, $field;
! 526: }
! 527:
! 528: return \@fields;
! 529: }
! 530:
! 531: # Password
! 532:
! 533: sub Password
! 534: {
1.16 andrew 535: my $self = shift;
1.24 andrew 536: my $pass = shift;
1.16 andrew 537: my $new_pass = shift;
1.14 andrew 538:
1.24 andrew 539: if (! $pass) {
540: delete $self->{password};
1.28 ! andrew 541: return 1;
1.24 andrew 542: }
543:
1.28 ! andrew 544: if (! exists $self->{records}) {
1.16 andrew 545: # Give the PDB the first record that will hold the encrypted password
1.28 ! andrew 546: $self->{records} = [ $self->new_Record ];
1.16 andrew 547:
548: return $self->_password_update($pass);
549: }
550:
551: if ($new_pass) {
552: my @accts = ();
1.28 ! andrew 553: foreach my $i (0..$#{ $self->{records} }) {
1.16 andrew 554: if ($i == 0) {
555: push @accts, undef;
556: next;
557: }
1.28 ! andrew 558: my $acct = $self->Decrypt($self->{records}->[$i], $pass);
1.16 andrew 559: if ( ! $acct ) {
1.28 ! andrew 560: croak("Couldn't decrypt $self->{records}->[$i]->{name}");
1.16 andrew 561: }
562: push @accts, $acct;
563: }
1.14 andrew 564:
1.16 andrew 565: if ( ! $self->_password_update($new_pass)) {
566: croak("Couldn't set new password!");
567: }
568: $pass = $new_pass;
1.1 andrew 569:
1.16 andrew 570: foreach my $i (0..$#accts) {
571: next if $i == 0;
1.28 ! andrew 572: delete $self->{records}->[$i]->{encrypted};
! 573: $self->Encrypt($self->{records}->[$i], $accts[$i], $pass);
1.16 andrew 574: }
1.14 andrew 575: }
1.1 andrew 576:
1.28 ! andrew 577: if (defined $self->{password} && $pass eq $self->{password}) {
! 578: # already verified this password
! 579: return 1;
! 580: }
! 581:
! 582: if ($self->{version} == 4) {
! 583: # AFAIK the thing we use to test the password is
! 584: # always in the first entry
! 585: my $valid = _password_verify_v4($pass, $self->{records}->[0]->{data});
! 586:
! 587: # May as well generate the keys we need now, since we know the password is right
! 588: if ($valid) {
! 589: $self->{digest} = _calc_keys($pass);
! 590: if ($self->{digest} ) {
! 591: $self->{password} = $pass;
! 592: return 1;
! 593: }
! 594: }
! 595: } elsif ($self->{version} == 5) {
! 596: $self->{key} = _password_verify_v5($pass, $self->{appinfo});
! 597: return 1 if $self->{key};
! 598: } else {
! 599: # XXX unsupported version
! 600: }
! 601:
! 602: return;
! 603: }
! 604:
! 605: sub _password_verify_v4
! 606: {
! 607: my $pass = shift;
! 608: my $data = shift;
! 609:
! 610: if (! $pass) { croak('No password specified!'); };
! 611:
! 612: # XXX die "No encrypted password in file!" unless defined $data;
! 613: if ( ! defined $data) { return; };
! 614:
! 615: $data =~ s/$NULL$//xm;
! 616:
! 617: my $salt = substr $data, 0, $kSalt_Size;
! 618:
! 619: my $msg = $salt . $pass;
! 620: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
! 621:
! 622: my $digest = md5($msg);
! 623:
! 624: if (! $data eq $salt . $digest ) {
! 625: return;
! 626: }
! 627:
! 628: return 1;
! 629: }
! 630:
! 631: sub _password_verify_v5
! 632: {
! 633: my $pass = shift;
! 634: my $appinfo = shift;
! 635:
! 636: my $salt = pack("H*", $appinfo->{salt});
! 637:
! 638: my $key = _pbkdf2(
! 639: $pass, $salt, $appinfo->{iter}, $appinfo->{keylen}, \&hmac_sha1
! 640: );
! 641: if ($appinfo->{DES_odd_parity}) {
! 642: $key = DES_odd_parity($key);
! 643: }
! 644:
! 645: my $newhash = unpack("H*", substr(sha1($key.$salt),0, 8));
! 646:
! 647: #print "Key: '". unpack("H*", $key) . "'\n";
! 648: #print "Hash: '". $newhash . "'\n";
! 649: #print "Hash: '". $appinfo->{masterhash} . "'\n";
! 650:
! 651: if ($appinfo->{masterhash} eq $newhash) {
! 652: $appinfo->{key} = $key;
! 653: } else {
! 654: return;
! 655: }
! 656: return $key;
1.1 andrew 657: }
658:
1.28 ! andrew 659: # V4 helpers
! 660:
! 661: sub _calc_keys
! 662: {
1.14 andrew 663: my $pass = shift;
664: if (! defined $pass) { croak('No password defined!'); };
665:
666: my $digest = md5($pass);
667:
668: my ( $key1, $key2 ) = unpack 'a8a8', $digest;
669:
670: #--------------------------------------------------
671: # print "key1: $key1: ", length $key1, "\n";
672: # print "key2: $key2: ", length $key2, "\n";
673: #--------------------------------------------------
674:
675: $digest = unpack 'H*', $key1 . $key2 . $key1;
676:
677: #--------------------------------------------------
678: # print "Digest: ", $digest, "\n";
679: # print length $digest, "\n";
680: #--------------------------------------------------
681:
682: return $digest;
1.3 andrew 683: }
684:
1.28 ! andrew 685: sub _crypt3des
! 686: {
! 687: my ( $plaintext, $passphrase, $flag ) = @_;
! 688:
! 689: $passphrase .= $SPACE x ( 16 * 3 );
! 690: my $cyphertext = $EMPTY;
! 691:
! 692: my $size = length $plaintext;
1.14 andrew 693:
1.28 ! andrew 694: #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
1.11 andrew 695:
1.28 ! andrew 696: my @C;
! 697: for ( 0 .. 2 ) {
! 698: $C[$_] =
! 699: new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
1.16 andrew 700: }
701:
1.28 ! andrew 702: for ( 0 .. ( ($size) / 8 ) ) {
! 703: my $pt = substr $plaintext, $_ * 8, 8;
! 704:
! 705: #print "PT: '$pt' - Length: " . length($pt) . "\n";
! 706: if (! length $pt) { next; };
! 707: if ( (length $pt) < 8 ) {
! 708: if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
! 709: my $len = 8 - (length $pt);
! 710: $pt .= ($NULL x $len);
! 711: }
! 712: if ( $flag == $ENCRYPT ) {
! 713: $pt = $C[0]->encrypt($pt);
! 714: $pt = $C[1]->decrypt($pt);
! 715: $pt = $C[2]->encrypt($pt);
! 716: }
! 717: else {
! 718: $pt = $C[0]->decrypt($pt);
! 719: $pt = $C[1]->encrypt($pt);
! 720: $pt = $C[2]->decrypt($pt);
! 721: }
! 722:
! 723: #print "PT: '$pt' - Length: " . length($pt) . "\n";
! 724: $cyphertext .= $pt;
! 725: }
1.11 andrew 726:
1.28 ! andrew 727: $cyphertext =~ s/$NULL+$//xm;
1.11 andrew 728:
1.28 ! andrew 729: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11 andrew 730:
1.28 ! andrew 731: return $cyphertext;
! 732: }
1.11 andrew 733:
1.28 ! andrew 734: # V5 helpers
1.11 andrew 735:
1.28 ! andrew 736: sub _setup_cipher_v5
! 737: {
! 738: my $ivec = shift;
! 739: my $key = shift;
! 740: my $keylen = shift;
! 741: my $cipher = shift;
! 742:
! 743: return Crypt::CBC->new(
! 744: -literal_key => 1,
! 745: -key => $key,
! 746: -iv => $ivec,
! 747: -cipher => $cipher,
! 748: -keysize => $keylen,
! 749: -header => 'none',
! 750: -padding => 'oneandzeroes',
! 751: );
! 752: }
1.11 andrew 753:
1.28 ! andrew 754: sub _parse_field
! 755: {
! 756: my $field = shift;
! 757:
! 758: my @labels;
! 759: $labels[0] = 'name';
! 760: $labels[1] = 'account';
! 761: $labels[2] = 'password';
! 762: $labels[3] = 'lastchange';
! 763: $labels[255] = 'notes';
! 764:
! 765: my ($len) = unpack "S1", $field;
! 766: if ($len + 4 > length $field) {
! 767: return undef, $field;
! 768: }
! 769: my $unpackstr = "S1 C1 C1 A$len";
! 770: if ($len % 2) {
! 771: # trim the 0/1 byte padding for next even address.
! 772: $unpackstr .= ' x'
! 773: }
! 774: $unpackstr .= ' A*';
1.11 andrew 775:
1.28 ! andrew 776: my (undef, $label, $font, $data, $leftover)
! 777: = unpack $unpackstr, $field;
1.11 andrew 778:
1.28 ! andrew 779: if ($label == 3) {
! 780: $data = _parse_keyring_date($data);
1.14 andrew 781: }
1.28 ! andrew 782: return {
! 783: #len => $len,
! 784: label => $labels[ $label ] || $label,
! 785: label_id => $label,
! 786: font => $font,
! 787: data => $data,
! 788: }, $leftover;
1.6 andrew 789: }
790:
1.28 ! andrew 791: # All version helpers
! 792:
! 793: sub _password_update
! 794: {
1.14 andrew 795:
796: # It is very important to Encrypt after calling this
797: # (Although it is generally only called by Encrypt)
798: # because otherwise the data will be out of sync with the
799: # password, and that would suck!
800: my $self = shift;
801: my $pass = shift;
802:
1.28 ! andrew 803: # XXX have to separate this out to v4 and v5 sections.
! 804: die "Unsupported version" unless $self->{version} == 4;
! 805:
1.16 andrew 806: if (! defined $pass) { croak('No password specified!'); };
1.14 andrew 807:
808: my $salt;
809: for ( 1 .. $kSalt_Size ) {
810: $salt .= chr int rand 255;
811: }
812:
813: my $msg = $salt . $pass;
1.11 andrew 814:
1.14 andrew 815: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1.11 andrew 816:
1.14 andrew 817: my $digest = md5($msg);
1.11 andrew 818:
1.14 andrew 819: my $data = $salt . $digest; # . "\0";
1.11 andrew 820:
1.14 andrew 821: # AFAIK the thing we use to test the password is
822: # always in the first entry
1.28 ! andrew 823: $self->{records}->[0]->{data} = $data;
1.11 andrew 824:
1.28 ! andrew 825: $self->{password} = $pass;
! 826: $self->{digest} = _calc_keys( $self->{password} );
1.11 andrew 827:
1.14 andrew 828: return 1;
1.1 andrew 829: }
830:
1.28 ! andrew 831: sub _hexdump
! 832: {
! 833: my $prefix = shift; # What to print in front of each line
! 834: my $data = shift; # The data to dump
! 835: my $maxlines = shift; # Max # of lines to dump
! 836: my $offset; # Offset of current chunk
! 837:
! 838: for ($offset = 0; $offset < length($data); $offset += 16)
! 839: {
! 840: my $hex; # Hex values of the data
! 841: my $ascii; # ASCII values of the data
! 842: my $chunk; # Current chunk of data
! 843:
! 844: last if defined($maxlines) && ($offset >= ($maxlines * 16));
1.14 andrew 845:
1.28 ! andrew 846: $chunk = substr($data, $offset, 16);
1.14 andrew 847:
1.28 ! andrew 848: ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;
1.11 andrew 849:
1.28 ! andrew 850: ($ascii = $chunk) =~ y/\040-\176/./c;
1.14 andrew 851:
1.28 ! andrew 852: printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
1.14 andrew 853: }
1.28 ! andrew 854: }
! 855:
! 856: sub _bindump
! 857: {
! 858: my $prefix = shift; # What to print in front of each line
! 859: my $data = shift; # The data to dump
! 860: my $maxlines = shift; # Max # of lines to dump
! 861: my $offset; # Offset of current chunk
! 862:
! 863: for ($offset = 0; $offset < length($data); $offset += 8)
! 864: {
! 865: my $bin; # binary values of the data
! 866: my $ascii; # ASCII values of the data
! 867: my $chunk; # Current chunk of data
1.14 andrew 868:
1.28 ! andrew 869: last if defined($maxlines) && ($offset >= ($maxlines * 8));
1.14 andrew 870:
1.28 ! andrew 871: $chunk = substr($data, $offset, 8);
1.14 andrew 872:
1.28 ! andrew 873: ($bin = $chunk) =~ s/./sprintf "%08b ", ord($&)/ges;
1.14 andrew 874:
1.28 ! andrew 875: ($ascii = $chunk) =~ y/\040-\176/./c;
1.14 andrew 876:
1.28 ! andrew 877: printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
1.14 andrew 878: }
1.28 ! andrew 879: }
1.14 andrew 880:
1.28 ! andrew 881: # Thanks to Jochen Hoenicke <hoenicke@gmail.com>
! 882: # (one of the authors of Palm Keyring)
! 883: # for these next two subs.
! 884:
! 885: # Usage pbkdf2(password, salt, iter, keylen, prf)
! 886: # iter is number of iterations
! 887: # keylen is length of generated key in bytes
! 888: # prf is the pseudo random function (e.g. hmac_sha1)
! 889: # returns the key.
! 890: sub _pbkdf2($$$$$)
! 891: {
! 892: my ($password, $salt, $iter, $keylen, $prf) = @_;
! 893: my ($k, $t, $u, $ui, $i);
! 894: $t = "";
! 895: for ($k = 1; length($t) < $keylen; $k++) {
! 896: $u = $ui = &$prf($salt.pack('N', $k), $password);
! 897: for ($i = 1; $i < $iter; $i++) {
! 898: $ui = &$prf($ui, $password);
! 899: $u ^= $ui;
! 900: }
! 901: $t .= $u;
! 902: }
! 903: return substr($t, 0, $keylen);
! 904: }
1.11 andrew 905:
1.28 ! andrew 906: sub DES_odd_parity($) {
! 907: my $key = $_[0];
! 908: my ($r, $i);
! 909: my @odd_parity = (
! 910: 1, 1, 2, 2, 4, 4, 7, 7, 8, 8, 11, 11, 13, 13, 14, 14,
! 911: 16, 16, 19, 19, 21, 21, 22, 22, 25, 25, 26, 26, 28, 28, 31, 31,
! 912: 32, 32, 35, 35, 37, 37, 38, 38, 41, 41, 42, 42, 44, 44, 47, 47,
! 913: 49, 49, 50, 50, 52, 52, 55, 55, 56, 56, 59, 59, 61, 61, 62, 62,
! 914: 64, 64, 67, 67, 69, 69, 70, 70, 73, 73, 74, 74, 76, 76, 79, 79,
! 915: 81, 81, 82, 82, 84, 84, 87, 87, 88, 88, 91, 91, 93, 93, 94, 94,
! 916: 97, 97, 98, 98,100,100,103,103,104,104,107,107,109,109,110,110,
! 917: 112,112,115,115,117,117,118,118,121,121,122,122,124,124,127,127,
! 918: 128,128,131,131,133,133,134,134,137,137,138,138,140,140,143,143,
! 919: 145,145,146,146,148,148,151,151,152,152,155,155,157,157,158,158,
! 920: 161,161,162,162,164,164,167,167,168,168,171,171,173,173,174,174,
! 921: 176,176,179,179,181,181,182,182,185,185,186,186,188,188,191,191,
! 922: 193,193,194,194,196,196,199,199,200,200,203,203,205,205,206,206,
! 923: 208,208,211,211,213,213,214,214,217,217,218,218,220,220,223,223,
! 924: 224,224,227,227,229,229,230,230,233,233,234,234,236,236,239,239,
! 925: 241,241,242,242,244,244,247,247,248,248,251,251,253,253,254,254);
! 926: for ($i = 0; $i< length($key); $i++) {
! 927: $r .= chr($odd_parity[ord(substr($key, $i, 1))]);
! 928: }
! 929: return $r;
1.14 andrew 930: }
1.11 andrew 931:
1.14 andrew 932: 1;
933: __END__
1.11 andrew 934:
1.14 andrew 935: =head1 NAME
1.11 andrew 936:
1.14 andrew 937: Palm::Keyring - Handler for Palm Keyring databases.
1.1 andrew 938:
1.14 andrew 939: =head1 DESCRIPTION
1.7 andrew 940:
1.14 andrew 941: The Keyring PDB handler is a helper class for the Palm::PDB package. It
942: parses Keyring for Palm OS databases. See
943: L<http://gnukeyring.sourceforge.net/>.
1.1 andrew 944:
1.14 andrew 945: It has the standard Palm::PDB methods with 2 additional public methods.
946: Decrypt and Encrypt.
1.1 andrew 947:
1.16 andrew 948: It currently supports the v4 Keyring databases. The v5 databases from
949: the pre-release keyring-2.0 are not supported.
950:
951: This module doesn't store the decrypted content. It only keeps it until it
952: returns it to you or encrypts it.
1.1 andrew 953:
1.14 andrew 954: =head1 SYNOPSIS
1.1 andrew 955:
1.16 andrew 956: use Palm::PDB;
957: use Palm::Keyring;
1.17 andrew 958:
959: my $pass = 'password';
1.18 andrew 960: my $file = 'Keys-Gtkr.pdb';
961: my $pdb = new Palm::PDB;
1.16 andrew 962: $pdb->Load($file);
1.17 andrew 963:
1.28 ! andrew 964: foreach (0..$#{ $pdb->{records} }) {
1.17 andrew 965: next if $_ = 0; # skip the password record
1.28 ! andrew 966: my $rec = $pdb->{records}->[$_];
1.17 andrew 967: my $acct = $pdb->Decrypt($rec, $pass);
1.28 ! andrew 968: print $rec->{name}, ' - ', $acct->{account}, "\n";
1.16 andrew 969: }
1.1 andrew 970:
1.14 andrew 971: =head1 SUBROUTINES/METHODS
1.1 andrew 972:
1.14 andrew 973: =head2 new
1.11 andrew 974:
1.16 andrew 975: $pdb = new Palm::Keyring([$password]);
1.11 andrew 976:
1.14 andrew 977: Create a new PDB, initialized with the various Palm::Keyring fields
978: and an empty record list.
1.11 andrew 979:
1.14 andrew 980: Use this method if you're creating a Keyring PDB from scratch otherwise you
1.16 andrew 981: can just use Palm::PDB::new() before calling Load().
1.11 andrew 982:
1.24 andrew 983: If you pass in a password, it will initalize the first record with the encrypted
984: password.
985:
1.16 andrew 986: =head2 Encrypt
1.11 andrew 987:
1.24 andrew 988: $pdb->Encrypt($rec, $acct[, $password]);
1.11 andrew 989:
1.16 andrew 990: Encrypts an account into a record, either with the password previously
991: used, or with a password that is passed.
1.1 andrew 992:
1.28 ! andrew 993: $rec is a record from $pdb->{records} or a new_Record().
1.16 andrew 994: $acct is a hashref in the format below.
1.1 andrew 995:
1.16 andrew 996: my $acct = {
1.28 ! andrew 997: name => $rec->{name},
1.20 andrew 998: account => $account,
999: password => $password,
1000: notes => $notes,
1001: lastchange => {
1002: year => 107, # years since 1900
1003: month => 0, # 0-11, 0 = January, 11 = December
1.21 andrew 1004: day => 30, # 1-31, same as localtime
1.20 andrew 1005: },
1.16 andrew 1006: };
1.7 andrew 1007:
1.22 andrew 1008: If you have changed anything other than the lastchange, or don't pass in a
1.24 andrew 1009: lastchange key, Encrypt() will generate a new lastchange date for you.
1.22 andrew 1010:
1011: If you pass in a lastchange field that is different than the one in the
1012: record, it will honor what you passed in.
1013:
1.28 ! andrew 1014: Encrypt() only uses the $acct->{name} if there is not already a $rec->{name}.
1.22 andrew 1015:
1.16 andrew 1016: =head2 Decrypt
1.1 andrew 1017:
1.16 andrew 1018: my $acct = $pdb->Decrypt($rec[, $password]);
1.1 andrew 1019:
1.16 andrew 1020: Decrypts the record and returns a hashref for the account as described
1.20 andrew 1021: under Encrypt().
1.1 andrew 1022:
1.28 ! andrew 1023: foreach (0..$#{ $pdb->{records}) {
1.16 andrew 1024: next if $_ == 0;
1.28 ! andrew 1025: my $rec = $pdb->{records}->[$_];
1.16 andrew 1026: my $acct = $pdb->Decrypt($rec[, $password]);
1027: # do something with $acct
1028: }
1.1 andrew 1029:
1.16 andrew 1030: =head2 Password
1.1 andrew 1031:
1.16 andrew 1032: $pdb->Password([$password[, $new_password]]);
1.1 andrew 1033:
1.16 andrew 1034: Either sets the password to be used to crypt, or if you pass $new_password,
1035: changes the password on the database.
1.1 andrew 1036:
1.16 andrew 1037: If you have created a new $pdb, and you didn't set a password when you
1038: called new(), you only need to pass one password and it will set that as
1039: the password.
1.1 andrew 1040:
1.24 andrew 1041: If nothing is passed, it forgets the password that it was remembering.
1.1 andrew 1042:
1.14 andrew 1043: =head1 DEPENDENCIES
1.1 andrew 1044:
1.14 andrew 1045: Palm::StdAppInfo
1.1 andrew 1046:
1.14 andrew 1047: Digest::MD5
1.9 andrew 1048:
1.14 andrew 1049: Crypt::DES
1.4 andrew 1050:
1.14 andrew 1051: Readonly
1.10 andrew 1052:
1.24 andrew 1053: =head1 THANKS
1054:
1055: I would like to thank the helpful Perlmonk shigetsu who gave me some great advice
1056: and helped me get my first module posted. L<http://perlmonks.org/?node_id=596998>
1057:
1058: I would also like to thank
1059: Johan Vromans
1060: E<lt>jvromans@squirrel.nlE<gt> --
1061: L<http://www.squirrel.nl/people/jvromans>.
1062: He had his own Palm::KeyRing module that he posted a couple of days before
1063: mine was ready and he was kind enough to let me have the namespace as well
1064: as giving me some very helpful hints about doing a few things that I was
1065: unsure of. He is really great.
1066:
1.14 andrew 1067: =head1 BUGS AND LIMITATIONS
1.1 andrew 1068:
1.14 andrew 1069: Please report any bugs or feature requests to
1070: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
1071: L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
1072: notified of progress on your bug as I make changes.
1.1 andrew 1073:
1074: =head1 AUTHOR
1075:
1.27 andrew 1076: Andrew Fresh E<lt>andrew@cpan.orgE<gt>
1.1 andrew 1077:
1.14 andrew 1078: =head1 LICENSE AND COPYRIGHT
1079:
1080: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
1081:
1.15 andrew 1082: This program is free software; you can redistribute it and/or
1083: modify it under the same terms as Perl itself.
1.14 andrew 1084:
1.1 andrew 1085: =head1 SEE ALSO
1086:
1087: Palm::PDB(3)
1088:
1089: Palm::StdAppInfo(3)
1.11 andrew 1090:
1091: The Keyring for Palm OS website:
1092: L<http://gnukeyring.sourceforge.net/>
1.24 andrew 1093:
1094: Johan Vromans also has a wxkeyring app that now uses this module, available
1.27 andrew 1095: from his website at L<http://www.vromans.org/johan/software/sw_palmkeyring.html>
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