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