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