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