Index: myldr/boot.c =================================================================== --- myldr/boot.c (revision 1335) +++ myldr/boot.c (working copy) @@ -1,5 +1,6 @@ #undef readdir +#include #include typedef struct my_chunk @@ -27,7 +28,7 @@ #endif /* Note: these two defines must be negative so as not to collide with - * real file descriptor */ + * any real file descriptor */ #define MKFILE_ERROR (-1) #define MKFILE_ALREADY_EXISTS (-2) @@ -59,12 +60,47 @@ int _CRT_glob = 0; #endif +#ifdef WIN32 +#define unpack_S(p) (*(WORD*)(p)) +#define unpack_L(p) (*(DWORD*)(p)) + +#define ASSERT(expr, msg) if (!(expr)) fprintf(stderr, "assertion failed: %s\n", msg) + +/* seek file descriptor fd to member Subsystem (a WORD) of the + * IMAGE_OPTIONAL_HEADER structure of a Windows executable + * (so that the next 2 bytes read/written from/to fd get/set Subsystem); + * cf. sub _fix_console in PAR/Packer.pm + */ +void seek_to_subsystem( int fd ) { + BYTE buf[64]; + DWORD off; + WORD size, magic; + + lseek(fd, 0, SEEK_SET); // CHECK != -1 + read(fd, buf, 64); // CHECK == 64 + ASSERT(unpack_S(buf) == 0x5a4d, "MZ magic bytes"); // "MZ" + off = unpack_L(buf+60); + + lseek(fd, off, SEEK_SET); // CHECK != -1 + read(fd, buf, 4 + 20 + 2); // CHECK == 4 + 20 + 2 + ASSERT(unpack_L(buf) == 0x4550, "PE header"); // "PE\0\0" + size = unpack_S(buf+20); + magic = unpack_S(buf+24); + ASSERT(( size == 224 && magic == 0x10b ) + || ( size == 240 && magic == 0x20b ), "IMAGE_NT_OPTIONAL_HDR_MAGIC"); + + lseek(fd, off + 4 + 20 + 68, SEEK_SET); // CHECK != -1 +} +#endif + + int main ( int argc, char **argv, char **env ) { int i; char *stmpdir; char *my_file; char *my_perl; + char *my_prog; char buf[20]; /* must be large enough to hold "PAR_ARGV_###" */ #ifdef WIN32 typedef BOOL (WINAPI *pALLOW)(DWORD); @@ -90,14 +126,14 @@ /* extract custom Perl interpreter into stmpdir (but under the same basename as argv[0]) */ - i = my_mkfile( argv[0], - stmpdir, par_basename(par_findprog(argv[0], strdup(par_getenv("PATH")))), - size_load_my_par, &my_perl ); + my_prog = par_findprog(argv[0], strdup(par_getenv("PATH"))); + i = my_mkfile( argv[0], stmpdir, par_basename(my_prog), size_load_my_par, &my_perl ); if ( i != MKFILE_ALREADY_EXISTS ) { if ( i == MKFILE_ERROR ) DIE; if ( write_chunks(i, chunks_load_my_par) == -1 ) DIE; if ( close(i) == -1 ) DIE; chmod(my_perl, 0755); + #ifdef __hpux { /* HPUX will only honour SHLIB_PATH if the executable is specially marked */ @@ -106,6 +142,27 @@ system(chatr_cmd); } #endif +#ifdef WIN32 + { + /* copy IMAGE_OPTIONAL_HEADER.Subsystem (GUI vs console) + * from this executable to the just extracted my_perl + */ + int fd; + WORD subsystem; + + fd = open(my_prog, O_RDONLY | OPEN_O_BINARY, 0755); + ASSERT(fd != -1, "open my_prog"); + seek_to_subsystem(fd); + read(fd, &subsystem, 2); // CHECK == 2 + close(fd); // CHECK != -1 + + fd = open(my_perl, O_RDWR | OPEN_O_BINARY, 0755); + ASSERT(fd != -1, "open my_perl"); + seek_to_subsystem(fd); + write(fd, &subsystem, 2); // CHECK == 2 + close(fd); // CHECK != -1 + } +#endif } /* extract libperl DLL into stmpdir */ @@ -159,3 +216,4 @@ DIE; #endif } + Index: lib/PAR/Packer.pm =================================================================== --- lib/PAR/Packer.pm (revision 1335) +++ lib/PAR/Packer.pm (working copy) @@ -1309,34 +1309,6 @@ } -sub _fix_console { - my ($self) = @_; - - my $opt = $self->{options}; - my $output = $self->{output}; - my $dynperl = $self->{dynperl}; - - return unless $opt->{g}; - - $self->_vprint(1, "Fixing $output to remove its console window"); - $self->_strip_console($output); - - if ($dynperl and !$opt->{d}) { - # we have a static.exe that needs taking care of. - my $buf; - my $fh = $self->_open($self->{orig_parl} || $self->{parl}); - seek $fh, -8, 2; - read $fh, $buf, 8; - die unless $buf eq "\nPAR.pm\n"; - seek $fh, -12, 2; - read $fh, $buf, 4; - seek $fh, -12 - unpack("N", $buf) - 4, 2; - read $fh, $buf, 4; - close $fh; - $self->_strip_console($output, unpack("N", $buf)); - } -} - sub _move_parl { my ($self) = @_; @@ -1408,26 +1380,32 @@ system($parl, @args); } -sub _strip_console { - my $self = shift; - my $file = shift; - my $preoff = shift || 0; +sub _fix_console { + my ($self) = @_; + my $opt = $self->{options}; + my $output = $self->{output}; + my $dynperl = $self->{dynperl}; + + return unless $opt->{g}; + + $self->_vprint(1, "Fixing $output to remove its console window"); + my ($record, $magic, $signature, $offset, $size); - my $exe = $self->_open('+<', $file); + my $exe = $self->_open('+<', $output); binmode $exe; - seek $exe, $preoff, 0; + seek $exe, 0, 0; # read IMAGE_DOS_HEADER structure read $exe, $record, 64; ($magic, $offset) = unpack "Sx58L", $record; - die "$file is not an MSDOS executable file.\n" + die "$output 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, $preoff + $offset, 0; + seek $exe, $offset, 0; read $exe, $record, 4 + 20 + 2; ($signature, $size, $magic) = unpack "Lx16Sx2S", $record; @@ -1440,7 +1418,7 @@ ($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, $preoff + $offset + 4 + 20 + 68, 0; + seek $exe, $offset + 4 + 20 + 68, 0; print $exe pack "S", 2; # IMAGE_WINDOWS close $exe; }