1#!/usr/bin/perl -w
2# this is complementary to the wince_cab_format.html file,
3# which gives a full description of all components
4use strict;
5
6my %arch = (
7    0     => 'none',
8    103   => 'SHx SH3',
9    104   => 'SHx SH4',
10    386   => 'Intel 386',
11    486   => 'Intel 486',
12    586   => 'Intel Pentium',
13    601   => 'PowerPC 601',
14    603   => 'PowerPC 603',
15    604   => 'PowerPC 604',
16    620   => 'PowerPC 620',
17    821   => 'Motorola 821',
18    0x720 => 'ARM 720',
19    0x820 => 'ARM 820',
20    0x920 => 'ARM 920',
21    0xA11 => 'StrongARM',
22    4000  => 'MIPS R4000',
23    10003 => 'Hitachi SH3',
24    10004 => 'Hitachi SH3E',
25    10005 => 'Hitachi SH4',
26    21064 => 'Alpha 21064',
27    70001 => 'ARM 7TDMI'
28);
29
30my @ce = (
31    undef,
32    '\Program Files',
33    '\Windows',
34    '\Windows\Desktop',
35    '\Windows\StartUp',
36    '\My Documents',
37    '\Program Files\Accessories',
38    '\Program Files\Communications',
39    '\Program Files\Games',
40    '\Program Files\Pocket Outlook',
41    '\Program Files\Office',
42    '\Windows\Programs',
43    '\Windows\Programs\Accessories',
44    '\Windows\Programs\Communications',
45    '\Windows\Programs\Games',
46    '\Windows\Fonts',
47    '\Windows\Recent',
48    '\Windows\Favorites'
49);
50
51my @hkeys = (
52    undef,
53    'HKEY_CLASSES_ROOT',
54    'HKEY_CURRENT_USER',
55    'HKEY_LOCAL_MACHINE',
56    'HKEY_USERS'
57);
58
59my @strings;
60
61sub seek_to {
62    seek FH, $_[0], 0;
63}
64
65sub read_data {
66    my $buf;
67    read FH, $buf, $_[0];
68    return $buf;
69}
70
71sub read_string {
72    my $str = read_data($_[0]);
73    $str =~ s/\000*$//;
74    return $str;
75}
76
77sub read_strings {
78    my @ids = unpack 'v*', read_data($_[0]);
79    pop @ids;
80    return map { $strings[$_] } @ids;
81}
82
83# replaces nulls with commas
84sub denull {
85    $_[0] =~ s/\000/,/g;
86    return $_[0];
87}
88
89for my $hdrfile (@ARGV) {
90    if (! open FH, '<', $hdrfile) {
91        warn "$hdrfile: $!\n";
92        next;
93    }
94
95    # read fixed-size header
96    my @hdr = unpack 'V12v6V6v8', read_data(100);
97    if ($hdr[0] != 0x4543534D) {
98        warn "$hdrfile: not a Windows CE install cabinet header\n";
99        close FH;
100        next;
101    }
102
103    # HEADER section
104    print "$hdrfile HEADER\n";
105    printf "  length       = %d bytes\n", $hdr[2];
106    printf "  architecture = %s (%d)\n", $arch{$hdr[5]} || 'unknown', $hdr[5];
107    printf "  counts       = %s\n", join ',', @hdr[12..17];
108    printf "  offsets      = %s\n", join ',', @hdr[18..23];
109    printf "  strings      = %s\n", join ',', @hdr[24..29];
110    printf "  unknowns     = %s\n", join ',', @hdr[1,3,4,30,31];
111    printf "  min WinCE v. = %d.%d%s\n", $hdr[6], $hdr[7], $hdr[10] ? " [build $hdr[10]]" : "";
112    printf "  max WinCE v. = %d.%d%s\n", $hdr[8], $hdr[9], $hdr[11] ? " [build $hdr[11]]" : "";
113
114    seek_to($hdr[24]) && printf "  app name     = %s\n", read_string($hdr[25]);
115    seek_to($hdr[26]) && printf "  provider     = %s\n", read_string($hdr[27]);
116    seek_to($hdr[28]) && printf "  unsupported  = %s\n", denull(read_string($hdr[29])) if $hdr[29];
117
118    # STRINGS section
119    print "$hdrfile STRINGS\n";
120    @strings = ();
121    seek_to($hdr[18]);
122    for (1 .. $hdr[12]) {
123        my ($id, $len) = unpack 'vv', read_data(4);
124        $strings[$id] = read_string($len);
125        printf "  s%02d: %s\n", $id, $strings[$id];
126    }
127
128    # DIRS section
129    print "$hdrfile DIRS\n";
130    my @dirs;
131    seek_to($hdr[19]);
132    for (1 .. $hdr[13]) {
133        my ($id, $len) = unpack 'vv', read_data(4);
134        $dirs[$id] = join '\\', read_strings($len);
135        $dirs[$id] =~ s/%CE(\d+)%/$ce[$1]/eg;
136        printf "  d%02d: %s\n", $id, $dirs[$id];
137    }
138
139    # FILES section
140    print "$hdrfile FILES\n";
141    my @files;
142    seek_to($hdr[20]);
143    for (1 .. $hdr[14]) {
144        my ($id, $dirid, $unk, $flags, $len) = unpack 'vvvVv', read_data(12);
145        $files[$id] = "$dirs[$dirid]\\" . read_string($len);
146        printf "  f%02d: %s\n", $id, $files[$id];
147        printf "       unknown=%d flags=0x%08x\n", $unk, $flags;
148    }
149
150    # REGHIVES section
151    print "$hdrfile REGHIVES\n";
152    my @reghives;
153    seek_to($hdr[21]);
154    for (1 .. $hdr[15]) {
155        my ($id, $root, $unk, $len) = unpack 'vvvv', read_data(8);
156        $reghives[$id] = join '\\', $hkeys[$root], read_strings($len);
157        printf "  h%02d: %s\n", $id, $reghives[$id], $unk;
158    }
159
160    # REGKEYS section
161    print "$hdrfile REGKEYS\n";
162    seek_to($hdr[22]);
163    for (1 .. $hdr[16]) {
164        my ($id, $hive, $subst, $flags, $len) = unpack 'vvvVv', read_data(12);
165        my $data = read_data($len);
166        my $name = $1 if $data =~ s/^([^\000]*)\000//; # data begins with key name
167
168        printf "  k%02d: hive=%s\n", $id, $reghives[$hive];
169        printf "       name=<<%s>> subst=%d flags=0x%08x\n", $name, $subst, $flags;
170
171        if (($flags & 0x10001) == 0x10001) {
172            my $dword = unpack 'V', $data;
173            printf "       [DWORD] %08x (%d)\n", $dword, $dword;;
174        }
175        elsif (($flags & 0x10001) == 0x10000) {
176            for my $sz (split /\000/, $data) {
177                printf "       [MULTI_SZ] <<%s>>\n", $sz
178            }
179        }
180        elsif (($flags & 0x10001) == 0x00001) {
181            printf "       [BINARY] (%d bytes hexdump follows)\n", length($data);
182            while ($data =~ /(.{1,12})/gs) {
183                my ($text, $hex) = ($1, unpack('h*', $1));
184                $hex =~ s/(.{8})/$1 /g; # space every 8 hexdigits
185                $text =~ s/[^[:print:]]/./g; # replace unprintables
186                printf "       %-28s%s\n", $hex, $text;
187            }
188        }
189        else {
190            chop $data; printf "       [SZ] %s\n", $data;
191        }
192    }
193
194    # LINKS section
195    print "$hdrfile LINKS\n";
196    my @links;
197    seek_to($hdr[23]);
198    for (1 .. $hdr[17]) {
199        my ($id, $unk, $dir, $fid, $type, $len) = unpack 'vvvvvv', read_data(12);
200        my $name = join '\\', read_strings($len);
201        my $dest = ($dir == 0) ? "%InstallDir%\\$name" :
202                   ($dir >  0) ? "$ce[$dir]\\$name" :
203                   $name;
204        my $src = ($type == 1) ? $files[$fid] :
205                  ($fid == 0) ? '%InstallDir%' :
206                  $dirs[$fid];
207        printf "  l%02d: src=<<%s>>\n", $id, $src;
208        printf "       dest=<<%s>>  (unk=%d)\n", $dest, $unk;
209    }
210
211    print "\n";
212    close FH;
213}
214