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