#! perl # Fake a PE/COFF header, forcing Windows to load and interpret a perl script, # better than pl2bat # Copyright 2005 John Tobey open IN, (my $name = shift) or die "Syntax: pl2exe.pl file.pl\n"; $name =~ s/\.pl$//; $name .= '.exe'; open (OUT, ">$name") or die "can\'t write to $name: $!\n"; binmode OUT; # because we want to be in control print OUT "MZ(<<'EXE_STUFF') # -*-Perl-*-\015\012"; print OUT "Here comes offset 60 .....\015\012"; # The DWORD at offset 60 holds the offset of the IMAGE_NT_HEADERS struct. # This stuff is in winnt.h. print OUT pack ("L", 64); my $code_size = 512; # actually the size of the entire # code section, which in this case contains # data as well; rounded up to a multiple of 512 # Construct the IMAGE_NT_HEADERS structure. my $headers = "PE\0\0"; # Portable Executable signature $headers .= pack ('SSLLLSS', # the IMAGE_FILE_HEADER substructure 0x14c, # for Intel I386 or later, and compatible 1, # number of sections 0x4d5a83be, # time-date stamp when we created the exe (TODO) 0,0, # symbols pointer, # symbols 224, # size of the IMAGE_OPTIONAL_HEADER 0x010f # random flags: 0xa18e(?) for a DLL ); $headers .= pack ('SCCL9S6L4SSL6',# IMAGE_OPTIONAL_HEADERS substruct 0x010b, # Magic PE32 : normal 32-bit, 0x0107 would be a ROM image 1,0, # linker version maj.min (that's us) $code_size, 0,0, # size of initialized/un- data 0x1000, # RVA of entry point # (the RVA is the address when loaded, # relative to the image base) 0x1000, # RVA of start of code section 0, # RVA of data section, if there were one 0x400000, # image base 0x1000, # section alignment 512, # file alignment 4, 0, # OS version maj.min 0, 0, # Image version 4, 0, # Subsystem version 0, # reserved1 zero 0x2000, # size of image 512, # size of headers 0, # checksum; ignored 3, # Subsystem 3=console app; 2=GUI app 0, # DLL characteristics (obsolete) 0x1000, # size of stack reserve 0x1000, # size of stack commit 0x100000, # size of heap reserve 0, # size of heap commit 0, # loader flags (obsolete) 16 # the number or RVA/size pairs to follow ); # DATA directory (16) $headers .= pack ('L32', # 16 (RVA,size) pairs locating certain # important image structures; the ones # we don't have are left zero 0,0, # export directory 0x1100, 195, # import directory 0,0, # resource directory 0,0, # exception table 0,0, # security table 0x10f8, 8, # base relocation table (empty, but needed) 0,0, # debug 0,0, # architecture specific data 0,0, # global pointer 0,0, # TLS dir 0,0, # load config table 0,0, # bound import table 0,0, # import address table 0,0, # delay import descriptor 0,0, # COM descriptor 0,0 # unused ); print OUT $headers; # SECTION TABLE, We need to describe our one section. my $section_header = pack ('a8L8', '.perl', # section name 464, # raw data size 0x1000, # section begin RVA 512, # rounded-up data size 512, # offset in file 0,0,0, # relocations, line # offs, line #s 0xe0000060, # flags: CODE INITIALIZED_DATA EXECUTE READ WRITE ALIGN_DEFAULT(16) ); print OUT $section_header; print OUT "\015\012\015\012"; print OUT "-------------that was the IMAGE_NT_HEADERS struct-------------"; print OUT "\015\012------------------------\015\012"; print OUT "--------Now comes the code (at offset 512, if you please)-----"; print OUT "\015\012\015\012"; # Next comes the code. # It performs fixups, prepends "perl -x " to the command line, # launches perl, and returns perl's exit status. See at the end. print OUT pack ("H*", "b8cc114000833dcc1140000074168b1085d27d06"); print OUT pack ("H*", "01500483c004ff0283c00483380075eaa1481140"); print OUT pack ("H*", "00ffd089c389c731c0b9f7fffffffcf2ae89f829"); print OUT pack ("H*", "d883e1fc01ccbec311400089e7b908000000f3a4"); print OUT pack ("H*", "89de89c1f3a489e383ec7cb91b00000089e731c0"); print OUT pack ("H*", "f3ab895c2404c74424284400000089e083c02889"); print OUT pack ("H*", "44242083c04489442424a140114000ffd021c075"); print OUT pack ("H*", "046a64eb258b4424446aff50a14c114000ffd021"); print OUT pack ("H*", "c074046a65eb0f8b4424446a665450a150114000"); print OUT pack ("H*", "ffd0a144114000ffd0"); print OUT "\015\012\015\012"; print OUT "-------here's the data, at file offset 760: -------"; print OUT "\015\012\015\012"; # Print out a dummy relocation table. # The code is not relocatable--it must be loaded at 0x400000. # But to allow programs to load it with LoadLibrary() and access # its resources, the file must contain this table. print OUT pack ('LL', 0x1000,8); # The import table. Contains RVAs and names. # (we import 5 functions from KERNEL32.DLL) print OUT pack ('L5', 0x1128, # (unbound IAT) 0, # TimeDateStamp 0, # ForwarderChain 0x1158, # DLL Name RVA 0x1140);# Import Address Table RVA print OUT pack ('L5', 0,0,0,0,0); # Ordinals of our KERNEL32 names, 0=unused print OUT pack ('L6', 0x1166, 0x1178, 0x1186, 0x1198, 0x11ae, 0); # Not sure if we really need to do this twice, but why argue: print OUT pack ('L6', 0x1166, 0x1178, 0x1186, 0x1198, 0x11ae, 0); # Gee it would be nice if C knew how to align things... print OUT "KERNEL32.DLL\0\0"; print OUT "\0\0CreateProcessA\0\0"; # 1140 print OUT "\0\0ExitProcess\0"; # 1144 print OUT "\0\0GetCommandLineA\0"; # 1148 print OUT "\0\0WaitForSingleObject\0"; # 114c print OUT "\0\0GetExitCodeProcess\0"; # 1150 # Our initialized data: print OUT "perl -x \0"; # 11c3 # align 4 print OUT pack ('L*', 0); # Let Perl know we're done. We no longer care about CRLF. print OUT "\nEXE_STUFF\nif 0;\n\n"; $_ = ; unless ($_ =~ /^\#!.*perl/ ) { print OUT "#!perl\n"; } print OUT $_, ; close IN; close OUT; chmod 0755, $name; __END__ =pod # base: 401000 objdump -D --target=binary --architecture i386 $code 0: b8 cc 11 40 00 mov $0x4011cc,%eax 5: 83 3d cc 11 40 00 00 cmpl $0x0,0x4011cc c: 74 16 je 0x24 e: 8b 10 mov (%eax),%edx 10: 85 d2 test %edx,%edx 12: 7d 06 jge 0x1a 14: 01 50 04 add %edx,0x4(%eax) 17: 83 c0 04 add $0x4,%eax 1a: ff 02 incl (%edx) 1c: 83 c0 04 add $0x4,%eax 1f: 83 38 00 cmpl $0x0,(%eax) 22: 75 ea jne 0xe 24: a1 48 11 40 00 mov 0x401148,%eax 29: ff d0 call *%eax ; GetCommandLineA 2b: 89 c3 mov %eax,%ebx 2d: 89 c7 mov %eax,%edi 2f: 31 c0 xor %eax,%eax 31: b9 f7 ff ff ff mov $0xfffffff7,%ecx 36: fc cld 37: f2 ae repnz scas %es:(%edi),%al 39: 89 f8 mov %edi,%eax 3b: 29 d8 sub %ebx,%eax 3d: 83 e1 fc and $0xfffffffc,%ecx 40: 01 cc add %ecx,%esp 42: be c3 11 40 00 mov $0x4011c3,%esi ; prepend 'perl -x ' 47: 89 e7 mov %esp,%edi 49: b9 08 00 00 00 mov $0x8,%ecx 4e: f3 a4 rep movsb %ds:(%esi),%es:(%edi) 50: 89 de mov %ebx,%esi 52: 89 c1 mov %eax,%ecx 54: f3 a4 rep movsb %ds:(%esi),%es:(%edi) 56: 89 e3 mov %esp,%ebx 58: 83 ec 7c sub $0x7c,%esp 5b: b9 1b 00 00 00 mov $0x1b,%ecx 60: 89 e7 mov %esp,%edi 62: 31 c0 xor %eax,%eax 64: f3 ab rep stos %eax,%es:(%edi) 66: 89 5c 24 04 mov %ebx,0x4(%esp) 6a: c7 44 24 28 44 00 00 movl $0x44,0x28(%esp) 71: 00 72: 89 e0 mov %esp,%eax 74: 83 c0 28 add $0x28,%eax 77: 89 44 24 20 mov %eax,0x20(%esp) 7b: 83 c0 44 add $0x44,%eax 7e: 89 44 24 24 mov %eax,0x24(%esp) 82: a1 40 11 40 00 mov 0x401140,%eax 87: ff d0 call *%eax ; if (!CreateProcessA) 89: 21 c0 and %eax,%eax 8b: 75 04 jne 0x91 8d: 6a 64 push $0x64 8f: eb 25 jmp 0xb6 ; abnormal exit 91: 8b 44 24 44 mov 0x44(%esp),%eax ; else 95: 6a ff push $0xffffffff 97: 50 push %eax 98: a1 4c 11 40 00 mov 0x40114c,%eax 9d: ff d0 call *%eax ; if (!WaitForSingleObject) 9f: 21 c0 and %eax,%eax a1: 74 04 je 0xa7 a3: 6a 65 push $0x65 a5: eb 0f jmp 0xb6 ; abnormal exit a7: 8b 44 24 44 mov 0x44(%esp),%eax ; else ab: 6a 66 push $0x66 ; exit with child code ad: 54 push %esp ae: 50 push %eax af: a1 50 11 40 00 mov 0x401150,%eax b4: ff d0 call *%eax ; GetExitCodeProcess b6: a1 44 11 40 00 mov 0x401144,%eax bb: ff d0 call *%eax ; ExitProcess =cut