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