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