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