#!/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, including path
# - 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;
use File::Basename qw(dirname);
use File::Copy qw(move);
use File::Path qw(make_path);
use File::Spec;
use File::Spec::Win32;

my @ce = (
  undef,
  '\Program Files',
  '\Windows',
  '\Windows\Desktop',
  '\Windows\StartUp',
  '\My Documents',
  '\Program Files\Accessories',
  '\Program Files\Communications',
  '\Program Files\Games',
  '\Program Files\Pocket Outlook',
  '\Program Files\Office',
  '\Windows\Programs',
  '\Windows\Programs\Accessories',
  '\Windows\Programs\Communications',
  '\Windows\Programs\Games',
  '\Windows\Fonts',
  '\Windows\Recent',
  '\Windows\Favorites'
);

# 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 {
  my ($src, $dest) = @_;
  print "moving \"$src\" to \"$dest\"\n";
  make_path(dirname($dest));
  move($src, $dest) || print STDERR "$src: $!\n";
}

sub win32_path_to_local {
  my ($volume, $dir, $file) = File::Spec::Win32->splitpath($_[0]) ;
  my @dirs = File::Spec::Win32->splitdir($dir);
  shift @dirs if @dirs > 0 && $dirs[0] eq ''; # remove leading slash
  return File::Spec->catfile(@dirs, $file);
}

# 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";

    # STRINGS section
    my @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];
    }

    # DIRS section
    my @dirs;
    seek FH, $hdr[19], 0;
    for (1 .. $hdr[13]) {
	read FH, $x, 4;
	my ($id, $len) = unpack 'vv', $x;
	read FH, $x, $len; chop $x; chop $x;
	$dirs[$id] = join '\\', map {$strs[$_]} unpack 'v*', $x;
	$dirs[$id] =~ s/%CE(\d+)%/$ce[$1]/eg;
    }

    # FILES section
    seek FH, $hdr[20], 0;
    for (1 .. $hdr[14]) {
      # read a FILES entry
      read FH, $x, 12;
      my ($id, $dirid, $unk, $flags, $len) = unpack 'vvvVv',$x;
      read FH, $x, $len; chop $x;

      # get file with decimal extension, rename it to dir and
      # filename given in FILES entry
      rename_file(get_fname($id), win32_path_to_local("$dirs[$dirid]\\$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 @hives;
      my $lasthive = -1;

      # 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";
}
