update exetype.pl tool

p4raw-id: //depot/perl@5094

diff --git a/win32/Makefile b/win32/Makefile
index 6bf5e6e..774e18b 100644 (file)
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -471,6 +471,7 @@ UTILS               =                       \
                ..\pod\podselect        \
                ..\x2p\find2perl        \
                ..\x2p\s2p              \
+               bin\exetype.pl          \
                bin\runperl.pl          \
                bin\pl2bat.pl           \
                bin\perlglob.pl         \

diff --git a/win32/bin/exetype.pl b/win32/bin/exetype.pl
index 5846b3e..27e3b94 100644 (file)
--- a/win32/bin/exetype.pl
+++ b/win32/bin/exetype.pl
@@ -1,26 +1,60 @@
 #!perl -w
 use strict;
-unless (@ARGV == 2) {
-    print "Usage: $0 exefile [CONSOLE|WINDOWS]\n";
+
+# All the IMAGE_* structures are defined in the WINNT.H file
+# of the Microsoft Platform SDK.
+
+my %subsys = (NATIVE    => 1,
+              WINDOWS   => 2,
+              CONSOLE   => 3,
+              POSIX     => 7,
+              WINDOWSCE => 9);
+
+unless (0 < @ARGV && @ARGV < 3) {
+    printf "Usage: $0 exefile [%s]\n", join '|', sort keys %subsys;
     exit;
 }
-unless ($ARGV[1] =~ /^(console|windows)$/i) {
-    print "Invalid subsystem $ARGV[1], please use CONSOLE or WINDOWS\n";
+
+$ARGV[1] = uc $ARGV[1] if $ARGV[1];
+unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) {
+    (my $subsys = join(', ', sort keys %subsys)) =~ s/, (\w+)$/ or $1/;
+    print "Invalid subsystem $ARGV[1], please use $subsys\n";
     exit;
 }
-my ($record,$magic,$offset,$size);
-open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!";
+
+my ($record,$magic,$signature,$offset,$size);
+open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
 binmode EXE;
-read EXE, $record, 32*4;
+
+# read IMAGE_DOS_HEADER structure
+read EXE, $record, 64;
 ($magic,$offset) = unpack "Sx58L", $record;
-die "Not an MSDOS executable file" unless $magic == 0x5a4d;
+
+die "$ARGV[0] is not an MSDOS executable file.\n"
+    unless $magic == 0x5a4d; # "MZ"
+
+# read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
 seek EXE, $offset, 0;
-read EXE, $record, 24;
-($magic,$size) = unpack "Lx16S", $record;
-die "PE header not found" unless $magic == 0x4550;
-die "Optional header not in NT32 format" unless $size == 224;
-seek EXE, $offset+24+68, 0;
-print EXE pack "S", uc($ARGV[1]) eq 'CONSOLE' ? 3 : 2;
+read EXE, $record, 4+20+2;
+($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
+
+die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
+
+die "Optional header is neither in NT32 nor in NT64 format"
+    unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC
+           ($size == 240 && $magic == 0x20b);   # IMAGE_NT_OPTIONAL_HDR64_MAGIC
+
+# Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
+seek EXE, $offset+4+20+68, 0;
+if (@ARGV == 1) {
+    read EXE, $record, 2;
+    my ($subsys) = unpack "S", $record;
+    $subsys = {reverse %subsys}->{$subsys} || "UNKNOWN($subsys)";
+    print "$ARGV[0] uses the $subsys subsystem.\n";
+}
+else {
+    print EXE pack "S", $subsys{$ARGV[1]};
+}
 close EXE;
 __END__
 
@@ -52,6 +86,19 @@ use a console supplied by the operating system.
 The WINDOWS subsystem handles an application that does not require a
 console and creates its own windows, if required.
 
+=item NATIVE
+
+The NATIVE subsystem handles a Windows NT device driver.
+
+=item WINDOWSCE
+
+The WINDOWSCE subsystem handles Windows CE consumer electronics
+applications.
+
+=item POSIX
+
+The POSIX subsystem handles a POSIX application in Windows NT.
+
 =back
 
 =head1 AUTHOR

diff --git a/win32/makefile.mk b/win32/makefile.mk
index 64f89fd..5e8a3ef 100644 (file)
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -576,6 +576,7 @@ UTILS               =                       \
                ..\pod\podselect        \
                ..\x2p\find2perl        \
                ..\x2p\s2p              \
+               bin\exetype.pl          \
                bin\runperl.pl          \
                bin\pl2bat.pl           \
                bin\perlglob.pl         \