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