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