pl2exe.pl 9.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242
  1. #! perl
  2. # Fake a PE/COFF header, forcing Windows to load and interpret a perl script,
  3. # better than pl2bat
  4. # Copyright 2005 John Tobey <jtobey@john-edwin-tobey.org>
  5. open IN, (my $name = shift) or die "Syntax: pl2exe.pl file.pl\n";
  6. $name =~ s/\.pl$//;
  7. $name .= '.exe';
  8. open (OUT, ">$name") or die "can\'t write to $name: $!\n";
  9. binmode OUT; # because we want to be in control
  10. print OUT "MZ(<<'EXE_STUFF') # -*-Perl-*-\015\012";
  11. print OUT "Here comes offset 60 .....\015\012";
  12. # The DWORD at offset 60 holds the offset of the IMAGE_NT_HEADERS struct.
  13. # This stuff is in winnt.h.
  14. print OUT pack ("L", 64);
  15. my $code_size = 512; # actually the size of the entire
  16. # code section, which in this case contains
  17. # data as well; rounded up to a multiple of 512
  18. # Construct the IMAGE_NT_HEADERS structure.
  19. my $headers = "PE\0\0"; # Portable Executable signature
  20. $headers .= pack ('SSLLLSS', # the IMAGE_FILE_HEADER substructure
  21. 0x14c, # for Intel I386 or later, and compatible
  22. 1, # number of sections
  23. 0x4d5a83be, # time-date stamp when we created the exe (TODO)
  24. 0,0, # symbols pointer, # symbols
  25. 224, # size of the IMAGE_OPTIONAL_HEADER
  26. 0x010f # random flags: 0xa18e(?) for a DLL
  27. );
  28. $headers .= pack ('SCCL9S6L4SSL6',# IMAGE_OPTIONAL_HEADERS substruct
  29. 0x010b, # Magic PE32 : normal 32-bit, 0x0107 would be a ROM image
  30. 1,0, # linker version maj.min (that's us)
  31. $code_size,
  32. 0,0, # size of initialized/un- data
  33. 0x1000, # RVA of entry point
  34. # (the RVA is the address when loaded,
  35. # relative to the image base)
  36. 0x1000, # RVA of start of code section
  37. 0, # RVA of data section, if there were one
  38. 0x400000, # image base
  39. 0x1000, # section alignment
  40. 512, # file alignment
  41. 4, 0, # OS version maj.min
  42. 0, 0, # Image version
  43. 4, 0, # Subsystem version
  44. 0, # reserved1 zero
  45. 0x2000, # size of image
  46. 512, # size of headers
  47. 0, # checksum; ignored
  48. 3, # Subsystem 3=console app; 2=GUI app
  49. 0, # DLL characteristics (obsolete)
  50. 0x1000, # size of stack reserve
  51. 0x1000, # size of stack commit
  52. 0x100000, # size of heap reserve
  53. 0, # size of heap commit
  54. 0, # loader flags (obsolete)
  55. 16 # the number or RVA/size pairs to follow
  56. );
  57. # DATA directory (16)
  58. $headers .= pack ('L32', # 16 (RVA,size) pairs locating certain
  59. # important image structures; the ones
  60. # we don't have are left zero
  61. 0,0, # export directory
  62. 0x1100, 195, # import directory
  63. 0,0, # resource directory
  64. 0,0, # exception table
  65. 0,0, # security table
  66. 0x10f8, 8, # base relocation table (empty, but needed)
  67. 0,0, # debug
  68. 0,0, # architecture specific data
  69. 0,0, # global pointer
  70. 0,0, # TLS dir
  71. 0,0, # load config table
  72. 0,0, # bound import table
  73. 0,0, # import address table
  74. 0,0, # delay import descriptor
  75. 0,0, # COM descriptor
  76. 0,0 # unused
  77. );
  78. print OUT $headers;
  79. # SECTION TABLE, We need to describe our one section.
  80. my $section_header = pack ('a8L8',
  81. '.perl', # section name
  82. 464, # raw data size
  83. 0x1000, # section begin RVA
  84. 512, # rounded-up data size
  85. 512, # offset in file
  86. 0,0,0, # relocations, line # offs, line #s
  87. 0xe0000060, # flags: CODE INITIALIZED_DATA EXECUTE READ WRITE ALIGN_DEFAULT(16)
  88. );
  89. print OUT $section_header;
  90. print OUT "\015\012\015\012";
  91. print OUT "-------------that was the IMAGE_NT_HEADERS struct-------------";
  92. print OUT "\015\012------------------------\015\012";
  93. print OUT "--------Now comes the code (at offset 512, if you please)-----";
  94. print OUT "\015\012\015\012";
  95. # Next comes the code.
  96. # It performs fixups, prepends "perl -x " to the command line,
  97. # launches perl, and returns perl's exit status. See at the end.
  98. print OUT pack ("H*", "b8cc114000833dcc1140000074168b1085d27d06");
  99. print OUT pack ("H*", "01500483c004ff0283c00483380075eaa1481140");
  100. print OUT pack ("H*", "00ffd089c389c731c0b9f7fffffffcf2ae89f829");
  101. print OUT pack ("H*", "d883e1fc01ccbec311400089e7b908000000f3a4");
  102. print OUT pack ("H*", "89de89c1f3a489e383ec7cb91b00000089e731c0");
  103. print OUT pack ("H*", "f3ab895c2404c74424284400000089e083c02889");
  104. print OUT pack ("H*", "44242083c04489442424a140114000ffd021c075");
  105. print OUT pack ("H*", "046a64eb258b4424446aff50a14c114000ffd021");
  106. print OUT pack ("H*", "c074046a65eb0f8b4424446a665450a150114000");
  107. print OUT pack ("H*", "ffd0a144114000ffd0");
  108. print OUT "\015\012\015\012";
  109. print OUT "-------here's the data, at file offset 760: -------";
  110. print OUT "\015\012\015\012";
  111. # Print out a dummy relocation table.
  112. # The code is not relocatable--it must be loaded at 0x400000.
  113. # But to allow programs to load it with LoadLibrary() and access
  114. # its resources, the file must contain this table.
  115. print OUT pack ('LL', 0x1000,8);
  116. # The import table. Contains RVAs and names.
  117. # (we import 5 functions from KERNEL32.DLL)
  118. print OUT pack ('L5', 0x1128, # (unbound IAT)
  119. 0, # TimeDateStamp
  120. 0, # ForwarderChain
  121. 0x1158, # DLL Name RVA
  122. 0x1140);# Import Address Table RVA
  123. print OUT pack ('L5', 0,0,0,0,0); # Ordinals of our KERNEL32 names, 0=unused
  124. print OUT pack ('L6', 0x1166, 0x1178, 0x1186, 0x1198, 0x11ae, 0);
  125. # Not sure if we really need to do this twice, but why argue:
  126. print OUT pack ('L6', 0x1166, 0x1178, 0x1186, 0x1198, 0x11ae, 0);
  127. # Gee it would be nice if C<pack> knew how to align things...
  128. print OUT "KERNEL32.DLL\0\0";
  129. print OUT "\0\0CreateProcessA\0\0"; # 1140
  130. print OUT "\0\0ExitProcess\0"; # 1144
  131. print OUT "\0\0GetCommandLineA\0"; # 1148
  132. print OUT "\0\0WaitForSingleObject\0"; # 114c
  133. print OUT "\0\0GetExitCodeProcess\0"; # 1150
  134. # Our initialized data:
  135. print OUT "perl -x \0"; # 11c3
  136. # align 4
  137. print OUT pack ('L*', 0);
  138. # Let Perl know we're done. We no longer care about CRLF.
  139. print OUT "\nEXE_STUFF\nif 0;\n\n";
  140. $_ = <IN>;
  141. unless ($_ =~ /^\#!.*perl/ ) {
  142. print OUT "#!perl\n";
  143. }
  144. print OUT $_, <IN>;
  145. close IN;
  146. close OUT;
  147. chmod 0755, $name;
  148. __END__
  149. =pod
  150. # base: 401000
  151. objdump -D --target=binary --architecture i386 $code
  152. 0: b8 cc 11 40 00 mov $0x4011cc,%eax
  153. 5: 83 3d cc 11 40 00 00 cmpl $0x0,0x4011cc
  154. c: 74 16 je 0x24
  155. e: 8b 10 mov (%eax),%edx
  156. 10: 85 d2 test %edx,%edx
  157. 12: 7d 06 jge 0x1a
  158. 14: 01 50 04 add %edx,0x4(%eax)
  159. 17: 83 c0 04 add $0x4,%eax
  160. 1a: ff 02 incl (%edx)
  161. 1c: 83 c0 04 add $0x4,%eax
  162. 1f: 83 38 00 cmpl $0x0,(%eax)
  163. 22: 75 ea jne 0xe
  164. 24: a1 48 11 40 00 mov 0x401148,%eax
  165. 29: ff d0 call *%eax ; GetCommandLineA
  166. 2b: 89 c3 mov %eax,%ebx
  167. 2d: 89 c7 mov %eax,%edi
  168. 2f: 31 c0 xor %eax,%eax
  169. 31: b9 f7 ff ff ff mov $0xfffffff7,%ecx
  170. 36: fc cld
  171. 37: f2 ae repnz scas %es:(%edi),%al
  172. 39: 89 f8 mov %edi,%eax
  173. 3b: 29 d8 sub %ebx,%eax
  174. 3d: 83 e1 fc and $0xfffffffc,%ecx
  175. 40: 01 cc add %ecx,%esp
  176. 42: be c3 11 40 00 mov $0x4011c3,%esi ; prepend 'perl -x '
  177. 47: 89 e7 mov %esp,%edi
  178. 49: b9 08 00 00 00 mov $0x8,%ecx
  179. 4e: f3 a4 rep movsb %ds:(%esi),%es:(%edi)
  180. 50: 89 de mov %ebx,%esi
  181. 52: 89 c1 mov %eax,%ecx
  182. 54: f3 a4 rep movsb %ds:(%esi),%es:(%edi)
  183. 56: 89 e3 mov %esp,%ebx
  184. 58: 83 ec 7c sub $0x7c,%esp
  185. 5b: b9 1b 00 00 00 mov $0x1b,%ecx
  186. 60: 89 e7 mov %esp,%edi
  187. 62: 31 c0 xor %eax,%eax
  188. 64: f3 ab rep stos %eax,%es:(%edi)
  189. 66: 89 5c 24 04 mov %ebx,0x4(%esp)
  190. 6a: c7 44 24 28 44 00 00 movl $0x44,0x28(%esp)
  191. 71: 00
  192. 72: 89 e0 mov %esp,%eax
  193. 74: 83 c0 28 add $0x28,%eax
  194. 77: 89 44 24 20 mov %eax,0x20(%esp)
  195. 7b: 83 c0 44 add $0x44,%eax
  196. 7e: 89 44 24 24 mov %eax,0x24(%esp)
  197. 82: a1 40 11 40 00 mov 0x401140,%eax
  198. 87: ff d0 call *%eax ; if (!CreateProcessA)
  199. 89: 21 c0 and %eax,%eax
  200. 8b: 75 04 jne 0x91
  201. 8d: 6a 64 push $0x64
  202. 8f: eb 25 jmp 0xb6 ; abnormal exit
  203. 91: 8b 44 24 44 mov 0x44(%esp),%eax ; else
  204. 95: 6a ff push $0xffffffff
  205. 97: 50 push %eax
  206. 98: a1 4c 11 40 00 mov 0x40114c,%eax
  207. 9d: ff d0 call *%eax ; if (!WaitForSingleObject)
  208. 9f: 21 c0 and %eax,%eax
  209. a1: 74 04 je 0xa7
  210. a3: 6a 65 push $0x65
  211. a5: eb 0f jmp 0xb6 ; abnormal exit
  212. a7: 8b 44 24 44 mov 0x44(%esp),%eax ; else
  213. ab: 6a 66 push $0x66 ; exit with child code
  214. ad: 54 push %esp
  215. ae: 50 push %eax
  216. af: a1 50 11 40 00 mov 0x401150,%eax
  217. b4: ff d0 call *%eax ; GetExitCodeProcess
  218. b6: a1 44 11 40 00 mov 0x401144,%eax
  219. bb: ff d0 call *%eax ; ExitProcess
  220. =cut