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