Annotation of palm/Palm-Keyring/lib/Palm/Keyring.pm, Revision 1.53
1.14 andrew 1: package Palm::Keyring;
1.53 ! andrew 2: # $RedRiver: Keyring.pm,v 1.52 2007/12/04 03:33:34 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 = (
1.34 andrew 31: {
32: alias => 'None',
1.28 andrew 33: name => 'None',
34: keylen => 8,
35: blocksize => 1,
1.29 andrew 36: default_iter => 500,
1.28 andrew 37: },
1.34 andrew 38: {
39: alias => 'DES-EDE3',
1.28 andrew 40: name => 'DES_EDE3',
41: keylen => 24,
42: blocksize => 8,
43: DES_odd_parity => 1,
1.29 andrew 44: default_iter => 1000,
1.28 andrew 45: },
1.34 andrew 46: {
47: alias => 'AES128',
1.28 andrew 48: name => 'Rijndael',
49: keylen => 16,
50: blocksize => 16,
1.29 andrew 51: default_iter => 100,
1.28 andrew 52: },
1.34 andrew 53: {
54: alias => 'AES256',
1.28 andrew 55: name => 'Rijndael',
56: keylen => 32,
57: blocksize => 16,
1.29 andrew 58: default_iter => 250,
1.28 andrew 59: },
60: );
61:
1.46 andrew 62: my %LABELS = (
63: 0 => {
64: id => 0,
65: name => 'name',
66: },
67: 1 => {
68: id => 1,
69: name => 'account',
70: },
71: 2 => {
72: id => 2,
73: name => 'password',
74: },
75: 3 => {
76: id => 3,
77: name => 'lastchange',
78: },
79: 255 => {
80: id => 255,
81: name => 'notes',
82: },
83: );
84:
1.1 andrew 85:
1.52 andrew 86: our $VERSION = '0.96_06';
1.28 andrew 87:
88: sub new
89: {
1.14 andrew 90: my $classname = shift;
1.28 andrew 91: my $options = {};
92:
1.46 andrew 93: if (@_) {
94: # hashref arguments
95: if (ref $_[0] eq 'HASH') {
96: $options = shift;
97: }
98:
99: # CGI style arguments
100: elsif ($_[0] =~ /^-[a-zA-Z0-9_]{1,20}$/) {
101: my %tmp = @_;
102: while ( my($key,$value) = each %tmp) {
103: $key =~ s/^-//;
104: $options->{lc $key} = $value;
105: }
106: }
107:
108: else {
109: $options->{password} = shift;
110: $options->{version} = shift;
111: }
1.28 andrew 112: }
1.1 andrew 113:
1.14 andrew 114: # Create a generic PDB. No need to rebless it, though.
1.28 andrew 115: my $self = $classname->SUPER::new();
1.1 andrew 116:
1.28 andrew 117: $self->{name} = 'Keys-Gtkr'; # Default
118: $self->{creator} = 'Gtkr';
119: $self->{type} = 'Gkyr';
1.14 andrew 120:
121: # The PDB is not a resource database by
122: # default, but it's worth emphasizing,
123: # since MemoDB is explicitly not a PRC.
1.28 andrew 124: $self->{attributes}{resource} = 0;
1.1 andrew 125:
1.28 andrew 126: # Set the version
127: $self->{version} = $options->{version} || 4;
1.1 andrew 128:
1.28 andrew 129: # Set options
130: $self->{options} = $options;
1.1 andrew 131:
1.29 andrew 132: # Set defaults
133: if ($self->{version} == 5) {
134: $self->{options}->{cipher} ||= 0; # 'None'
1.39 andrew 135: my $c = crypts($self->{options}->{cipher})
136: or croak('Unknown cipher ' . $self->{options}->{cipher});
137: $self->{options}->{iterations} ||= $c->{default_iter};
138: $self->{appinfo}->{cipher} ||= $self->{options}->{cipher};
139: $self->{appinfo}->{iter} ||= $self->{options}->{iterations};
1.29 andrew 140: };
141:
1.28 andrew 142: if ( defined $options->{password} ) {
143: $self->Password($options->{password});
1.14 andrew 144: }
1.1 andrew 145:
1.14 andrew 146: return $self;
147: }
1.1 andrew 148:
1.28 andrew 149: sub import
150: {
1.14 andrew 151: Palm::PDB::RegisterPDBHandlers( __PACKAGE__, [ 'Gtkr', 'Gkyr' ], );
152: return 1;
153: }
1.1 andrew 154:
1.34 andrew 155: # Accessors
156:
157: sub crypts
158: {
159: my $crypt = shift;
1.46 andrew 160: if ((! defined $crypt) || (! length $crypt)) {
1.39 andrew 161: return;
162: } elsif ($crypt =~ /\D/) {
1.34 andrew 163: foreach my $c (@CRYPTS) {
164: if ($c->{alias} eq $crypt) {
165: return $c;
166: }
167: }
168: # didn't find it.
169: return;
170: } else {
171: return $CRYPTS[$crypt];
172: }
173: }
174:
1.46 andrew 175: sub labels
176: {
177: my $label = shift;
178:
179: if ((! defined $label) || (! length $label)) {
180: return;
181: } elsif (exists $LABELS{$label}) {
182: return $LABELS{$label};
183: } else {
184: foreach my $l (keys %LABELS) {
185: if ($LABELS{$l}{name} eq $label) {
186: return $LABELS{$l};
187: }
188: }
189:
190: # didn't find it, make one.
191: if ($label =~ /^\d+$/) {
192: return {
193: id => $label,
194: name => undef,
195: };
196: } else {
197: return;
198: }
199: }
200: }
201:
202: # Write
203:
204: sub Write
205: {
206: my $self = shift;
207:
208: if ($self->{version} == 4) {
209: # Give the PDB the first record that will hold the encrypted password
210: my $rec = $self->new_Record;
211: $rec->{data} = $self->{encpassword};
212:
213: if (ref $self->{records} eq 'ARRAY') {
214: unshift @{ $self->{records} }, $rec;
215: } else {
216: $self->{records} = [ $rec ];
217: }
218: }
219:
220: my $rc = $self->SUPER::Write(@_);
221:
222: if ($self->{version} == 4) {
223: shift @{ $self->{records} };
224: }
225:
226: return $rc;
227: }
228:
1.29 andrew 229: # ParseRecord
1.28 andrew 230:
231: sub ParseRecord
232: {
1.14 andrew 233: my $self = shift;
234:
1.16 andrew 235: my $rec = $self->SUPER::ParseRecord(@_);
1.28 andrew 236: return $rec if ! exists $rec->{data};
237:
238: if ($self->{version} == 4) {
239: # skip the first record because it contains the password.
1.46 andrew 240: if (! exists $self->{records}) {
241: $self->{encpassword} = $rec->{data};
242: return '__DELETE_ME__';
243: }
244:
245: if ($self->{records}->[0] eq '__DELETE_ME__') {
246: shift @{ $self->{records} };
247: }
1.28 andrew 248:
249: my ( $name, $encrypted ) = split /$NULL/xm, $rec->{data}, 2;
250:
251: return $rec if ! $encrypted;
1.48 andrew 252: $rec->{plaintext}->{0} = {
1.46 andrew 253: label => 'name',
254: label_id => 0,
255: data => $name,
256: font => 0,
257: };
1.28 andrew 258: $rec->{encrypted} = $encrypted;
259: delete $rec->{data};
260:
261: } elsif ($self->{version} == 5) {
1.39 andrew 262: my $c = crypts( $self->{appinfo}->{cipher} )
263: or croak('Unknown cipher ' . $self->{appinfo}->{cipher});
264: my $blocksize = $c->{blocksize};
1.28 andrew 265: my ($field, $extra) = _parse_field($rec->{data});
1.37 andrew 266: delete $rec->{data};
1.16 andrew 267:
1.48 andrew 268: $rec->{plaintext}->{0} = $field;
1.37 andrew 269: $rec->{ivec} = substr $extra, 0, $blocksize;
270: $rec->{encrypted} = substr $extra, $blocksize;
1.28 andrew 271:
272: } else {
1.46 andrew 273: croak "Unsupported Version $self->{version}";
1.28 andrew 274: return;
275: }
1.12 andrew 276:
1.16 andrew 277: return $rec;
1.14 andrew 278: }
1.11 andrew 279:
1.28 andrew 280: # PackRecord
281:
282: sub PackRecord
283: {
1.16 andrew 284: my $self = shift;
285: my $rec = shift;
286:
1.28 andrew 287: if ($self->{version} == 4) {
288: if ($rec->{encrypted}) {
1.48 andrew 289: my $name = $rec->{plaintext}->{0}->{data} || $EMPTY;
1.46 andrew 290: $rec->{data} = join $NULL, $name, $rec->{encrypted};
1.48 andrew 291: delete $rec->{plaintext};
1.28 andrew 292: delete $rec->{encrypted};
293: }
1.29 andrew 294:
1.28 andrew 295: } elsif ($self->{version} == 5) {
1.37 andrew 296: my $field;
1.48 andrew 297: if ($rec->{plaintext}->{0}) {
298: $field = $rec->{plaintext}->{0};
1.37 andrew 299: } else {
300: $field = {
1.46 andrew 301: 'label' => 'name',
302: 'label_id' => 0,
1.37 andrew 303: 'data' => $EMPTY,
304: 'font' => 0,
305: };
306: }
307: my $packed = _pack_field($field);
1.29 andrew 308:
1.46 andrew 309: $rec->{data} = join $EMPTY, $packed, $rec->{ivec}, $rec->{encrypted};
1.29 andrew 310:
1.28 andrew 311: } else {
1.46 andrew 312: croak "Unsupported Version $self->{version}";
1.16 andrew 313: }
1.1 andrew 314:
1.16 andrew 315: return $self->SUPER::PackRecord($rec, @_);
1.14 andrew 316: }
1.1 andrew 317:
1.28 andrew 318: # ParseAppInfoBlock
319:
320: sub ParseAppInfoBlock
321: {
322: my $self = shift;
323: my $data = shift;
324: my $appinfo = {};
325:
326: &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);
327:
328: # int8/uint8
329: # - Signed or Unsigned Byte (8 bits). C types: char, unsigned char
330: # int16/uint16
331: # - Signed or Unsigned Word (16 bits). C types: short, unsigned short
332: # int32/uint32
333: # - Signed or Unsigned Doubleword (32 bits). C types: int, unsigned int
334: # sz
335: # - Zero-terminated C-style string
336:
337: if ($self->{version} == 4) {
338: # Nothing extra for version 4
339:
340: } elsif ($self->{version} == 5) {
341: _parse_appinfo_v5($appinfo) || return;
342:
343: } else {
1.46 andrew 344: croak "Unsupported Version $self->{version}";
1.28 andrew 345: }
346:
347: return $appinfo;
348: }
349:
350: sub _parse_appinfo_v5
351: {
352: my $appinfo = shift;
353:
354: if (! exists $appinfo->{other}) {
355: # XXX Corrupt appinfo?
356: return;
357: }
358:
359: my $unpackstr
360: = ("C1" x 8) # 8 uint8s in an array for the salt
1.35 andrew 361: . ("n1" x 2) # the iter (uint16) and the cipher (uint16)
1.28 andrew 362: . ("C1" x 8); # and finally 8 more uint8s for the hash
363:
364: my (@salt, $iter, $cipher, @hash);
365: (@salt[0..7], $iter, $cipher, @hash[0..7])
366: = unpack $unpackstr, $appinfo->{other};
367:
368: $appinfo->{salt} = sprintf "%02x" x 8, @salt;
369: $appinfo->{iter} = $iter;
370: $appinfo->{cipher} = $cipher;
371: $appinfo->{masterhash} = sprintf "%02x" x 8, @hash;
372: delete $appinfo->{other};
373:
374: return $appinfo
375: }
376:
377: # PackAppInfoBlock
378:
379: sub PackAppInfoBlock
380: {
381: my $self = shift;
382: my $retval;
383:
384: if ($self->{version} == 4) {
385: # Nothing to do for v4
386:
387: } elsif ($self->{version} == 5) {
1.29 andrew 388: _pack_appinfo_v5($self->{appinfo});
1.28 andrew 389: } else {
1.46 andrew 390: croak "Unsupported Version $self->{version}";
1.28 andrew 391: }
392: return &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});
393: }
394:
1.29 andrew 395: sub _pack_appinfo_v5
396: {
397: my $appinfo = shift;
398:
399: my $packstr
400: = ("C1" x 8) # 8 uint8s in an array for the salt
1.35 andrew 401: . ("n1" x 2) # the iter (uint16) and the cipher (uint16)
1.29 andrew 402: . ("C1" x 8); # and finally 8 more uint8s for the hash
403:
404: my @salt = map { hex $_ } $appinfo->{salt} =~ /../gxm;
405: my @hash = map { hex $_ } $appinfo->{masterhash} =~ /../gxm;
406:
407: my $packed = pack($packstr,
408: @salt,
409: $appinfo->{iter},
410: $appinfo->{cipher},
411: @hash
412: );
413:
414: $appinfo->{other} = $packed;
415:
416: return $appinfo
417: }
418:
1.28 andrew 419: # Encrypt
420:
421: sub Encrypt
422: {
1.14 andrew 423: my $self = shift;
1.16 andrew 424: my $rec = shift;
1.28 andrew 425: my $pass = shift || $self->{password};
1.48 andrew 426: my $data = shift || $rec->{plaintext};
1.34 andrew 427: my $ivec = shift;
1.16 andrew 428:
1.29 andrew 429: if ( ! $pass && ! $self->{appinfo}->{key}) {
1.28 andrew 430: croak("password not set!\n");
1.16 andrew 431: }
432:
433: if ( ! $rec) {
434: croak("Needed parameter 'record' not passed!\n");
435: }
1.14 andrew 436:
1.16 andrew 437: if ( ! $data) {
1.48 andrew 438: croak("Needed 'plaintext' not passed!\n");
1.14 andrew 439: }
440:
1.29 andrew 441: if ( $pass && ! $self->Password($pass)) {
1.16 andrew 442: croak("Incorrect Password!\n");
443: }
1.14 andrew 444:
1.29 andrew 445: my $acct;
446: if ($rec->{encrypted}) {
447: $acct = $self->Decrypt($rec, $pass);
448: }
449:
450: my $encrypted;
1.28 andrew 451: if ($self->{version} == 4) {
452: $self->{digest} ||= _calc_keys( $pass );
1.46 andrew 453: my $datav4 = {
454: name => $data->{0}->{data},
455: account => $data->{1}->{data},
456: password => $data->{2}->{data},
457: lastchange => $data->{3}->{data},
458: notes => $data->{255}->{data},
459: };
460: my $acctv4 = {
461: name => $acct->{0}->{data},
462: account => $acct->{1}->{data},
463: password => $acct->{2}->{data},
464: lastchange => $acct->{3}->{data},
465: notes => $acct->{255}->{data},
466: };
467: $encrypted = _encrypt_v4($datav4, $acctv4, $self->{digest});
1.29 andrew 468:
469: } elsif ($self->{version} == 5) {
470: ($encrypted, $ivec) = _encrypt_v5(
1.46 andrew 471: $data, $acct,
1.29 andrew 472: $self->{appinfo}->{key},
473: $self->{appinfo}->{cipher},
1.34 andrew 474: $ivec,
1.29 andrew 475: );
1.34 andrew 476: if (defined $ivec) {
1.29 andrew 477: $rec->{ivec} = $ivec;
1.28 andrew 478: }
1.29 andrew 479:
480: } else {
1.46 andrew 481: croak "Unsupported Version $self->{version}";
1.29 andrew 482: }
483:
1.48 andrew 484: $rec->{plaintext}->{0} = $data->{0};
1.46 andrew 485:
1.29 andrew 486: if ($encrypted) {
487: if ($encrypted eq '1') {
1.28 andrew 488: return 1;
489: }
1.29 andrew 490:
491: $rec->{attributes}{Dirty} = 1;
492: $rec->{attributes}{dirty} = 1;
493: $rec->{encrypted} = $encrypted;
494:
495: return 1;
1.28 andrew 496: } else {
1.29 andrew 497: return;
1.28 andrew 498: }
499: }
1.14 andrew 500:
1.28 andrew 501: sub _encrypt_v4
502: {
1.29 andrew 503: my $new = shift;
504: my $old = shift;
1.28 andrew 505: my $digest = shift;
506:
1.29 andrew 507: $new->{account} ||= $EMPTY;
508: $new->{password} ||= $EMPTY;
509: $new->{notes} ||= $EMPTY;
1.1 andrew 510:
1.22 andrew 511: my $changed = 0;
512: my $need_newdate = 0;
1.29 andrew 513: if ($old && %{ $old }) {
1.46 andrew 514: no warnings 'uninitialized';
1.29 andrew 515: foreach my $key (keys %{ $new }) {
1.22 andrew 516: next if $key eq 'lastchange';
1.29 andrew 517: if ($new->{$key} ne $old->{$key}) {
1.22 andrew 518: $changed = 1;
519: last;
520: }
521: }
1.29 andrew 522: if ( exists $new->{lastchange} && exists $old->{lastchange} && (
523: $new->{lastchange}->{day} != $old->{lastchange}->{day} ||
524: $new->{lastchange}->{month} != $old->{lastchange}->{month} ||
525: $new->{lastchange}->{year} != $old->{lastchange}->{year}
1.22 andrew 526: )) {
527: $changed = 1;
528: $need_newdate = 0;
529: } else {
530: $need_newdate = 1;
531: }
532:
533: } else {
534: $changed = 1;
535: }
536:
537: # no need to re-encrypt if it has not changed.
538: return 1 if ! $changed;
539:
1.21 andrew 540: my ($day, $month, $year);
541:
1.29 andrew 542: if ($new->{lastchange} && ! $need_newdate ) {
543: $day = $new->{lastchange}->{day} || 1;
544: $month = $new->{lastchange}->{month} || 0;
545: $year = $new->{lastchange}->{year} || 0;
1.22 andrew 546:
547: # XXX Need to actually validate the above information somehow
548: if ($year >= 1900) {
549: $year -= 1900;
550: }
551: } else {
552: $need_newdate = 1;
553: }
554:
555: if ($need_newdate) {
1.21 andrew 556: ($day, $month, $year) = (localtime)[3,4,5];
557: }
1.22 andrew 558:
1.29 andrew 559: my $packed_date = _pack_keyring_date( {
1.28 andrew 560: year => $year,
561: month => $month,
562: day => $day,
563: });
1.19 andrew 564:
1.16 andrew 565: my $plaintext = join $NULL,
1.29 andrew 566: $new->{account}, $new->{password}, $new->{notes}, $packed_date;
1.1 andrew 567:
1.28 andrew 568: return _crypt3des( $plaintext, $digest, $ENCRYPT );
569: }
1.11 andrew 570:
1.29 andrew 571: sub _encrypt_v5
572: {
573: my $new = shift;
574: my $old = shift;
575: my $key = shift;
576: my $cipher = shift;
1.34 andrew 577: my $ivec = shift;
1.39 andrew 578: my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
1.29 andrew 579:
1.34 andrew 580: if (! defined $ivec) {
1.39 andrew 581: $ivec = pack("C*",map {rand(256)} 1..$c->{blocksize});
1.34 andrew 582: }
583:
1.29 andrew 584: my $changed = 0;
585: my $need_newdate = 1;
1.46 andrew 586: if ($new->{3}->{data}) {
587: $need_newdate = 0;
588: }
589: foreach my $k (keys %{ $new }) {
590: if (! $old) {
591: $changed = 1;
592: } elsif ($k == 3) {
593: if ($old && (
594: $new->{$k}{data}{day} == $old->{$k}{data}{day} &&
595: $new->{$k}{data}{month} == $old->{$k}{data}{month} &&
596: $new->{$k}{data}{year} == $old->{$k}{data}{year}
1.29 andrew 597: )) {
598: $changed = 1;
1.46 andrew 599: $need_newdate = 1;
1.29 andrew 600: }
601:
1.46 andrew 602: } else {
603: my $n = join ':', sort %{ $new->{$k} };
604: my $o = join ':', sort %{ $old->{$k} };
1.29 andrew 605: if ($n ne $o) {
606: $changed = 1;
607: }
608: }
609: }
610:
611: return 1, 0 if $changed == 0;
612:
1.46 andrew 613: if ($need_newdate) {
1.29 andrew 614: my ($day, $month, $year) = (localtime)[3,4,5];
1.46 andrew 615: $new->{3} = {
616: label => 'lastchange',
617: label_id => 3,
618: font => 0,
619: data => {
620: year => $year,
621: month => $month,
622: day => $day,
1.47 andrew 623: },
1.29 andrew 624: };
625: } else {
626: # XXX Need to actually validate the above information somehow
1.46 andrew 627: if ($new->{3}->{data}->{year} >= 1900) {
628: $new->{3}->{data}->{year} -= 1900;
1.29 andrew 629: }
630: }
631:
1.48 andrew 632: my $plaintext;
1.46 andrew 633: foreach my $k (keys %{ $new }) {
1.52 andrew 634: next if $new->{$k}->{label_id} == 0;
1.48 andrew 635: $plaintext .= _pack_field($new->{$k});
1.29 andrew 636: }
1.53 ! andrew 637: $plaintext .= chr(0xff) x 2;
1.46 andrew 638:
1.29 andrew 639: my $encrypted;
1.39 andrew 640: if ($c->{name} eq 'None') {
1.29 andrew 641: # do nothing
1.48 andrew 642: $encrypted = $plaintext;
1.29 andrew 643:
1.39 andrew 644: } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
1.35 andrew 645: require Crypt::CBC;
1.39 andrew 646: my $cbc = Crypt::CBC->new(
1.35 andrew 647: -key => $key,
1.29 andrew 648: -literal_key => 1,
649: -iv => $ivec,
1.39 andrew 650: -cipher => $c->{name},
651: -keysize => $c->{keylen},
652: -blocksize => $c->{blocksize},
1.29 andrew 653: -header => 'none',
654: -padding => 'oneandzeroes',
655: );
656:
657: if (! $c) {
658: croak("Unable to set up encryption!");
659: }
660:
1.48 andrew 661: $encrypted = $cbc->encrypt($plaintext);
1.29 andrew 662:
663: } else {
1.46 andrew 664: croak "Unsupported Crypt $c->{name}";
1.29 andrew 665: }
666:
667: return $encrypted, $ivec;
668: }
669:
1.28 andrew 670: # Decrypt
1.1 andrew 671:
1.31 andrew 672: sub Decrypt
1.28 andrew 673: {
1.14 andrew 674: my $self = shift;
1.16 andrew 675: my $rec = shift;
1.28 andrew 676: my $pass = shift || $self->{password};
1.16 andrew 677:
1.29 andrew 678: if ( ! $pass && ! $self->{appinfo}->{key}) {
1.28 andrew 679: croak("password not set!\n");
1.16 andrew 680: }
681:
682: if ( ! $rec) {
1.19 andrew 683: croak("Needed parameter 'record' not passed!\n");
1.16 andrew 684: }
1.14 andrew 685:
1.30 andrew 686: if ( $pass && ! $self->Password($pass)) {
1.16 andrew 687: croak("Invalid Password!\n");
1.14 andrew 688: }
689:
1.28 andrew 690: if ( ! $rec->{encrypted} ) {
1.16 andrew 691: croak("No encrypted content!");
692: }
1.14 andrew 693:
1.48 andrew 694: my $plaintext;
1.28 andrew 695: if ($self->{version} == 4) {
696: $self->{digest} ||= _calc_keys( $pass );
697: my $acct = _decrypt_v4($rec->{encrypted}, $self->{digest});
1.48 andrew 698: $plaintext = {
699: 0 => $rec->{plaintext}->{0},
1.46 andrew 700: 1 => {
701: label => 'account',
702: label_id => 1,
703: font => 0,
704: data => $acct->{account},
705: },
706: 2 => {
707: label => 'password',
708: label_id => 2,
709: font => 0,
710: data => $acct->{password},
711: },
712: 3 => {
713: label => 'lastchange',
714: label_id => 3,
715: font => 0,
716: data => $acct->{lastchange},
717: },
718: 255 => {
719: label => 'notes',
720: label_id => 255,
721: font => 0,
722: data => $acct->{notes},
723: },
724: };
1.29 andrew 725:
1.28 andrew 726: } elsif ($self->{version} == 5) {
1.48 andrew 727: $plaintext = _decrypt_v5(
1.29 andrew 728: $rec->{encrypted}, $self->{appinfo}->{key},
729: $self->{appinfo}->{cipher}, $rec->{ivec},
1.28 andrew 730: );
1.48 andrew 731: $plaintext->{0} ||= $rec->{plaintext}->{0};
1.29 andrew 732:
1.28 andrew 733: } else {
1.46 andrew 734: croak "Unsupported Version $self->{version}";
1.28 andrew 735: }
1.48 andrew 736:
737: if ($plaintext) {
738: $rec->{plaintext} = $plaintext;
739: return $plaintext;
740: }
1.28 andrew 741: return;
742: }
1.14 andrew 743:
1.28 andrew 744: sub _decrypt_v4
745: {
746: my $encrypted = shift;
747: my $digest = shift;
748:
1.48 andrew 749: my $plaintext = _crypt3des( $encrypted, $digest, $DECRYPT );
1.29 andrew 750: my ( $account, $password, $notes, $packed_date )
1.48 andrew 751: = split /$NULL/xm, $plaintext, 4;
1.14 andrew 752:
1.28 andrew 753: my $modified;
1.29 andrew 754: if ($packed_date) {
755: $modified = _parse_keyring_date($packed_date);
1.19 andrew 756: }
757:
1.16 andrew 758: return {
1.20 andrew 759: account => $account,
760: password => $password,
761: notes => $notes,
1.28 andrew 762: lastchange => $modified,
1.16 andrew 763: };
764: }
1.14 andrew 765:
1.28 andrew 766: sub _decrypt_v5
767: {
1.34 andrew 768:
1.28 andrew 769: my $encrypted = shift;
770: my $key = shift;
771: my $cipher = shift;
1.29 andrew 772: my $ivec = shift;
773:
1.39 andrew 774: my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
1.28 andrew 775:
1.48 andrew 776: my $plaintext;
1.28 andrew 777:
1.39 andrew 778: if ($c->{name} eq 'None') {
1.28 andrew 779: # do nothing
1.48 andrew 780: $plaintext = $encrypted;
1.28 andrew 781:
1.39 andrew 782: } elsif ($c->{name} eq 'DES_EDE3' or $c->{name} eq 'Rijndael') {
1.35 andrew 783: require Crypt::CBC;
1.39 andrew 784: my $cbc = Crypt::CBC->new(
1.35 andrew 785: -key => $key,
1.29 andrew 786: -literal_key => 1,
787: -iv => $ivec,
1.39 andrew 788: -cipher => $c->{name},
789: -keysize => $c->{keylen},
790: -blocksize => $c->{blocksize},
1.29 andrew 791: -header => 'none',
792: -padding => 'oneandzeroes',
793: );
794:
1.28 andrew 795: if (! $c) {
796: croak("Unable to set up encryption!");
797: }
1.39 andrew 798: my $len = $c->{blocksize} - length($encrypted) % $c->{blocksize};
1.34 andrew 799: $encrypted .= $NULL x $len;
1.48 andrew 800: $plaintext = $cbc->decrypt($encrypted);
1.28 andrew 801:
802: } else {
1.46 andrew 803: croak "Unsupported Crypt $c->{name}";
1.28 andrew 804: }
805:
1.46 andrew 806: my %fields;
1.48 andrew 807: while ($plaintext) {
1.28 andrew 808: my $field;
1.48 andrew 809: ($field, $plaintext) = _parse_field($plaintext);
1.28 andrew 810: if (! $field) {
811: last;
812: }
1.46 andrew 813: $fields{ $field->{label_id} } = $field;
1.28 andrew 814: }
815:
1.46 andrew 816: return \%fields;
1.28 andrew 817: }
818:
819: # Password
820:
821: sub Password
822: {
1.16 andrew 823: my $self = shift;
1.24 andrew 824: my $pass = shift;
1.16 andrew 825: my $new_pass = shift;
1.14 andrew 826:
1.24 andrew 827: if (! $pass) {
828: delete $self->{password};
1.30 andrew 829: delete $self->{appinfo}->{key};
1.28 andrew 830: return 1;
1.24 andrew 831: }
832:
1.29 andrew 833: if (
1.46 andrew 834: ($self->{version} == 4 && ! exists $self->{encpassword}) ||
1.29 andrew 835: ($self->{version} == 5 && ! exists $self->{appinfo}->{masterhash})
836: ) {
1.16 andrew 837: return $self->_password_update($pass);
838: }
839:
840: if ($new_pass) {
841: my @accts = ();
1.46 andrew 842: foreach my $rec (@{ $self->{records} }) {
843: my $acct = $self->Decrypt($rec, $pass);
1.16 andrew 844: if ( ! $acct ) {
1.48 andrew 845: croak("Couldn't decrypt $rec->{plaintext}->{0}->{data}");
1.16 andrew 846: }
847: push @accts, $acct;
848: }
1.14 andrew 849:
1.16 andrew 850: if ( ! $self->_password_update($new_pass)) {
851: croak("Couldn't set new password!");
852: }
853: $pass = $new_pass;
1.1 andrew 854:
1.16 andrew 855: foreach my $i (0..$#accts) {
1.28 andrew 856: delete $self->{records}->[$i]->{encrypted};
1.48 andrew 857: $self->{records}->[$i]->{plaintext} = $accts[$i];
858: $self->Encrypt($self->{records}->[$i], $pass);
1.16 andrew 859: }
1.14 andrew 860: }
1.1 andrew 861:
1.28 andrew 862: if (defined $self->{password} && $pass eq $self->{password}) {
863: # already verified this password
864: return 1;
865: }
866:
867: if ($self->{version} == 4) {
1.46 andrew 868: my $valid = _password_verify_v4($pass, $self->{encpassword});
1.28 andrew 869:
1.46 andrew 870: # May as well generate the keys we need now,
871: # since we know the password is right
1.28 andrew 872: if ($valid) {
873: $self->{digest} = _calc_keys($pass);
874: if ($self->{digest} ) {
875: $self->{password} = $pass;
876: return 1;
877: }
878: }
879: } elsif ($self->{version} == 5) {
1.35 andrew 880: return _password_verify_v5($self->{appinfo}, $pass);
1.28 andrew 881: } else {
1.46 andrew 882: croak "Unsupported version $self->{version}";
1.28 andrew 883: }
884:
885: return;
886: }
887:
888: sub _password_verify_v4
889: {
1.32 andrew 890: require Digest::MD5;
891: import Digest::MD5 qw(md5);
892:
1.28 andrew 893: my $pass = shift;
894: my $data = shift;
895:
896: if (! $pass) { croak('No password specified!'); };
897:
898: # XXX die "No encrypted password in file!" unless defined $data;
899: if ( ! defined $data) { return; };
900:
901: $data =~ s/$NULL$//xm;
902:
903: my $salt = substr $data, 0, $kSalt_Size;
904:
905: my $msg = $salt . $pass;
906: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
907:
908: my $digest = md5($msg);
909:
1.33 andrew 910: if ($data ne $salt . $digest ) {
1.28 andrew 911: return;
912: }
913:
914: return 1;
915: }
916:
917: sub _password_verify_v5
918: {
1.35 andrew 919: my $appinfo = shift;
1.28 andrew 920: my $pass = shift;
921:
922: my $salt = pack("H*", $appinfo->{salt});
923:
1.39 andrew 924: my $c = crypts($appinfo->{cipher})
925: or croak('Unknown cipher ' . $appinfo->{cipher});
1.29 andrew 926: my ($key, $hash) = _calc_key_v5(
927: $pass, $salt, $appinfo->{iter},
1.39 andrew 928: $c->{keylen},
929: $c->{DES_odd_parity},
1.28 andrew 930: );
931:
1.35 andrew 932: #print "Iter: '" . $appinfo->{iter} . "'\n";
1.28 andrew 933: #print "Key: '". unpack("H*", $key) . "'\n";
1.35 andrew 934: #print "Salt: '". unpack("H*", $salt) . "'\n";
1.29 andrew 935: #print "Hash: '". $hash . "'\n";
1.28 andrew 936: #print "Hash: '". $appinfo->{masterhash} . "'\n";
937:
1.29 andrew 938: if ($appinfo->{masterhash} eq $hash) {
1.28 andrew 939: $appinfo->{key} = $key;
940: } else {
941: return;
942: }
1.29 andrew 943:
944: return $key;
945: }
946:
947:
948: sub _password_update
949: {
950: # It is very important to Encrypt after calling this
951: # (Although it is generally only called by Encrypt)
952: # because otherwise the data will be out of sync with the
953: # password, and that would suck!
954: my $self = shift;
955: my $pass = shift;
956:
957: if ($self->{version} == 4) {
958: my $data = _password_update_v4($pass, @_);
959:
960: if (! $data) {
961: carp("Failed to update password!");
962: return;
963: }
964:
965: # AFAIK the thing we use to test the password is
966: # always in the first entry
1.46 andrew 967: $self->{encpassword} = $data;
1.29 andrew 968: $self->{password} = $pass;
969: $self->{digest} = _calc_keys( $self->{password} );
970:
971: return 1;
972:
973: } elsif ($self->{version} == 5) {
974: my $cipher = shift || $self->{appinfo}->{cipher};
975: my $iter = shift || $self->{appinfo}->{iter};
976: my $salt = shift || 0;
977:
978: my $hash = _password_update_v5(
979: $self->{appinfo}, $pass, $cipher, $iter, $salt
980: );
981:
982: if (! $hash) {
983: carp("Failed to update password!");
984: return;
985: }
986:
987: return 1;
988: } else {
989: croak("Unsupported version ($self->{version})");
990: }
991:
992: return;
993: }
994:
995: sub _password_update_v4
996: {
1.32 andrew 997: require Digest::MD5;
998: import Digest::MD5 qw(md5);
999:
1.29 andrew 1000: my $pass = shift;
1001:
1002: if (! defined $pass) { croak('No password specified!'); };
1003:
1004: my $salt;
1005: for ( 1 .. $kSalt_Size ) {
1006: $salt .= chr int rand 255;
1007: }
1008:
1009: my $msg = $salt . $pass;
1010:
1011: $msg .= "\0" x ( $MD5_CBLOCK - length $msg );
1012:
1013: my $digest = md5($msg);
1014:
1015: my $data = $salt . $digest; # . "\0";
1016:
1017: return $data;
1018: }
1019:
1020: sub _password_update_v5
1021: {
1022: my $appinfo = shift;
1023: my $pass = shift;
1024: my $cipher = shift;
1025: my $iter = shift;
1026:
1027: # I thought this needed to be 'blocksize', but apparently not.
1028: #my $length = $CRYPTS[ $cipher ]{blocksize};
1029: my $length = 8;
1030: my $salt = shift || pack("C*",map {rand(256)} 1..$length);
1031:
1.39 andrew 1032: my $c = crypts($cipher) or croak('Unknown cipher ' . $cipher);
1.29 andrew 1033: my ($key, $hash) = _calc_key_v5(
1034: $pass, $salt, $iter,
1.39 andrew 1035: $c->{keylen},
1036: $c->{DES_odd_parity},
1.29 andrew 1037: );
1038:
1039: $appinfo->{salt} = unpack "H*", $salt;
1040: $appinfo->{iter} = $iter;
1041: $appinfo->{cipher} = $cipher;
1.39 andrew 1042: $appinfo->{masterhash} = $hash;
1.29 andrew 1043: $appinfo->{key} = $key;
1044:
1.28 andrew 1045: return $key;
1.1 andrew 1046: }
1047:
1.48 andrew 1048: sub Unlock
1049: {
1050: my $self = shift;
1051: my ($pass) = @_;
1052: $pass ||= $self->{password};
1053:
1054: if ( $pass && ! $self->Password($pass)) {
1055: croak("Invalid Password!\n");
1056: }
1057:
1058: foreach my $rec (@{ $self->{records} }) {
1059: $self->Decrypt($rec);
1060: }
1061:
1062: return 1;
1063:
1064: }
1065:
1066: sub Lock
1067: {
1068: my $self = shift;
1069:
1070: $self->Password();
1071:
1072: foreach my $rec (@{ $self->{records} }) {
1073: my $name = $rec->{plaintext}->{0};
1074: delete $rec->{plaintext};
1075: $rec->{plaintext}->{0} = $name;
1076: }
1077:
1078: return 1;
1079: }
1080:
1.34 andrew 1081: # Helpers
1.28 andrew 1082:
1083: sub _calc_keys
1084: {
1.14 andrew 1085: my $pass = shift;
1086: if (! defined $pass) { croak('No password defined!'); };
1087:
1088: my $digest = md5($pass);
1089:
1090: my ( $key1, $key2 ) = unpack 'a8a8', $digest;
1091:
1092: #--------------------------------------------------
1093: # print "key1: $key1: ", length $key1, "\n";
1094: # print "key2: $key2: ", length $key2, "\n";
1095: #--------------------------------------------------
1096:
1097: $digest = unpack 'H*', $key1 . $key2 . $key1;
1098:
1099: #--------------------------------------------------
1100: # print "Digest: ", $digest, "\n";
1101: # print length $digest, "\n";
1102: #--------------------------------------------------
1103:
1104: return $digest;
1.3 andrew 1105: }
1106:
1.29 andrew 1107: sub _calc_key_v5
1108: {
1109: my ($pass, $salt, $iter, $keylen, $dop) = @_;
1110:
1.32 andrew 1111: require Digest::HMAC_SHA1;
1112: import Digest::HMAC_SHA1 qw(hmac_sha1);
1113: require Digest::SHA1;
1114: import Digest::SHA1 qw(sha1);
1115:
1.29 andrew 1116: my $key = _pbkdf2( $pass, $salt, $iter, $keylen, \&hmac_sha1 );
1.43 andrew 1117: if ($dop) { $key = _DES_odd_parity($key); }
1.29 andrew 1118:
1119: my $hash = unpack("H*", substr(sha1($key.$salt),0, 8));
1120:
1121: return $key, $hash;
1122: }
1123:
1.28 andrew 1124: sub _crypt3des
1125: {
1.32 andrew 1126: require Crypt::DES;
1127:
1.28 andrew 1128: my ( $plaintext, $passphrase, $flag ) = @_;
1129:
1130: $passphrase .= $SPACE x ( 16 * 3 );
1131: my $cyphertext = $EMPTY;
1132:
1133: my $size = length $plaintext;
1.14 andrew 1134:
1.28 andrew 1135: #print "STRING: '$plaintext' - Length: " . (length $plaintext) . "\n";
1.11 andrew 1136:
1.28 andrew 1137: my @C;
1138: for ( 0 .. 2 ) {
1139: $C[$_] =
1140: new Crypt::DES( pack 'H*', ( substr $passphrase, 16 * $_, 16 ));
1.16 andrew 1141: }
1142:
1.28 andrew 1143: for ( 0 .. ( ($size) / 8 ) ) {
1144: my $pt = substr $plaintext, $_ * 8, 8;
1145:
1146: #print "PT: '$pt' - Length: " . length($pt) . "\n";
1147: if (! length $pt) { next; };
1148: if ( (length $pt) < 8 ) {
1149: if ($flag == $DECRYPT) { croak('record not 8 byte padded'); };
1150: my $len = 8 - (length $pt);
1151: $pt .= ($NULL x $len);
1152: }
1153: if ( $flag == $ENCRYPT ) {
1154: $pt = $C[0]->encrypt($pt);
1155: $pt = $C[1]->decrypt($pt);
1156: $pt = $C[2]->encrypt($pt);
1157: }
1158: else {
1159: $pt = $C[0]->decrypt($pt);
1160: $pt = $C[1]->encrypt($pt);
1161: $pt = $C[2]->decrypt($pt);
1162: }
1163:
1164: #print "PT: '$pt' - Length: " . length($pt) . "\n";
1165: $cyphertext .= $pt;
1166: }
1.11 andrew 1167:
1.28 andrew 1168: $cyphertext =~ s/$NULL+$//xm;
1.11 andrew 1169:
1.28 andrew 1170: #print "CT: '$cyphertext' - Length: " . length($cyphertext) . "\n";
1.11 andrew 1171:
1.28 andrew 1172: return $cyphertext;
1173: }
1.11 andrew 1174:
1.28 andrew 1175: sub _parse_field
1176: {
1177: my $field = shift;
1178:
1.46 andrew 1179: my ($len) = unpack "n", $field;
1.28 andrew 1180: if ($len + 4 > length $field) {
1181: return undef, $field;
1182: }
1.34 andrew 1183: my $unpackstr = "x2 C1 C1 A$len";
1184: my $offset = 2 +1 +1 +$len;
1.46 andrew 1185: if ($len % 2) {
1.28 andrew 1186: # trim the 0/1 byte padding for next even address.
1.34 andrew 1187: $offset++;
1.28 andrew 1188: $unpackstr .= ' x'
1189: }
1.11 andrew 1190:
1.34 andrew 1191: my ($label, $font, $data) = unpack $unpackstr, $field;
1192: my $leftover = substr $field, $offset;
1.11 andrew 1193:
1.46 andrew 1194: my $label_id = $label;
1195: my $l = labels($label);
1196: if ($l) {
1197: $label = $l->{name} || $l->{id};
1198: $label_id = $l->{id};
1199: }
1200:
1201: if ($label_id && $label_id == 3) {
1202: ($data) = substr $field, 4, $len;
1.28 andrew 1203: $data = _parse_keyring_date($data);
1.14 andrew 1204: }
1.28 andrew 1205: return {
1206: #len => $len,
1.46 andrew 1207: label => $label,
1208: label_id => $label_id,
1.28 andrew 1209: font => $font,
1210: data => $data,
1211: }, $leftover;
1.6 andrew 1212: }
1213:
1.29 andrew 1214: sub _pack_field
1215: {
1216: my $field = shift;
1.28 andrew 1217:
1.37 andrew 1218: my $packed;
1219: if (defined $field) {
1220: my $label = $field->{label_id} || 0;
1221: if (defined $field->{label} && ! $label) {
1.46 andrew 1222: $label = $field->{label};
1223: }
1224:
1225: my $l = labels($field->{label});
1226: if ($l) {
1227: $label = $l->{id};
1.37 andrew 1228: }
1.46 andrew 1229:
1.37 andrew 1230: my $font = $field->{font} || 0;
1231: my $data = defined $field->{data} ? $field->{data} : $EMPTY;
1232:
1233: if ($label && $label == 3) {
1234: $data = _pack_keyring_date($data);
1235: }
1236: my $len = length $data;
1237: my $packstr = "n1 C1 C1 A*";
1238:
1239: $packed = pack $packstr, ($len, $label, $font, $data);
1240:
1241: if ($len % 2) {
1242: # add byte padding for next even address.
1243: $packed .= $NULL;
1244: }
1245: } else {
1.38 andrew 1246: my $packstr = "n1 C1 C1 x1";
1.37 andrew 1247: $packed = pack $packstr, 0, 0, 0;
1.14 andrew 1248: }
1249:
1.29 andrew 1250: return $packed;
1251: }
1.11 andrew 1252:
1.29 andrew 1253: sub _parse_keyring_date
1254: {
1255: my $data = shift;
1.11 andrew 1256:
1.29 andrew 1257: my $u = unpack 'n', $data;
1258: my $year = (($u & 0xFE00) >> 9) + 4; # since 1900
1259: my $month = (($u & 0x01E0) >> 5) - 1; # 0-11
1260: my $day = (($u & 0x001F) >> 0); # 1-31
1.11 andrew 1261:
1.29 andrew 1262: return {
1263: year => $year,
1264: month => $month || 0,
1265: day => $day || 1,
1266: };
1267: }
1.11 andrew 1268:
1.29 andrew 1269: sub _pack_keyring_date
1270: {
1271: my $d = shift;
1272: my $year = $d->{year};
1273: my $month = $d->{month};
1274: my $day = $d->{day};
1.11 andrew 1275:
1.29 andrew 1276: $year -= 4;
1277: $month++;
1.11 andrew 1278:
1.46 andrew 1279: return pack 'n*', $day | ($month << 5) | ($year << 9);
1.1 andrew 1280: }
1.29 andrew 1281:
1.1 andrew 1282:
1.28 andrew 1283: sub _hexdump
1284: {
1285: my $prefix = shift; # What to print in front of each line
1286: my $data = shift; # The data to dump
1287: my $maxlines = shift; # Max # of lines to dump
1288: my $offset; # Offset of current chunk
1289:
1290: for ($offset = 0; $offset < length($data); $offset += 16)
1291: {
1292: my $hex; # Hex values of the data
1293: my $ascii; # ASCII values of the data
1294: my $chunk; # Current chunk of data
1295:
1296: last if defined($maxlines) && ($offset >= ($maxlines * 16));
1.14 andrew 1297:
1.28 andrew 1298: $chunk = substr($data, $offset, 16);
1.14 andrew 1299:
1.28 andrew 1300: ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;
1.11 andrew 1301:
1.28 andrew 1302: ($ascii = $chunk) =~ y/\040-\176/./c;
1.14 andrew 1303:
1.28 andrew 1304: printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
1.14 andrew 1305: }
1.28 andrew 1306: }
1307:
1308: sub _bindump
1309: {
1310: my $prefix = shift; # What to print in front of each line
1311: my $data = shift; # The data to dump
1312: my $maxlines = shift; # Max # of lines to dump
1313: my $offset; # Offset of current chunk
1314:
1315: for ($offset = 0; $offset < length($data); $offset += 8)
1316: {
1317: my $bin; # binary values of the data
1318: my $ascii; # ASCII values of the data
1319: my $chunk; # Current chunk of data
1.14 andrew 1320:
1.28 andrew 1321: last if defined($maxlines) && ($offset >= ($maxlines * 8));
1.14 andrew 1322:
1.28 andrew 1323: $chunk = substr($data, $offset, 8);
1.14 andrew 1324:
1.28 andrew 1325: ($bin = $chunk) =~ s/./sprintf "%08b ", ord($&)/ges;
1.14 andrew 1326:
1.28 andrew 1327: ($ascii = $chunk) =~ y/\040-\176/./c;
1.14 andrew 1328:
1.28 andrew 1329: printf "%s %-72s|%-8s|\n", $prefix, $bin, $ascii;
1.14 andrew 1330: }
1.28 andrew 1331: }
1.14 andrew 1332:
1.28 andrew 1333: # Thanks to Jochen Hoenicke <hoenicke@gmail.com>
1334: # (one of the authors of Palm Keyring)
1335: # for these next two subs.
1336:
1337: # Usage pbkdf2(password, salt, iter, keylen, prf)
1338: # iter is number of iterations
1339: # keylen is length of generated key in bytes
1340: # prf is the pseudo random function (e.g. hmac_sha1)
1341: # returns the key.
1342: sub _pbkdf2($$$$$)
1343: {
1344: my ($password, $salt, $iter, $keylen, $prf) = @_;
1345: my ($k, $t, $u, $ui, $i);
1346: $t = "";
1347: for ($k = 1; length($t) < $keylen; $k++) {
1348: $u = $ui = &$prf($salt.pack('N', $k), $password);
1349: for ($i = 1; $i < $iter; $i++) {
1350: $ui = &$prf($ui, $password);
1351: $u ^= $ui;
1352: }
1353: $t .= $u;
1354: }
1355: return substr($t, 0, $keylen);
1356: }
1.11 andrew 1357:
1.43 andrew 1358: sub _DES_odd_parity($) {
1.28 andrew 1359: my $key = $_[0];
1360: my ($r, $i);
1361: my @odd_parity = (
1362: 1, 1, 2, 2, 4, 4, 7, 7, 8, 8, 11, 11, 13, 13, 14, 14,
1363: 16, 16, 19, 19, 21, 21, 22, 22, 25, 25, 26, 26, 28, 28, 31, 31,
1364: 32, 32, 35, 35, 37, 37, 38, 38, 41, 41, 42, 42, 44, 44, 47, 47,
1365: 49, 49, 50, 50, 52, 52, 55, 55, 56, 56, 59, 59, 61, 61, 62, 62,
1366: 64, 64, 67, 67, 69, 69, 70, 70, 73, 73, 74, 74, 76, 76, 79, 79,
1367: 81, 81, 82, 82, 84, 84, 87, 87, 88, 88, 91, 91, 93, 93, 94, 94,
1368: 97, 97, 98, 98,100,100,103,103,104,104,107,107,109,109,110,110,
1369: 112,112,115,115,117,117,118,118,121,121,122,122,124,124,127,127,
1370: 128,128,131,131,133,133,134,134,137,137,138,138,140,140,143,143,
1371: 145,145,146,146,148,148,151,151,152,152,155,155,157,157,158,158,
1372: 161,161,162,162,164,164,167,167,168,168,171,171,173,173,174,174,
1373: 176,176,179,179,181,181,182,182,185,185,186,186,188,188,191,191,
1374: 193,193,194,194,196,196,199,199,200,200,203,203,205,205,206,206,
1375: 208,208,211,211,213,213,214,214,217,217,218,218,220,220,223,223,
1376: 224,224,227,227,229,229,230,230,233,233,234,234,236,236,239,239,
1377: 241,241,242,242,244,244,247,247,248,248,251,251,253,253,254,254);
1378: for ($i = 0; $i< length($key); $i++) {
1379: $r .= chr($odd_parity[ord(substr($key, $i, 1))]);
1380: }
1381: return $r;
1.14 andrew 1382: }
1.11 andrew 1383:
1.14 andrew 1384: 1;
1385: __END__
1386: =head1 NAME
1.11 andrew 1387:
1.14 andrew 1388: Palm::Keyring - Handler for Palm Keyring databases.
1.1 andrew 1389:
1.14 andrew 1390: =head1 DESCRIPTION
1.7 andrew 1391:
1.14 andrew 1392: The Keyring PDB handler is a helper class for the Palm::PDB package. It
1393: parses Keyring for Palm OS databases. See
1394: L<http://gnukeyring.sourceforge.net/>.
1.1 andrew 1395:
1.49 andrew 1396: It has the standard Palm::PDB methods with 4 additional public methods.
1397: Unlock, Lock, Decrypt and Encrypt.
1.1 andrew 1398:
1.37 andrew 1399: It currently supports the v4 Keyring databases as well as
1.49 andrew 1400: the pre-release v5 databases.
1.1 andrew 1401:
1.14 andrew 1402: =head1 SYNOPSIS
1.1 andrew 1403:
1.16 andrew 1404: use Palm::PDB;
1405: use Palm::Keyring;
1.17 andrew 1406:
1407: my $pass = 'password';
1.18 andrew 1408: my $file = 'Keys-Gtkr.pdb';
1409: my $pdb = new Palm::PDB;
1.16 andrew 1410: $pdb->Load($file);
1.17 andrew 1411:
1.49 andrew 1412: $pdb->Unlock($pass);
1.46 andrew 1413: foreach my $rec (@{ $pdb->{records} }) {
1.49 andrew 1414: print $rec->{plaintext}->{0}->{data}, ' - ',
1415: $rec->{plaintext}->{1}->{data}, "\n";
1.16 andrew 1416: }
1.49 andrew 1417: $pdb->Lock();
1.1 andrew 1418:
1.14 andrew 1419: =head1 SUBROUTINES/METHODS
1.1 andrew 1420:
1.14 andrew 1421: =head2 new
1.11 andrew 1422:
1.31 andrew 1423: $pdb = new Palm::Keyring([$password[, $version]]);
1.11 andrew 1424:
1.14 andrew 1425: Create a new PDB, initialized with the various Palm::Keyring fields
1426: and an empty record list.
1.11 andrew 1427:
1.14 andrew 1428: Use this method if you're creating a Keyring PDB from scratch otherwise you
1.16 andrew 1429: can just use Palm::PDB::new() before calling Load().
1.11 andrew 1430:
1.49 andrew 1431: If you pass in a password, it will initalize the database with the encrypted
1.24 andrew 1432: password.
1433:
1.31 andrew 1434: new() now also takes options in other formats
1435:
1436: $pdb = new Palm::Keyring({ key1 => value1, key2 => value2 });
1437: $pdb = new Palm::Keyring( -key1 => value1, -key2 => value2);
1438:
1.38 andrew 1439: =over
1440:
1441: =item Supported options
1.31 andrew 1442:
1443: =over
1444:
1445: =item password
1446:
1447: The password used to initialize the database
1448:
1449: =item version
1450:
1451: The version of database to create. Accepts either 4 or 5. Currently defaults to 4.
1452:
1453: =item cipher
1454:
1.49 andrew 1455: The cipher to use. Either the number or the name. Only used by v5 datbases.
1.31 andrew 1456:
1457: 0 => None
1458: 1 => DES_EDE3
1459: 2 => AES128
1460: 3 => AES256
1461:
1462: =item iterations
1463:
1.49 andrew 1464: The number of iterations to encrypt with. Only used by somy crypts in v5 databases.
1.37 andrew 1465:
1.31 andrew 1466: =back
1467:
1.38 andrew 1468: =back
1469:
1.36 andrew 1470: For v5 databases there are some additional appinfo fields set.
1.40 andrew 1471: These are set either on new() or Load().
1.36 andrew 1472:
1.37 andrew 1473: $pdb->{appinfo} = {
1474: # normal appinfo stuff described in L<Palm::StdAppInfo>
1475: cipher => The index number of the cipher being used
1476: iter => Number of iterations for the cipher
1477: };
1.36 andrew 1478:
1.43 andrew 1479: =head2 crypts
1.34 andrew 1480:
1481: Pass in the alias of the crypt to use, or the index.
1482:
1.38 andrew 1483: These only make sense for v5 databases.
1484:
1.34 andrew 1485: This is a function, not a method.
1.40 andrew 1486:
1.38 andrew 1487: $cipher can be 0, 1, 2, 3, None, DES_EDE3, AES128 or AES256.
1.34 andrew 1488:
1489: my $c = Palm::Keyring::crypt($cipher);
1490:
1491: $c is now:
1492:
1493: $c = {
1494: alias => (None|DES_EDE3|AES128|AES256),
1495: name => (None|DES_EDE3|Rijndael),
1.44 andrew 1496: keylen => <key length of the cipher>,
1.34 andrew 1497: blocksize => <block size of the cipher>,
1498: default_iter => <default iterations for the cipher>,
1499: };
1500:
1.46 andrew 1501: If it is unable to find the crypt it will return undef.
1502:
1503: =head2 labels
1504:
1.49 andrew 1505: Pass in the id or the name of the label. The label id is used as a key
1506: to the different parts of the records.
1507: See Encrypt() for details on where the label is used.
1.46 andrew 1508:
1509: This is a function, not a method.
1510:
1511: my $l = Palm::Keyring::labels($label);
1512:
1513: $l is now:
1514:
1515: $l = {
1516: id => 0,
1517: name => 'name',
1518: };
1519:
1520: If what you passed in was a number that doesn't have a name, it will return:
1521:
1522: $l => {
1523: id => $num_passed_in,
1524: name => undef,
1525: }
1526:
1527: If you pass in a name that it can't find, then it returns undef.
1528:
1.16 andrew 1529: =head2 Encrypt
1.11 andrew 1530:
1.49 andrew 1531: =head3 B<!!! IMPORTANT !!!> The order of the arguments to Encrypt has
1532: changed. $password and $plaintext used to be swapped. They changed
1533: because you can now set $rec->{plaintext} and not pass in $plaintext so
1534: $password is more important.
1535:
1.48 andrew 1536: $pdb->Encrypt($rec[, $password[, $plaintext[, $ivec]]]);
1.11 andrew 1537:
1.16 andrew 1538: Encrypts an account into a record, either with the password previously
1539: used, or with a password that is passed.
1.34 andrew 1540:
1541: $ivec is the initialization vector to use to encrypt the record. This is
1542: not used by v4 databases. Normally this is not passed and is generated
1543: randomly.
1.1 andrew 1544:
1.28 andrew 1545: $rec is a record from $pdb->{records} or a new_Record().
1.48 andrew 1546: $rec->{plaintext} is a hashref in the format below.
1.1 andrew 1547:
1.48 andrew 1548: $plaintext = {
1.46 andrew 1549: 0 => {
1550: label => 'name',
1551: label_id => 0,
1552: font => 0,
1553: data => $name,
1554: 1 => {
1555: label => 'account',
1556: label_id => 1,
1557: font => 0,
1558: data => $account,
1559: },
1560: 2 => {
1561: label => 'password',
1562: label_id => 2,
1563: font => 0,
1564: data => $password,
1.20 andrew 1565: },
1.46 andrew 1566: 3 => {
1567: label => 'lastchange',
1568: label_id => 3,
1569: font => 0,
1.49 andrew 1570: data => {
1571: year => $year, # usually the year - 1900
1572: mon => $mon, # range 0-11
1573: day => $day, # range 1-31
1574: },
1.31 andrew 1575: },
1.46 andrew 1576: 255 => {
1577: label => 'notes',
1578: label_id => 255,
1579: font => 0,
1580: data => $notes,
1.31 andrew 1581: },
1.46 andrew 1582: };
1.31 andrew 1583:
1.49 andrew 1584: The account name is stored in $rec->{plaintext}->{0}->{data} for both v4
1585: and v5 databases even when the record has not been Decrypt()ed.
1.31 andrew 1586:
1.48 andrew 1587: $rec->{plaintext}->{0} => {
1.47 andrew 1588: label => 'name',
1589: label_id => 0,
1590: font => 0,
1591: data => 'account name',
1.46 andrew 1592: };
1.31 andrew 1593:
1.22 andrew 1594: If you have changed anything other than the lastchange, or don't pass in a
1.24 andrew 1595: lastchange key, Encrypt() will generate a new lastchange date for you.
1.22 andrew 1596:
1597: If you pass in a lastchange field that is different than the one in the
1598: record, it will honor what you passed in.
1599:
1.48 andrew 1600: You can either set $rec->{plaintext} or pass in $plaintext. $plaintext
1601: is used over anything in $rec->{plaintext}.
1602:
1.22 andrew 1603:
1.16 andrew 1604: =head2 Decrypt
1.1 andrew 1605:
1.48 andrew 1606: my $plaintext = $pdb->Decrypt($rec[, $password]);
1.1 andrew 1607:
1.48 andrew 1608: Decrypts the record and returns a reference for the plaintext account as
1.49 andrew 1609: described under Encrypt().
1.48 andrew 1610: Also sets $rec->{plaintext} with the same information as $plaintext as
1.49 andrew 1611: described in Encrypt().
1.1 andrew 1612:
1.46 andrew 1613: foreach my $rec (@{ $pdb->{records} }) {
1.48 andrew 1614: my $plaintext = $pdb->Decrypt($rec);
1615: # do something with $plaintext
1.16 andrew 1616: }
1.1 andrew 1617:
1.31 andrew 1618:
1.16 andrew 1619: =head2 Password
1.1 andrew 1620:
1.16 andrew 1621: $pdb->Password([$password[, $new_password]]);
1.1 andrew 1622:
1.16 andrew 1623: Either sets the password to be used to crypt, or if you pass $new_password,
1624: changes the password on the database.
1.1 andrew 1625:
1.16 andrew 1626: If you have created a new $pdb, and you didn't set a password when you
1627: called new(), you only need to pass one password and it will set that as
1628: the password.
1.1 andrew 1629:
1.24 andrew 1630: If nothing is passed, it forgets the password that it was remembering.
1.36 andrew 1631:
1632: After a successful password verification the following fields are set
1633:
1634: For v4
1635:
1.37 andrew 1636: $pdb->{digest} = the calculated digest used from the key;
1637: $pdb->{password} = the password that was passed in;
1.46 andrew 1638: $pdb->{encpassword} = the password as stored in the pdb;
1.36 andrew 1639:
1640: For v5
1641:
1.37 andrew 1642: $pdb->{appinfo} = {
1643: # As described under new() with these additional fields
1644: cipher => The index number of the cipher being used
1645: iter => Number of iterations for the cipher
1646: key => The key that is calculated from the password
1647: and salt and is used to decrypt the records.
1648: masterhash => the hash of the key that is stored in the
1649: database. Either set when Loading the database
1650: or when setting a new password.
1651: salt => the salt that is either read out of the database
1652: or calculated when setting a new password.
1653: };
1.1 andrew 1654:
1.48 andrew 1655: =head2 Unlock
1656:
1657: $pdb->Unlock([$password]);
1658:
1659: Decrypts all the records. Sets $rec->{plaintext} for all records.
1660:
1661: This makes it easy to show all decrypted information.
1662:
1663: my $pdb = Palm::KeyRing->new();
1664: $pdb->Load($keyring_file);
1665: $pdb->Unlock($password);
1666: foreach my $plaintext (map { $_->{plaintext} } @{ $pdb->{records} }) {
1667: # Do something like display the account.
1668: }
1669: $pdb->Lock();
1670:
1671: =head2 Lock
1672:
1673: $pdb->Lock();
1674:
1675: Unsets $rec->{plaintext} for all records and unsets the saved password.
1676:
1.49 andrew 1677: This does NOT Encrypt() any of the records before clearing them, so if
1.48 andrew 1678: you are not careful you will lose information.
1679:
1680: B<CAVEAT!> This only does "delete $rec->{plaintext}" and the same for the
1681: password. If someone knows of a cross platform reliable way to make
1682: sure that the information is actually cleared from memory I would
1683: appreciate it. Also, if someone knows how to make sure that the stuff
1684: in $rec->{plaintext} is not written to swap, that would be very handy as
1685: well.
1686:
1.43 andrew 1687: =head2 Other overridden subroutines/methods
1688:
1689: =over
1690:
1691: =item ParseAppInfoBlock
1692:
1693: Converts the extra returned by Palm::StdAppInfo::ParseAppInfoBlock() into
1694: the following additions to $pdb->{appinfo}
1695:
1696: $pdb->{appinfo} = {
1697: cipher => The index number of the cipher being used (Not v4)
1698: iter => Number of iterations for the cipher (Not v4)
1699: };
1700:
1701: =item PackAppInfoBlock
1702:
1703: Reverses ParseAppInfoBlock before
1704: sending it on to Palm::StdAppInfo::PackAppInfoBlock()
1705:
1706: =item ParseRecord
1707:
1708: Adds some fields to a record from Palm::StdAppInfo::ParseRecord()
1709:
1710: $rec = {
1711: name => Account name
1712: ivec => The IV for the encrypted record. (Not v4)
1713: encrypted => the encrypted information
1714: };
1.46 andrew 1715:
1716: For v4 databases it also removes record 0 and moves the encrypted password
1717: to $self->{encpassword}.
1.43 andrew 1718:
1719: =item PackRecord
1720:
1721: Reverses ParseRecord and then sends it through Palm::StdAppInfo::PackRecord()
1722:
1.47 andrew 1723: =item Write
1724:
1725: For v4 databases it puts back the record 0 for the encrypted password before
1726: writing it.
1727:
1.43 andrew 1728: =back
1729:
1.14 andrew 1730: =head1 DEPENDENCIES
1.1 andrew 1731:
1.14 andrew 1732: Palm::StdAppInfo
1.1 andrew 1733:
1.41 andrew 1734: B<For v4 databases>
1735:
1.14 andrew 1736: Digest::MD5
1.9 andrew 1737:
1.14 andrew 1738: Crypt::DES
1.4 andrew 1739:
1.41 andrew 1740: B<For v5 databases>
1741:
1742: Digest::HMAC_SHA1
1743:
1744: Digest::SHA1
1745:
1746: Depending on how the database is encrypted
1747:
1748: Crypt::CBC - For any encryption but None
1749:
1.43 andrew 1750: Crypt::DES_EDE3 - DES_EDE3 encryption
1.41 andrew 1751:
1.43 andrew 1752: Crytp::Rijndael - AES encryption schemes
1.10 andrew 1753:
1.24 andrew 1754: =head1 THANKS
1755:
1.47 andrew 1756: I would like to thank the helpful Perlmonk shigetsu who gave me some great
1757: advice and helped me get my first module posted.
1758: L<http://perlmonks.org/?node_id=596998>
1.24 andrew 1759:
1760: I would also like to thank
1761: Johan Vromans
1762: E<lt>jvromans@squirrel.nlE<gt> --
1763: L<http://www.squirrel.nl/people/jvromans>.
1764: He had his own Palm::KeyRing module that he posted a couple of days before
1765: mine was ready and he was kind enough to let me have the namespace as well
1766: as giving me some very helpful hints about doing a few things that I was
1767: unsure of. He is really great.
1.42 andrew 1768:
1769: And finally,
1770: thanks to Jochen Hoenicke E<lt>hoenicke@gmail.comE<gt>
1771: (one of the authors of Palm Keyring)
1772: for getting me started on the v5 support as well as providing help
1773: and some subroutines.
1.24 andrew 1774:
1.14 andrew 1775: =head1 BUGS AND LIMITATIONS
1.43 andrew 1776:
1777: I am sure there are problems with this module. For example, I have
1778: not done very extensive testing of the v5 databases.
1.45 andrew 1779:
1780: I am not sure I am 'require module' the best way, but I don't want to
1781: depend on modules that you don't need to use.
1.43 andrew 1782:
1783: The date validation for packing new dates is very poor.
1784:
1785: I have not gone through and standardized on how the module fails. Some
1786: things fail with croak, some return undef, some may even fail silently.
1.49 andrew 1787: Nothing initializes a lasterr method or anything like that.
1788:
1789: This module does not do anything special with the plaintext data. It SHOULD
1790: treat it somehow special so that it can't be found in RAM or in a swap file
1791: anywhere. I don't have a clue how to do this.
1792:
1793: I need to fix all this before it is a 1.0 candidate.
1.1 andrew 1794:
1.14 andrew 1795: Please report any bugs or feature requests to
1796: C<bug-palm-keyring at rt.cpan.org>, or through the web interface at
1797: L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
1798: notified of progress on your bug as I make changes.
1.1 andrew 1799:
1800: =head1 AUTHOR
1801:
1.27 andrew 1802: Andrew Fresh E<lt>andrew@cpan.orgE<gt>
1.1 andrew 1803:
1.14 andrew 1804: =head1 LICENSE AND COPYRIGHT
1805:
1806: Copyright 2004, 2005, 2006, 2007 Andrew Fresh, All Rights Reserved.
1807:
1.15 andrew 1808: This program is free software; you can redistribute it and/or
1809: modify it under the same terms as Perl itself.
1.14 andrew 1810:
1.1 andrew 1811: =head1 SEE ALSO
1812:
1813: Palm::PDB(3)
1814:
1815: Palm::StdAppInfo(3)
1.11 andrew 1816:
1817: The Keyring for Palm OS website:
1818: L<http://gnukeyring.sourceforge.net/>
1.31 andrew 1819:
1820: The HACKING guide for palm keyring databases:
1821: L<http://gnukeyring.cvs.sourceforge.net/*checkout*/gnukeyring/keyring/HACKING>
1.24 andrew 1822:
1823: Johan Vromans also has a wxkeyring app that now uses this module, available
1.27 andrew 1824: 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