Annotation of palm/Palm-Keyring/examples/KeyRingpdbdump, Revision 1.1
1.1 ! andrew 1: #!/usr/bin/perl
! 2: #
! 3: # Dump a Palm PDB or PRC database.
! 4: #
! 5: # $Id: KeyRingpdbdump,v 1.2 2005/08/25 00:56:07 andrew Exp $
! 6: # $RedRiver: KeyRingpdbdump,v 1.2 2005/08/25 00:56:07 andrew Exp $
! 7:
! 8: use strict;
! 9: use Palm::PDB;
! 10: use Palm::Raw;
! 11:
! 12: use lib 'lib';
! 13: # Load handlers for the built-in apps by default
! 14: use Palm::Memo;
! 15: use Palm::Address;
! 16: use Palm::Datebook;
! 17: use Palm::Mail;
! 18: use Palm::ToDo;
! 19: use Palm::Keyring;
! 20:
! 21: use vars qw( $VERSION %PDBHandlers %PRCHandlers $hexdump );
! 22:
! 23: $VERSION = sprintf "%d.%03d_%03d_%03d",
! 24: '$Revision: 1.2 $ ' =~ m{(\d+)(?:\.(\d+))};
! 25:
! 26: *PDBHandlers = *Palm::PDB::PDBHandlers;
! 27: *PRCHandlers = *Palm::PDB::PRCHandlers;
! 28:
! 29: &Palm::PDB::RegisterPRCHandlers("Palm::Raw",
! 30: [ "", "" ]
! 31: );
! 32:
! 33: $hexdump = 1; # By default, print hex dumps of everything
! 34:
! 35: # Parse command-line arguments
! 36: my $arg;
! 37: while (($arg = $ARGV[0]) =~ /^-/)
! 38: {
! 39: $arg = shift;
! 40:
! 41: if (($arg eq "-h") || ($arg eq "-help") || ($arg eq "--help"))
! 42: {
! 43: print <<EOT;
! 44: Usage: $0 [options] pdb-file
! 45: Options:
! 46: -h, -help, --help This message.
! 47: -nohex Don't print hex dumps
! 48: -M<module> Load <module> (e.g., -MPalm::Address)
! 49: EOT
! 50: #'
! 51: exit 0;
! 52: } elsif ($arg =~ /^-M/)
! 53: {
! 54: eval "use $';";
! 55: } elsif ($arg eq "-nohex")
! 56: {
! 57: $hexdump = 0;
! 58: } else {
! 59: die "Unrecognized option: $arg\n";
! 60: }
! 61: }
! 62:
! 63: my $fname = shift;
! 64:
! 65: die "No such file: $fname\n" if ! -f $fname;
! 66:
! 67: my $EPOCH_1904 = 2082844800; # Difference between Palm's
! 68: # epoch (Jan. 1, 1904) and
! 69: # Unix's epoch (Jan. 1, 1970),
! 70: # in seconds.
! 71: my $HeaderLen = 32+2+2+(9*4); # Size of database header
! 72: my $RecIndexHeaderLen = 6; # Size of record index header
! 73: my $IndexRecLen = 8; # Length of record index entry
! 74: my $IndexRsrcLen = 10; # Length of resource index entry
! 75:
! 76: #%PDBHandlers = (); # Record handler map
! 77: #%PRCHandlers = (); # Resource handler map
! 78:
! 79:
! 80: #&Palm::PDB::rawread($fname);
! 81: &rawread($fname);
! 82:
! 83: #package Palm::PDB; # XXX - Gross hack!
! 84: sub rawread
! 85: {
! 86: my $self = new Palm::Raw;
! 87: my $fname = shift; # Filename to read from
! 88: my $buf; # Buffer into which to read stuff
! 89:
! 90: # Open database file
! 91: open PDB, "< $fname" or die "Can't open \"$fname\": $!\n";
! 92: binmode PDB; # Parse as binary file under MS-DOS
! 93:
! 94: # Get the size of the file. It'll be useful later
! 95: seek PDB, 0, 2; # 2 == SEEK_END. Seek to the end.
! 96: $self->{_size} = tell PDB;
! 97: print "File size: $self->{_size}\n";
! 98: seek PDB, 0, 0; # 0 == SEEK_START. Rewind to the beginning.
! 99:
! 100: # Read header
! 101: my $name;
! 102: my $attributes;
! 103: my $version;
! 104: my $ctime;
! 105: my $mtime;
! 106: my $baktime;
! 107: my $modnum;
! 108: my $appinfo_offset;
! 109: my $sort_offset;
! 110: my $type;
! 111: my $creator;
! 112: my $uniqueIDseed;
! 113:
! 114: read PDB, $buf, $HeaderLen; # Read the PDB header
! 115: print "Database header:\n";
! 116: if ($hexdump)
! 117: {
! 118: &hexdump(" ", $buf);
! 119: print "\n";
! 120: }
! 121:
! 122: # Split header into its component fields
! 123: ($name, $attributes, $version, $ctime, $mtime, $baktime,
! 124: $modnum, $appinfo_offset, $sort_offset, $type, $creator,
! 125: $uniqueIDseed) =
! 126: unpack "a32 n n N N N N N N a4 a4 N", $buf;
! 127:
! 128: ($self->{name} = $name) =~ s/\0*$//;
! 129: $self->{attributes}{resource} = 1 if $attributes & 0x0001;
! 130: $self->{attributes}{"read-only"} = 1 if $attributes & 0x0002;
! 131: $self->{attributes}{"AppInfo dirty"} = 1 if $attributes & 0x0004;
! 132: $self->{attributes}{backup} = 1 if $attributes & 0x0008;
! 133: $self->{attributes}{"OK newer"} = 1 if $attributes & 0x0010;
! 134: $self->{attributes}{reset} = 1 if $attributes & 0x0020;
! 135: $self->{attributes}{open} = 1 if $attributes & 0x0040;
! 136: $self->{attributes}{launchable} = 1 if $attributes & 0x0200;
! 137: $self->{version} = $version;
! 138: $self->{ctime} = $ctime - $EPOCH_1904;
! 139: $self->{mtime} = $mtime - $EPOCH_1904;
! 140: $self->{baktime} = $baktime - $EPOCH_1904;
! 141: $self->{modnum} = $modnum;
! 142: # _appinfo_offset and _sort_offset are private fields
! 143: $self->{_appinfo_offset} = $appinfo_offset;
! 144: $self->{_sort_offset} = $sort_offset;
! 145: $self->{type} = $type;
! 146: $self->{creator} = $creator;
! 147: $self->{uniqueIDseed} = $uniqueIDseed;
! 148:
! 149: print <<EOT;
! 150: Name: $name
! 151: Attributes: @{[sprintf("0x%02x", $attributes)]}
! 152: EOT
! 153: print " "x19;
! 154: print " LAUNCHABLE" if $self->{attributes}{launchable};
! 155: print " OPEN" if $self->{attributes}{open};
! 156: print " RESET" if $self->{attributes}{reset};
! 157: print " OKNEWER" if $self->{attributes}{"OK newer"};
! 158: print " BACKUP" if $self->{attributes}{backup};
! 159: print " APPINFO-DIRTY" if $self->{attributes}{"AppInfo dirty"};
! 160: print " READ-ONLY" if $self->{attributes}{"read-only"};
! 161: print " RESOURCE" if $self->{attributes}{resource};
! 162: print "\n";
! 163: print <<EOT;
! 164: Version: $version
! 165: Ctime: $ctime @{[scalar(localtime($ctime-$EPOCH_1904))]}
! 166: Mtime: $mtime @{[scalar(localtime($mtime-$EPOCH_1904))]}
! 167: Backup time: $baktime @{[scalar(localtime($baktime-$EPOCH_1904))]}
! 168: Mod number: $modnum
! 169: AppInfo offset: $appinfo_offset
! 170: Sort offset: $sort_offset
! 171: Type: $type
! 172: Creator: $creator
! 173: Unique ID seed: $uniqueIDseed
! 174:
! 175: EOT
! 176:
! 177: # Rebless this PDB object, depending on its type and/or
! 178: # creator. This allows us to magically invoke the proper
! 179: # &Parse*() function on the various parts of the database.
! 180:
! 181: # Look for most specific handlers first, least specific ones
! 182: # last. That is, first look for a handler that deals
! 183: # specifically with this database's creator and type, then for
! 184: # one that deals with this database's creator and any type,
! 185: # and finally for one that deals with anything.
! 186:
! 187: my $handler;
! 188: if ($self->{attributes}{resource})
! 189: {
! 190: # Look among resource handlers
! 191: $handler = $PRCHandlers{$self->{creator}}{$self->{type}} ||
! 192: $PRCHandlers{undef}{$self->{type}} ||
! 193: $PRCHandlers{$self->{creator}}{""} ||
! 194: $PRCHandlers{""}{""};
! 195: } else {
! 196: # Look among record handlers
! 197: $handler = $PDBHandlers{$self->{creator}}{$self->{type}} ||
! 198: $PDBHandlers{""}{$self->{type}} ||
! 199: $PDBHandlers{$self->{creator}}{""} ||
! 200: $PDBHandlers{""}{""};
! 201: }
! 202:
! 203: if (defined($handler))
! 204: {
! 205: bless $self, $handler;
! 206: } else {
! 207: # XXX - This should probably return 'undef' or something,
! 208: # rather than die.
! 209: die "No handler defined for creator \"$creator\", type \"$type\"\n";
! 210: }
! 211:
! 212: ## Read record/resource index
! 213: # Read index header
! 214: read PDB, $buf, $RecIndexHeaderLen;
! 215: print "Record/resource index header:\n";
! 216: if ($hexdump)
! 217: {
! 218: &hexdump(" ", $buf);
! 219: print "\n";
! 220: }
! 221:
! 222: my $next_index;
! 223: my $numrecs;
! 224:
! 225: ($next_index, $numrecs) = unpack "N n", $buf;
! 226: $self->{_numrecs} = $numrecs;
! 227:
! 228: print <<EOT;
! 229: Next index: $next_index
! 230: # records: $numrecs
! 231:
! 232: EOT
! 233:
! 234: # Read the index itself
! 235: if ($self->{attributes}{resource})
! 236: {
! 237: &_load_rsrc_index($self, \*PDB);
! 238: } else {
! 239: &_load_rec_index($self, \*PDB);
! 240: }
! 241:
! 242: # Ignore the two NUL bytes that are usually here. We'll seek()
! 243: # around them later.
! 244:
! 245: # Read AppInfo block, if it exists
! 246: if ($self->{_appinfo_offset} != 0)
! 247: {
! 248: &_load_appinfo_block($self, \*PDB);
! 249: }
! 250:
! 251: # Read sort block, if it exists
! 252: if ($self->{_sort_offset} != 0)
! 253: {
! 254: &_load_sort_block($self, \*PDB);
! 255: }
! 256:
! 257: # Read record/resource list
! 258: if ($self->{attributes}{resource})
! 259: {
! 260: &_load_resources($self, \*PDB);
! 261: } else {
! 262: &_load_records($self, \*PDB);
! 263: }
! 264:
! 265: # These keys were needed for parsing the file, but are not
! 266: # needed any longer. Delete them.
! 267: delete $self->{_index};
! 268: delete $self->{_numrecs};
! 269: delete $self->{_appinfo_offset};
! 270: delete $self->{_sort_offset};
! 271: delete $self->{_size};
! 272:
! 273: close PDB;
! 274: }
! 275:
! 276:
! 277: # _load_rec_index
! 278: # Private function. Read the record index, for a record database
! 279: sub _load_rec_index
! 280: {
! 281: my $pdb = shift;
! 282: my $fh = shift; # Input file handle
! 283: my $i;
! 284: my $lastoffset = 0;
! 285:
! 286: print "Record index:\n";
! 287:
! 288: # Read each record index entry in turn
! 289: for ($i = 0; $i < $pdb->{_numrecs}; $i++)
! 290: {
! 291: my $buf; # Input buffer
! 292:
! 293: print " Record index entry $i\n";
! 294:
! 295: # Read the next record index entry
! 296: my $offset;
! 297: my $attributes;
! 298: my @id; # Raw ID
! 299: my $id; # Numerical ID
! 300: my $entry = {}; # Parsed index entry
! 301:
! 302: read $fh, $buf, $IndexRecLen;
! 303: if ($hexdump)
! 304: {
! 305: &hexdump(" ", $buf);
! 306: print "\n";
! 307: }
! 308:
! 309: # The ID field is a bit weird: it's represented as 3
! 310: # bytes, but it's really a double word (long) value.
! 311:
! 312: ($offset, $attributes, @id) = unpack "N C C3", $buf;
! 313: if ($offset == $lastoffset)
! 314: {
! 315: print STDERR "Record $i has same offset as previous one: $offset\n";
! 316: }
! 317: $lastoffset = $offset;
! 318:
! 319: $entry->{offset} = $offset;
! 320: $entry->{attributes}{expunged} = 1 if $attributes & 0x80;
! 321: $entry->{attributes}{dirty} = 1 if $attributes & 0x40;
! 322: $entry->{attributes}{deleted} = 1 if $attributes & 0x20;
! 323: $entry->{attributes}{private} = 1 if $attributes & 0x10;
! 324: $entry->{id} = ($id[0] << 16) |
! 325: ($id[1] << 8) |
! 326: $id[2];
! 327:
! 328: # The lower 4 bits of the attributes field are
! 329: # overloaded: If the record has been deleted and/or
! 330: # expunged, then bit 0x08 indicates whether the record
! 331: # should be archived. Otherwise (if it's an ordinary,
! 332: # non-deleted record), the lower 4 bits specify the
! 333: # category that the record belongs in.
! 334: if (($attributes & 0xa0) == 0)
! 335: {
! 336: $entry->{category} = $attributes & 0x0f;
! 337: } else {
! 338: $entry->{attributes}{archive} = 1
! 339: if $attributes & 0x08;
! 340: }
! 341:
! 342: print <<EOT;
! 343: Offset: $offset
! 344: Attributes: @{[sprintf("0x%02x", $attributes), keys %{$entry->{attributes}}]}
! 345: Category: $entry->{category}
! 346: ID: @{[sprintf("0x%02x%02x%02x", @id)]}
! 347:
! 348: EOT
! 349:
! 350: # Put this information on a temporary array
! 351: push @{$pdb->{_index}}, $entry;
! 352: }
! 353: }
! 354:
! 355: # XXX - Make this print out debugging information
! 356: # _load_rsrc_index
! 357: # Private function. Read the resource index, for a resource database
! 358: sub _load_rsrc_index
! 359: {
! 360: my $pdb = shift;
! 361: my $fh = shift; # Input file handle
! 362: my $i;
! 363:
! 364: print "Resource index:\n";
! 365:
! 366: # Read each resource index entry in turn
! 367: for ($i = 0; $i < $pdb->{_numrecs}; $i++)
! 368: {
! 369: my $buf; # Input buffer
! 370:
! 371: print " Resource index entry $i\n";
! 372:
! 373: # Read the next resource index entry
! 374: my $type;
! 375: my $id;
! 376: my $offset;
! 377: my $entry = {}; # Parsed index entry
! 378:
! 379: read $fh, $buf, $IndexRsrcLen;
! 380: if ($hexdump)
! 381: {
! 382: &hexdump(" ", $buf);
! 383: print "\n";
! 384: }
! 385:
! 386: ($type, $id, $offset) = unpack "a4 n N", $buf;
! 387:
! 388: $entry->{type} = $type;
! 389: $entry->{id} = $id;
! 390: $entry->{offset} = $offset;
! 391:
! 392: print <<EOT;
! 393: Offset: $offset
! 394: ID: $id
! 395: Type: $type
! 396:
! 397: EOT
! 398:
! 399: push @{$pdb->{_index}}, $entry;
! 400: }
! 401: }
! 402:
! 403: # _load_appinfo_block
! 404: # Private function. Read the AppInfo block
! 405: sub _load_appinfo_block
! 406: {
! 407: my $pdb = shift;
! 408: my $fh = shift; # Input file handle
! 409: my $len; # Length of AppInfo block
! 410: my $buf; # Input buffer
! 411:
! 412: print "AppInfo block:\n";
! 413:
! 414: # Sanity check: make sure we're positioned at the beginning of
! 415: # the AppInfo block
! 416: if (tell($fh) > $pdb->{_appinfo_offset})
! 417: {
! 418: die "Bad AppInfo offset: expected ",
! 419: sprintf("0x%08x", $pdb->{_appinfo_offset}),
! 420: ", but I'm at ",
! 421: tell($fh), "\n";
! 422: }
! 423:
! 424: # Seek to the right place, if necessary
! 425: if (tell($fh) != $pdb->{_appinfo_offset})
! 426: {
! 427: seek PDB, $pdb->{_appinfo_offset}, 0;
! 428: }
! 429:
! 430: # There's nothing that explicitly gives the size of the
! 431: # AppInfo block. Rather, it has to be inferred from the offset
! 432: # of the AppInfo block (previously recorded in
! 433: # $pdb->{_appinfo_offset}) and whatever's next in the file.
! 434: # That's either the sort block, the first data record, or the
! 435: # end of the file.
! 436:
! 437: if ($pdb->{_sort_offset})
! 438: {
! 439: # The next thing in the file is the sort block
! 440: $len = $pdb->{_sort_offset} - $pdb->{_appinfo_offset};
! 441: } elsif ((defined $pdb->{_index}) && @{$pdb->{_index}})
! 442: {
! 443: # There's no sort block; the next thing in the file is
! 444: # the first data record
! 445: $len = $pdb->{_index}[0]{offset} -
! 446: $pdb->{_appinfo_offset};
! 447: } else {
! 448: # There's no sort block and there are no records. The
! 449: # AppInfo block goes to the end of the file.
! 450: $len = $pdb->{_size} - $pdb->{_appinfo_offset};
! 451: }
! 452:
! 453: # Read the AppInfo block
! 454: read $fh, $buf, $len;
! 455: if ($hexdump)
! 456: {
! 457: &hexdump(" ", $buf);
! 458: print "\n";
! 459: }
! 460:
! 461: # Tell the real class to parse the AppInfo block
! 462: $pdb->{appinfo} = $pdb->ParseAppInfoBlock($buf);
! 463:
! 464: # Print out the parsed values
! 465: if (ref($pdb->{appinfo}) ne "")
! 466: {
! 467: &dumphash($pdb->{appinfo}, "\t");
! 468: print "\n";
! 469: }
! 470: }
! 471:
! 472: # _load_sort_block
! 473: # Private function. Read the sort block.
! 474: sub _load_sort_block
! 475: {
! 476: my $pdb = shift;
! 477: my $fh = shift; # Input file handle
! 478: my $len; # Length of sort block
! 479: my $buf; # Input buffer
! 480:
! 481: print "Sort block:\n";
! 482:
! 483: # Sanity check: make sure we're positioned at the beginning of
! 484: # the sort block
! 485: if (tell($fh) > $pdb->{_sort_offset})
! 486: {
! 487: die "Bad sort block offset: expected ",
! 488: sprintf("0x%08x", $pdb->{_sort_offset}),
! 489: ", but I'm at ",
! 490: tell($fh), "\n";
! 491: }
! 492:
! 493: # Seek to the right place, if necessary
! 494: if (tell($fh) != $pdb->{_sort_offset})
! 495: {
! 496: seek PDB, $pdb->{_sort_offset}, 0;
! 497: }
! 498:
! 499: # There's nothing that explicitly gives the size of the sort
! 500: # block. Rather, it has to be inferred from the offset of the
! 501: # sort block (previously recorded in $pdb->{_sort_offset})
! 502: # and whatever's next in the file. That's either the first
! 503: # data record, or the end of the file.
! 504:
! 505: if (defined($pdb->{_index}))
! 506: {
! 507: # The next thing in the file is the first data record
! 508: $len = $pdb->{_index}[0]{offset} -
! 509: $pdb->{_sort_offset};
! 510: } else {
! 511: # There are no records. The sort block goes to the end
! 512: # of the file.
! 513: $len = $pdb->{_size} - $pdb->{_sort_offset};
! 514: }
! 515:
! 516: # Read the AppInfo block
! 517: read $fh, $buf, $len;
! 518: if ($hexdump)
! 519: {
! 520: &hexdump(" ", $buf);
! 521: print "\n";
! 522: }
! 523:
! 524: # XXX - Check to see if the sort block has some predefined
! 525: # structure. If so, it might be a good idea to parse the sort
! 526: # block here.
! 527:
! 528: # Tell the real class to parse the sort block
! 529: $pdb->{sort} = $pdb->ParseSortBlock($buf);
! 530: }
! 531:
! 532: # _load_records
! 533: # Private function. Load the actual data records, for a record database
! 534: # (PDB)
! 535: sub _load_records
! 536: {
! 537: my $pdb = shift;
! 538: my $fh = shift; # Input file handle
! 539: my $i;
! 540:
! 541: print "Records:\n";
! 542: # Read each record in turn
! 543: for ($i = 0; $i < $pdb->{_numrecs}; $i++)
! 544: {
! 545: my $len; # Length of record
! 546: my $buf; # Input buffer
! 547:
! 548: print " Record $i\n";
! 549:
! 550: # Sanity check: make sure we're where we think we
! 551: # should be.
! 552: if (tell($fh) > $pdb->{_index}[$i]{offset})
! 553: {
! 554: # XXX - The two NULs are really optional.
! 555: # die "Bad offset for record $i: expected ",
! 556: # sprintf("0x%08x",
! 557: # $pdb->{_index}[$i]{offset}),
! 558: # " but it's at ",
! 559: # sprintf("[0x%08x]", tell($fh)), "\n";
! 560: }
! 561:
! 562: # Seek to the right place, if necessary
! 563: if (tell($fh) != $pdb->{_index}[$i]{offset})
! 564: {
! 565: seek PDB, $pdb->{_index}[$i]{offset}, 0;
! 566: }
! 567:
! 568: # Compute the length of the record: the last record
! 569: # extends to the end of the file. The others extend to
! 570: # the beginning of the next record.
! 571: if ($i == $pdb->{_numrecs} - 1)
! 572: {
! 573: # This is the last record
! 574: $len = $pdb->{_size} -
! 575: $pdb->{_index}[$i]{offset};
! 576: } else {
! 577: # This is not the last record
! 578: $len = $pdb->{_index}[$i+1]{offset} -
! 579: $pdb->{_index}[$i]{offset};
! 580: }
! 581:
! 582: # Read the record
! 583: read $fh, $buf, $len;
! 584: if ($hexdump)
! 585: {
! 586: &hexdump(" ", $buf);
! 587: print "\n";
! 588: }
! 589:
! 590: # Tell the real class to parse the record data. Pass
! 591: # &ParseRecord all of the information from the index,
! 592: # plus a "data" field with the raw record data.
! 593: my $record;
! 594:
! 595: $record = $pdb->ParseRecord(
! 596: %{$pdb->{_index}[$i]},
! 597: "data" => $buf,
! 598: );
! 599:
! 600: my $pass = 12345;
! 601: if ($i == 0) {
! 602: unless (keyring_verify($record->{data}, $pass) ) {
! 603: die "Incorrect password!";
! 604: }
! 605: } else {
! 606: $record->{decrypted} = decrypt($record->{data}, $pass);
! 607: }
! 608: push @{$pdb->{records}}, $record;
! 609:
! 610: if ($hexdump)
! 611: {
! 612: &hexdump(" ", $record->{decrypted});
! 613: print "\n";
! 614: }
! 615:
! 616: # Print out the parsed values
! 617: &dumphash($record, "\t");
! 618: print "\n";
! 619: }
! 620: use Data::Dumper;
! 621: print Dumper $pdb;
! 622: }
! 623:
! 624: # _load_resources
! 625: # Private function. Load the actual data resources, for a resource database
! 626: # (PRC)
! 627: sub _load_resources
! 628: {
! 629: my $pdb = shift;
! 630: my $fh = shift; # Input file handle
! 631: my $i;
! 632:
! 633: print "Resources:\n";
! 634: # Read each resource in turn
! 635: for ($i = 0; $i < $pdb->{_numrecs}; $i++)
! 636: {
! 637: my $len; # Length of record
! 638: my $buf; # Input buffer
! 639:
! 640: print " Resource $i\n";
! 641:
! 642: # Sanity check: make sure we're where we think we
! 643: # should be.
! 644: if (tell($fh) > $pdb->{_index}[$i]{offset})
! 645: {
! 646: die "Bad offset for resource $i: expected ",
! 647: sprintf("0x%08x",
! 648: $pdb->{_index}[$i]{offset}),
! 649: " but it's at ",
! 650: sprintf("0x%08x", tell($fh)), "\n";
! 651: }
! 652:
! 653: # Seek to the right place, if necessary
! 654: if (tell($fh) != $pdb->{_index}[$i]{offset})
! 655: {
! 656: seek PDB, $pdb->{_index}[$i]{offset}, 0;
! 657: }
! 658:
! 659: # Compute the length of the resource: the last
! 660: # resource extends to the end of the file. The others
! 661: # extend to the beginning of the next resource.
! 662: if ($i == $pdb->{_numrecs} - 1)
! 663: {
! 664: # This is the last resource
! 665: $len = $pdb->{_size} -
! 666: $pdb->{_index}[$i]{offset};
! 667: } else {
! 668: # This is not the last resource
! 669: $len = $pdb->{_index}[$i+1]{offset} -
! 670: $pdb->{_index}[$i]{offset};
! 671: }
! 672:
! 673: # Read the resource
! 674: read $fh, $buf, $len;
! 675: if ($hexdump)
! 676: {
! 677: &hexdump(" ", $buf);
! 678: print "\n";
! 679: }
! 680:
! 681: # Tell the real class to parse the resource data. Pass
! 682: # &ParseResource all of the information from the
! 683: # index, plus a "data" field with the raw resource
! 684: # data.
! 685: my $resource;
! 686:
! 687: $resource = $pdb->ParseResource(
! 688: %{$pdb->{_index}[$i]},
! 689: "data" => $buf,
! 690: );
! 691: push @{$pdb->{resources}}, $resource;
! 692:
! 693: # Print out the parsed values
! 694: &dumphash($resource, "\t");
! 695: print "\n";
! 696: }
! 697: }
! 698:
! 699: sub decrypt
! 700: {
! 701: use Digest::MD5 qw(md5);
! 702: use Crypt::TripleDES;
! 703:
! 704: my $MD5_CBLOCK = 64;
! 705:
! 706: my $data = shift;
! 707: my $pass = shift;
! 708:
! 709: my $digest = md5($pass);
! 710:
! 711: my ($key1, $key2) = unpack('a8a8', $digest);
! 712: #--------------------------------------------------
! 713: # print "key1: $key1: ", length $key1, "\n";
! 714: # print "key2: $key2: ", length $key2, "\n";
! 715: #--------------------------------------------------
! 716:
! 717: $digest = unpack('H*', $key1 . $key2 . $key1);
! 718: #--------------------------------------------------
! 719: # print "Digest: ", $digest, "\n";
! 720: # print length $digest, "\n";
! 721: #--------------------------------------------------
! 722:
! 723: my ($name, $ciphertext) = split /\0/, $data;
! 724:
! 725: my $des = new Crypt::TripleDES;
! 726: my $plaintext = $des->decrypt3($ciphertext, $digest);
! 727:
! 728: my ($account, $password, $description, $extra) = split /\0/, $plaintext, 4;
! 729:
! 730: print "Name: $name\n";
! 731: print "Account: $account\n";
! 732: print "Password: $password\n";
! 733: print "Description: $description\n";
! 734:
! 735: return $plaintext;
! 736: }
! 737:
! 738: sub keyring_verify
! 739: {
! 740: use Digest::MD5 qw(md5);
! 741:
! 742: my $MD5_CBLOCK = 64;
! 743:
! 744: my $data = shift;
! 745: my $pass = shift;
! 746:
! 747: my $kSaltSize = 4;
! 748: my $salt = substr($data, 0, $kSaltSize);
! 749:
! 750: my $msg = $salt . $pass;
! 751:
! 752: $msg .= "\0" x ($MD5_CBLOCK - length($msg));
! 753:
! 754: print "LENGTH: ", length $msg, "\n";
! 755:
! 756: my $digest = md5($msg);
! 757:
! 758: print "Data: ", unpack('H*', $data);
! 759: print "\n";
! 760: print "Digest: ", unpack('H*', $salt . $digest);
! 761: print "\n";
! 762:
! 763: if ($data eq $salt . $digest) {
! 764: return 1;
! 765: } else {
! 766: return undef;
! 767: }
! 768:
! 769: return $digest;
! 770: #return $decrypted;
! 771: }
! 772: sub hexdump
! 773: {
! 774: my $prefix = shift; # What to print in front of each line
! 775: my $data = shift; # The data to dump
! 776: my $maxlines = shift; # Max # of lines to dump
! 777: my $offset; # Offset of current chunk
! 778:
! 779: for ($offset = 0; $offset < length($data); $offset += 16)
! 780: {
! 781: my $hex; # Hex values of the data
! 782: my $ascii; # ASCII values of the data
! 783: my $chunk; # Current chunk of data
! 784:
! 785: last if defined($maxlines) && ($offset >= ($maxlines * 16));
! 786:
! 787: $chunk = substr($data, $offset, 16);
! 788:
! 789: ($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;
! 790:
! 791: ($ascii = $chunk) =~ y/\040-\176/./c;
! 792:
! 793: printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
! 794: }
! 795: }
! 796:
! 797: # XXX - Ought to have a &dumparray as well. The two can call each other
! 798: # recursively.
! 799:
! 800: sub dumphash
! 801: {
! 802: my $hash = shift;
! 803: my $indent = shift;
! 804: my $key;
! 805: my $value;
! 806:
! 807: while (($key, $value) = each %{$hash})
! 808: {
! 809: if (ref($value) eq "HASH")
! 810: {
! 811: print $indent, $key, ":\n";
! 812: &dumphash($value, $indent . "\t");
! 813: } elsif (ref($value) eq "ARRAY")
! 814: {
! 815: my($i,$j);
! 816:
! 817: print $indent, $key, ":\n";
! 818: for ($i = 0; $i <= $#{$value}; $i++)
! 819: {
! 820: if (ref($value->[$i]) eq "HASH")
! 821: {
! 822: print $indent, " $i:\n";
! 823: &dumphash($value->[$i],
! 824: $indent . "\t");
! 825: } elsif (ref($value->[$i]) eq "ARRAY")
! 826: {
! 827: my @v2 = @{$value->[$i]};
! 828: for ($j = 0; $j <= $#v2; $j++)
! 829: {
! 830: print $indent,
! 831: "\t$i-$j: [$v2[$j]]\n";
! 832: }
! 833: }else {
! 834: print $indent,
! 835: "\t$i: [$value->[$i]]\n";
! 836: }
! 837: }
! 838: } else {
! 839: print $indent, $key, " -> [", $value, "]\n";
! 840: }
! 841: }
! 842: }
! 843:
! 844: __END__
! 845:
! 846: =head1 NAME
! 847:
! 848: pdbdump - Print the contents of a Palm PDB file
! 849:
! 850: =head1 SYNOPSIS
! 851:
! 852: C<pdbdump> I<[options]> F<filename>
! 853:
! 854: =head1 DESCRIPTION
! 855:
! 856: C<pdbdump> reads a PalmOS F<.pdb> file, parses it, and prints its
! 857: contents. This includes both a hex dump of the raw data of each piece,
! 858: and a human-readable list of the various values, insofar as possible.
! 859: The aim of C<pdbdump> is to allow one to verify whether a particular
! 860: file is a well-formed PalmOS database file and if not, where the error
! 861: lies.
! 862:
! 863: If the database is of a known type, C<pdbdump> parses the AppInfo
! 864: block and records. Otherwise, it simply prints out a hex dump of their
! 865: contents. C<pdbdump> includes, by default, support for most of the
! 866: built-in applications. Other helper modules may be loaded with the
! 867: C<-M> option.
! 868:
! 869: =head1 OPTIONS
! 870:
! 871: =over 4
! 872:
! 873: =item -h -help --help
! 874:
! 875: Print a usage message and exit.
! 876:
! 877: =item -nohex
! 878:
! 879: Don't print the hex dump of the various parts.
! 880:
! 881: =item -MI<module>
! 882:
! 883: C<use> the named module. This can be useful for loading additional
! 884: helper modules.
! 885:
! 886: =back
! 887:
! 888: =head1 BUGS
! 889:
! 890: C<pdbdump> only recognizes record databases (C<.pdb> files), not
! 891: resource databases (C<.prc> files).
! 892:
! 893: =head1 SEE ALSO
! 894:
! 895: Palm::PDB(3)
! 896:
! 897: =head1 AUTHOR
! 898:
! 899: Andrew Arensburger <arensb@ooblick.com>
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>