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