#!/usr/bin/perl -w
# wince_rename
# - when run in a directory containing files extracted from
#   a Windows CE installation cabinet, it will rename all files
#   to their "installed" filenames
# - the header file (*.000) will be renamed to header.bin
# - the setup DLL (*.999) will be renamed to setup.dll
# - a REGEDIT4 style file will be made, called setup.reg
use strict;

# expands a decimal number from 0-999 into a filename with a three digit
# decimal number as a file extension, if one exists. Otherwise, undef is
# is returned.
sub get_fname {
  my $x = sprintf '*.%03d', $_[0];
  my @x = glob $x;
  if ($#x > 0) {
    print STDERR "WARNING: more than one '$x' file, using '$x[0]'\n";
  }
  elsif ($#x < 0) {
    return undef;
  }
  return $x[0];
}

sub rename_file {
  print "renaming \"$_[0]\" to \"$_[1]\"\n";
  rename $_[0], $_[1] || print STDERR "$_[0]: $!\n";
}


# get the *.000 file
my $hdrfile = get_fname(0);
if (not defined $hdrfile) {
  print "no header (*.000) file found\n";
  exit;
}

# open the header file
if (open FH, "<$hdrfile") {
  my $x;
  read FH, $x, 0x64;

  # read the fixed header
  # $hdr[0] = "MSCE" signature
  # $hdr[2] = overall length of the header file
  # $hdr[5] = target architecture ID
  # @hdr[6..11] = minimal and maximal versions WinCE versions supported
  # @hdr[12..17] = number of entries in {STRINGS,DIRS,FILES,HIVES,KEYS,LINKS}
  # @hdr[18..23] = file offset of {STRINGS,DIRS,FILES,HIVES,KEYS,LINKS}
  # @hdr[24..25] = {file offset, length} of APPNAME
  # @hdr[26..27] = {file offset, length} of PROVIDER
  # @hdr[28..29] = {file offset, length} of UNSUPPORTED
  # other entries are unknown/undefined
  my @hdr = unpack 'V12v6V6v8', $x;

  # does the file begin with "MSCE"?
  if ($hdr[0] == 0x4543534D) {
    # print appname and provider
    seek FH,$hdr[24],0; read FH,$x,$hdr[25]; chop $x; print "Appname:  $x\n";
    seek FH,$hdr[26],0; read FH,$x,$hdr[27]; chop $x; print "Provider: $x\n";

    # RENAME FILES TO INSTALLED FILENAMES:

    # seek to FILES section and loop for the number of FILES entries
    seek FH, $hdr[20], 0;
    for (1 .. $hdr[14]) {
      # read a FILES entry
      read FH, $x, 12;
      my ($id, $dirid, $realid, $flags, $len) = unpack 'vvvVv',$x;
      read FH, $x, $len; chop $x;

      # get file with decimal extension, rename it to filename given in
      # FILES entry
      rename_file(get_fname($realid), $x);
    }

    # CREATE REGISTRY KEYS LIST

    # create "setup.reg" file in REGEDIT4 format, if any KEYS entries
    if (($hdr[16] > 0) && open REGFH, '>setup.reg') {
      print REGFH "REGEDIT4\r\n";

      my @strs;
      my @hives;
      my $lasthive = -1;

      # seek to STRINGS section and read all STRINGS entries into @strs
      seek FH, $hdr[18], 0;
      for (1 .. $hdr[12]) {
	read FH, $x, 4; my ($id, $len) = unpack 'vv',$x;
	read FH, $strs[$id], $len; chop $strs[$id];
      }

      # seek to HIVES section and read all HIVES entries into @hives
      seek FH, $hdr[21], 0;
      for (1 .. $hdr[15]) {
	read FH, $x, 8; my ($id, $root, $unk, $len) = unpack 'vvvv',$x;
	read FH, $x, $len; chop $x; chop $x;
	$hives[$id] = join '\\',(('HKCR','HKCU','HKLM','HKEY_USERS')[$root-1],
				 (map{$strs[$_]} unpack 'v*', $x));
      }

      # seek to KEYS section and loop for all KEYS entries
      seek FH, $hdr[22], 0;
      for (1 .. $hdr[16]) {
	# read KEYS entry, split off name and data components
	read FH, $x, 12; my ($id,$hive,$unk,$flags,$len) = unpack 'vvvVv',$x;
	read FH, $x, $len;
	my $name = (split /\000/, $x)[0];
	my $data = substr $x, length($name) + 1;

	# print REGEDIT4 entry header for key, print hive header if a
	# different hive has been entered
	print REGFH "\r\n[$hives[$hive]]\r\n" unless $lasthive == $hive;
	print REGFH ''.(($name eq '') ? '@' : "\"$name\"").'=';
	$lasthive = $hive;

	# print appropriate REGEDIT4 format for data
	if (($flags & 0x10001) == 0x10001) {
	  print REGFH sprintf 'dword:%08x', unpack('V', $data);
	}
	elsif (($flags & 0x10001) == 0x00001) {
	  print REGFH 'hex:'.join ',',map{sprintf'%02x',$_}unpack 'c*',$data;
	}
	else {
	  chop $data; chop $data if (($flags & 0x10001) == 0x10000);
	  $data =~ s/\\/\\\\/g; $data =~ s/\000/\\0/g; $data =~ s/\"/\\\"/g;
	  print REGFH '"'.$data.'"';
	}
	print REGFH "\r\n";
      }
      close REGFH;
    }
  }
  else {
    print "$hdrfile: not a Windows CE install cabinet header\n";
  }
  close FH;

  # rename *.000 file to header.bin
  rename_file($hdrfile, 'header.bin');

  # rename *.999 file to setup.dll, if it exists
  rename_file($x, 'setup.dll') if $x = get_fname(999);
}
else {
  print "$hdrfile: $!\n";
}