[BACK]Return to KeyRingpdbdump CVS log [TXT][DIR] Up to [local] / palm / Palm-Keyring / examples

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>