1#!/usr/bin/env perl
2
3my $quiet = 1;
4
5unpack("L",pack("N",1))!=1 || die "only little-endian hosts are supported";
6
7# first argument can specify custom suffix...
8$suffix=(@ARGV[0]=~/^\$/) ? shift(@ARGV) : "\$m";
9#################################################################
10# rename segments in COFF modules according to %map table below	#
11%map=(	".text" => "fipstx$suffix",				#
12	".text\$"=> "fipstx$suffix",				#
13	".rdata"=> "fipsrd$suffix",				#
14	".data" => "fipsda$suffix"	);			#
15#################################################################
16
17# collect file list
18foreach (@ARGV) {
19    if (/\*/)	{ push(@files,glob($_)); }
20    else	{ push(@files,$_);       }
21}
22
23use Fcntl;
24use Fcntl ":seek";
25
26foreach (@files) {
27    $file=$_;
28    print "processing $file\n" unless $quiet;
29
30    sysopen(FD,$file,O_RDWR|O_BINARY) || die "sysopen($file): $!";
31
32    # read IMAGE_DOS_HEADER
33    sysread(FD,$mz,64)==64 || die "$file is too short";
34    @dos_header=unpack("a2C58I",$mz);
35    if (@dos_header[0] eq "MZ") {
36	$e_lfanew=pop(@dos_header);
37	sysseek(FD,$e_lfanew,SEEK_SET)	|| die "$file is too short";
38	sysread(FD,$Magic,4)==4		|| die "$file is too short";
39	unpack("I",$Magic)==0x4550	|| die "$file is not COFF image";
40    } elsif ($file =~ /\.obj$/i) {
41	# .obj files have no IMAGE_DOS_HEADER
42	sysseek(FD,0,SEEK_SET)		|| die "unable to rewind $file";
43    } else { next; }
44
45    # read IMAGE_FILE_HEADER
46    sysread(FD,$coff,20)==20 || die "$file is too short";
47    ($Machine,$NumberOfSections,$TimeDateStamp,
48     $PointerToSymbolTable,$NumberOfSysmbols,
49     $SizeOfOptionalHeader,$Characteristics)=unpack("SSIIISS",$coff);
50
51    # skip over IMAGE_OPTIONAL_HEADER
52    sysseek(FD,$SizeOfOptionalHeader,SEEK_CUR) || die "$file is too short";
53
54    # traverse IMAGE_SECTION_HEADER table
55    for($i=0;$i<$NumberOfSections;$i++) {
56	sysread(FD,$SectionHeader,40)==40 || die "$file is too short";
57	($Name,@opaque)=unpack("Z8C*",$SectionHeader);
58	if ($map{$Name}) {
59	    sysseek(FD,-40,SEEK_CUR) || die "unable to rewind $file";
60	    syswrite(FD,pack("a8C*",$map{$Name},@opaque))==40 || die "syswrite failed: $!";
61	    printf "    %-8s -> %.8s\n",$Name,$map{$Name} unless $quiet;
62	}
63    }
64    close(FD);
65}
66