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