New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
win32: rebase and bind the core and all XS module dlls during build process #12370
Comments
From @bulk88Created by @bulk88TLDR, Win32 Perl needs to rebase and bind all its DLLs and EXE files during the build process and save alot of memory on Win32 and speed up process start up time very easily. In 729a02f a change was done to the VC makefile in win32/Makefile. This change was to avoid DLL relocation on windows to speed up Perl starting up. While the perl core dll (perl5**.dll) does not get relocated, all XS modules (which are DLLs in Win32 Perl) sit at the default 0x10000000. Perl 5.17.4 comes with the following DLLs on Win32 out of the box. The list was hand pruned to remove /site's DLLs. A 2nd way smaller way of decreasing the private memory usage of Perl images is to "bind" the EXEs and DLLs. That mean that the import table is prefilled with the function pointers of the functions to import, along with a CRC and timestamp of the exporting DLL, if the CRC and timestamp of the exporting DLL in the importer DLL match the exporting DLL on disk, no fixups are required. This reduces the private memory by 4KB (1 page) per EXE/DLL. This is highly Windows OS release and MS security fix specific. One strange thing about Visual C linker is, it merges the ".idata" section, which itself is marked as read/write in .lib files, into the ".rdata" section of the PE file. The ".idata" section contains the function pointer import table. This means, that unless a DLL is binded, 1 page of C const "read only" data is always unsharable since the DLL loaded will mark the page read write to do fixup the function pointers, then mark it back to read only, but now its unsharable with other Perl processes. This can be confirmed with VMMap on WinXP. Using the -merge option to VC linker to force the .idata section into .data (read write initialized data) where is rightfully belongs results in linker error LNK1272. An example of the bind command, note it is missing the winsxs specific directory of comctl32.dll V6 so perl5**.dll is not fully binadable I guess. bind� -p "C:\WINDOWS\system32;C:\perl517\bin"� -u "C:\perl517\bin\perl.exe" "C:\perl517\bin\perl517.dll" "C:\perl517\lib\auto\arybase\arybase.dll" ...... An example of the rebase command, rebase -b 0x70000000 -d� -R "." -G "C:/Documents and Settings/Owner/Desktop/p517dlls_to_rebase.txt" p517dlls_to_rebase.txt is newline separated dll names, like the list above. Both bind and rebase are MS command line tools included with Visual C/Platform SDK. I dont know if any of this ticket applies to Mingw Perl or not. I've heard rumors rebase has been discontinued for Windows 8's SDK, probably due to ASLR caching/interprocess sharing of relocated DLLs. A rebasing should be done atleast build time. Perhaps a bat file or a perl script can be written and installed to /bin so if a user has rebase and bind they can rebase all the DLLs in /lib and /site/lib to be neatly in order. The bind is most important since it is end user OS patch level specific. Of course the user would have to have bind and rebase in their PATH already and have a copy of paid Visual Studio or free Platform SDK. I'm not sure if there are any FOSS equivelents of rebase and bind, and whether they would be Perl license compatible. A fancier idea more complicated more unrealistic idea idea is to have ExtUtils::MakeMaker or Config.pm or IDK what keep a record on disk of the last used base address, and lower it or rebase the XS DLL to be just below the last known lowest base address on the last EUMM compiled module, each time a XS DLL is built, this way /site/lib XS modules are always rebased to not ever conflict and a manual tool or perl script does not have to be run on demand by the user to keep their /site/lib rebased and binded. Looking at ActivePerl 5.12.3 32 bit, none of the /lib XS DLLs are rebased, all of them are 0x10000000. I'm surprised nobody including AS ever thought of this before. These 2 ideas presented here can reduce accusations that Perl is a memory hog/slow startup/etc on Windows. I'm not sure how much impact on "Mem Usage" column in Task Manager these ideas will have, but the results will be measurable in Process Explorer and VMMap. I dont have the time to do anything about this idea right now or in the near future, so I'm creating this as a todo ticket for me in the future, or some other Win32 Perl dev to look at one day. Perl Info
|
From @tonycozOn Sat, Sep 01, 2012 at 07:59:22PM -0700, bulk 88 wrote:
There are Win32 API functions to rebase and bind images from XP http://msdn.microsoft.com/en-us/library/windows/desktop/aa363364%28v=vs.85%29.aspx http://msdn.microsoft.com/en-us/library/windows/desktop/ms679278%28v=vs.85%29.aspx Tony |
The RT System itself - Status changed from 'new' to 'open' |
From @bulk88On Sat Sep 01 20:38:14 2012, tonyc wrote:
I saw that, but I thought its best not to reinvent the wheel. MS's bind |
From @tonycozOn Sat, Sep 01, 2012 at 11:14:46PM -0700, bulk 88 via RT wrote:
Cygwin includes a GPL2 rebase tool, which uses ReBaseImage64. The tool can't be written using perl - since it needs write to the Tony |
From @bulk88On Sat Sep 01 19:59:21 2012, bulk88 wrote:
Adding a system 'pause' to the script after it loaded all the core DLLs (unrealistic, but this is testing), before Not bad at all in the extreme case. This is intended for Win32 parallel testing one day so more memory is shared and therefore saved between the same perl.exe processes+whatever benefit comes out of CPU cache. Now have a WIP patch. Added benchmarking. Quite noisy even though it runs for 5-10 mins (didnt count it precisely) each run. C:\perl521>perl bench.pl C:\perl521> C:\perl521> C:\perl521> There is also some more optimizing to do on a linker level. PL_ppaddr and PL_check and PL_magic_vtables and all the magic vtable structs themselves, plus the PIO thing slike PerlIO_remove, PerlIO_utf8, PerlIO_byte, PerlIO_raw, plus fcrypt.c is very polluting, SPtrans and skb and cov_2char and con_salt and shifts2 in fcrypt.c need to be RO (thats probably my next patch). So my question is, why are the magic vtables and PerlIO vtables non-const RW? I still need to test the patch on Win64 compiling 32 bit perl to make sure bind tool doesn't put the "defaults" to connect 32 bit perl DLLs to 64 bit OS DLLs (that will be silent error, since the DLL Loader will ignore the defaults if they aren't right). -- |
From @bulk880001-114704-WIP-add-rebase-and-bind-during-build-for-Win3.patchFrom 986b4f3edb056aa4ef658ed164cf8e2053456ada Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sat, 6 Dec 2014 18:17:46 -0500
Subject: [PATCH] #114704 WIP add rebase and bind during build for Win32 where
available
---
make_ext.pl | 37 +++++++++++++++++++++++++++++++++++++
1 files changed, 37 insertions(+), 0 deletions(-)
diff --git a/make_ext.pl b/make_ext.pl
index 12926f8..239234a 100644
--- a/make_ext.pl
+++ b/make_ext.pl
@@ -257,6 +257,43 @@ foreach my $spec (@extspec) {
[@pass_through, @{$extra_passthrough{$spec} || []}]);
}
+if(IS_WIN32 && $dynamic){
+ my $usage = `rebase 2>&1`;
+ my ($have_ms_rebase, $have_ms_bind, $files, @files);
+ #msysgit ships a rebase.exe, it might wind up in %path, feel free to add support
+ if(index($usage, 'usage: rebase -b BaseAddress') == 0){
+ warn "Warning non-MS rebase program not supported. Startup speeds will suffer.\n";
+ }
+ elsif(index($usage, 'usage: REBASE [switches]') == 0){
+ $have_ms_rebase = 1;
+ }
+ else{
+ warn "Warning no rebase program found. Startup speeds will suffer.\n";
+ }
+ $usage = `bind -? 2>&1`;
+ $have_ms_bind = 1 if index($usage, 'usage: BIND [switches] image-names...') == 0;
+ #I am not sure if there are any other "bind.exe"s in the world
+ warn "Warning no bind program found. Startup speeds will suffer.\n" unless $have_ms_bind;
+
+ if($have_ms_rebase || $have_ms_bind) {
+ $files = qx'dir /s /b *.dll';
+ @files = map {$_ !~ /(\\t\\perl5\d+
+ |lib\\auto\\Devel\\PPPort\\PPPort
+ |lib\\auto\\XS\\Typemap\\Typemap
+ |lib\\auto\\XS\\APItest\\APItest)
+ \.dll$/x ? $_ : ()} split("\n", $files);
+ $files = join(' ', @files);
+ }
+ system('rebase -b 0x28000000 '.$files) if $have_ms_rebase;
+#The bind tool saves (from page type private to shareable) usually 1 4KB
+#block containing the IAT in .rdata (RO) section of each DLL, verified with
+#VMMap. Why MS puts the IAT in .rdata instead of .data who knows. VC 2003
+#with "/MERGE:.idata=.data" causes
+#"LINK : fatal error LNK1272: cannot merge '.idata' with any section"
+#!!!!!!what happens on Win64? is bind a x64 exe when compiling x64? syswow64?
+ system('bind -u -p "..\;%SystemRoot%\system32" '.$files) if $have_ms_bind;
+}
+
sub build_extension {
my ($ext_dir, $perl, $mname, $target, $pass_through) = @_;
--
1.7.9.msysgit.0
|
From @bulk88Now with support for binding to SxS CRTs and the Win64 question is answered, 64 bit rebase tool finds 64 bit kernel32.dll. MS really didn't intend to support IAT binding with SxS. Figuring out the path of the CRT DLL was quite complicated. In this patch, to do a IAT bind, full perl and Win32 the module must be built, because of the xsub Win32::GetModuleFileName which I added. I could change Win32::GetCRTDllHandle to be Win32::GetCRTDllFileName and return a string, that way miniperl.exe can IAT bind itself on SxS VCs. Or I could add a plain C "--w32libc" option to generate_uudmap.c which prints the CRT path and miniperl gets it with backticks from generate_uudmap.exe since both were compiled with the same VC/same config. The problem with this script from my original goals in this ticket is, it doesn't run at XS module build time, it only runs at Perl engine build time. Maybe it should be extracted from make_ext.pl and go into /utils as "/utils/winprelink" or "/utils/plrebase" or "/utils/plrb" ("rb.pl" is what I've called it when running it outside of make_ext.pl). Cygwin has a unix shell script called "perlrebase" but is unusable on non-Cygwin Win32 perl. https://github.com/ajaxorg/cygwin-builds/blob/master/bin/perlrebase related reading: cygwin rebase.exe's readme http://www.tishler.net/jason/software/rebase/rebase-2.4.2.README -- |
From @bulk880001-114704-WIP-add-rebase-and-bind-during-build-for-Win3.patchFrom d1f6d3039581b3e7da1c81f7b867499b01de417b Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 25 Dec 2014 22:01:47 -0500
Subject: [PATCH] #114704 WIP add rebase and bind during build for Win32 where
available
---
MANIFEST | 3 +++
cpan/Win32/Win32.xs | 40 ++++++++++++++++++++++++++++
cpan/Win32/t/GetModuleFileName.t | 8 ++++++
make_ext.pl | 57 ++++++++++++++++++++++++++++++++++++++++
win32/Makefile | 40 +++++++++++++++++++++++-----
win32/ntdlldec.def | 3 +++
win32/ntdllundec.def | 3 +++
win32/win32.c | 41 +++++++++++++++++++++++++++++
8 files changed, 189 insertions(+), 6 deletions(-)
create mode 100644 cpan/Win32/t/GetModuleFileName.t
create mode 100644 win32/ntdlldec.def
create mode 100644 win32/ntdllundec.def
diff --git a/MANIFEST b/MANIFEST
index e781d3a..8aad139 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2867,6 +2867,7 @@ cpan/Win32/t/GetFileVersion.t See if Win32 extension works
cpan/Win32/t/GetFolderPath.t See if Win32 extension works
cpan/Win32/t/GetFullPathName.t See if Win32 extension works
cpan/Win32/t/GetLongPathName.t See if Win32 extension works
+cpan/Win32/t/GetModuleFileName.t See if Win32 extension works
cpan/Win32/t/GetOSName.t See if Win32 extension works
cpan/Win32/t/GetOSVersion.t See if Win32 extension works
cpan/Win32/t/GetShortPathName.t See if Win32 extension works
@@ -5635,6 +5636,8 @@ win32/list_static_libs.pl prints libraries for static linking
win32/Makefile Win32 makefile for NMAKE (Visual C++ build)
win32/Makefile.ce WinCE port
win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds)
+win32/ntdlldec.def Def for making a decorated symbol ntdll.lib
+win32/ntdllundec.def Def for making a undecorated symbol ntdll.lib
win32/perlexe.ico perlexe.ico image file
win32/perlexe.manifest Assembly manifest file
win32/perlexe.rc associated perl binary with icon
diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs
index b47df40..a5d6c6a 100644
--- a/cpan/Win32/Win32.xs
+++ b/cpan/Win32/Win32.xs
@@ -732,6 +732,45 @@ XS(w32_FreeLibrary)
XSRETURN_NO;
}
+XS(w32_GetModuleFileName)
+{
+ dXSARGS;
+ dXSTARG;
+ HINSTANCE handle;
+ char buffer [MAX_PATH+1];
+ DWORD size;
+ if (items != 1)
+ croak("usage: Win32::GetModuleFileName($handle)\n");
+ handle = (HINSTANCE)SvIV(*SP);
+ size = GetModuleFileName(handle, buffer, MAX_PATH+1);
+ if(size == 0) {
+ got_zero:
+ if(GetLastError() != ERROR_SUCCESS)
+ sv_setpvn(TARG, NULL, size);
+ else
+ sv_setpvn(TARG, "", size);
+ } else if (size == MAX_PATH+1) {
+ DWORD oldsize = size;
+ retry:
+ oldsize <<= 1; /* double the buffer */
+ sv_grow(TARG, oldsize); /* unknown type, can't use SvGROW */
+ size = GetModuleFileName(handle, SvPVX(TARG), oldsize);
+ if(size == 0)
+ goto got_zero;
+ else if (size == oldsize)
+ goto retry;
+ else {
+ SvCUR_set(TARG, size);
+ SvPOK_only(TARG);
+ }
+ } else {
+ sv_setpvn(TARG, buffer, size);
+ }
+ SETTARG;
+ /* no putback b/c SP didn't move */
+ return;
+}
+
XS(w32_GetProcAddress)
{
dXSARGS;
@@ -1779,6 +1818,7 @@ BOOT:
newXS("Win32::MsgBox", w32_MsgBox, file);
newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
+ newXS("Win32::GetModuleFileName", w32_GetModuleFileName, file);
newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
newXS("Win32::RegisterServer", w32_RegisterServer, file);
newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
diff --git a/cpan/Win32/t/GetModuleFileName.t b/cpan/Win32/t/GetModuleFileName.t
new file mode 100644
index 0000000..9bcafbd
--- /dev/null
+++ b/cpan/Win32/t/GetModuleFileName.t
@@ -0,0 +1,8 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 1;
+
+my $path = Win32::GetModuleFileName(0);
+ok(index($path , '.exe') == -1, "", "GetModuleFileName returned an .exe path (\"$path\")");
diff --git a/make_ext.pl b/make_ext.pl
index 12926f8..a8f9dd0 100644
--- a/make_ext.pl
+++ b/make_ext.pl
@@ -257,6 +257,63 @@ foreach my $spec (@extspec) {
[@pass_through, @{$extra_passthrough{$spec} || []}]);
}
+if(IS_WIN32 && $dynamic && $target !~ /clean$/){
+ my $usage = `rebase 2>&1`;
+ my ($have_ms_rebase, $have_ms_bind, $files, @files);
+ #msysgit ships a rebase.exe, it might wind up in %path, feel free to add support
+ if(index($usage, 'usage: rebase -b BaseAddress') == 0){
+ warn "Warning non-MS rebase program not supported. Startup speeds will suffer.\n";
+ }
+ elsif(index($usage, 'usage: REBASE [switches]') == 0){
+ $have_ms_rebase = 1;
+ }
+ else{
+ warn "Warning no rebase program found. Startup speeds will suffer.\n";
+ }
+ $usage = `bind -? 2>&1`;
+ $have_ms_bind = 1 if index($usage, 'usage: BIND [switches] image-names...') == 0;
+ #I am not sure if there are any other "bind.exe"s in the world
+ warn "Warning no bind program found. Startup speeds will suffer.\n" unless $have_ms_bind;
+
+ if($have_ms_rebase || $have_ms_bind) {
+ $files = qx'dir /s /b *.dll';
+ @files = map {$_ !~ /(\\t\\perl5\d+
+ |lib\\auto\\Devel\\PPPort\\PPPort
+ |lib\\auto\\XS\\Typemap\\Typemap
+ |lib\\auto\\XS\\APItest\\APItest)
+ \.dll$/x ? $_ : ()} split("\n", $files);
+ $files = join(' ', @files);
+ }
+ system('rebase -b 0x28000000 '.$files) if $have_ms_rebase;
+#The bind tool saves (from page type private to shareable) usually 1 4KB
+#block containing the IAT in .rdata (RO) section of each DLL, verified with
+#VMMap. Why MS puts the IAT in .rdata instead of .data who knows. VC 2003
+#with "/MERGE:.idata=.data" causes
+#"LINK : fatal error LNK1272: cannot merge '.idata' with any section"
+#!!!!!!what happens on Win64? is bind a x64 exe when compiling x64? syswow64?
+#it seems on x64 VC, bind is a x64 exe, so it finds x64 kernel32.dll and not
+#syswow64 kernel32.dll
+#SxS means that the CRT is in a unpredictable directory, so discover which CRT
+#DLL this perl is using, SxS CRT DLLs are more likely to change over time and
+#render the binding prefilled info useless, if binding to a SxS CRT DLL helps
+#atleast on the machine where perl was built and tested, it is better than
+#not binding and leaving 0s in the IAT
+
+#even though this make_ext.pl is miniperl, at this point full perl and
+#Win32:: have been compiled and are available
+ my $crtpath = qx'perl.exe -Ilib -MWin32 -e"print Win32::GetModuleFileName(Win32::GetCRTDllHandle())"';
+ my $pos = rindex($crtpath, '\\'); #chop off '\msvcr**.dll'
+ die 'CRT DLL path "'.$crtpath.'" malformed' if $pos == -1;
+ substr($crtpath, $pos, length($crtpath)-$pos, '');
+ print $crtpath."\n";
+ my $run = 'bind -u -p "..\;%SystemRoot%\system32;'.$crtpath.';" '.$files.' perl.exe';
+ print "will run ".$run."\n";
+ system($run) #perl.exe should not be rebased, but needs binding
+ if $have_ms_bind;
+ warn "no bid" if !$have_ms_bind;
+ system 'pause';
+}
+
sub build_extension {
my ($ext_dir, $perl, $mname, $target, $pass_through) = @_;
diff --git a/win32/Makefile b/win32/Makefile
index d2ec6c5..b879579 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -527,6 +527,17 @@ LIBBASEFILES = $(LIBBASEFILES) bufferoverflowU.lib
LIBFILES = $(LIBBASEFILES) $(LIBC)
+!IF "$(WIN64)" == "define"
+#On Win64, use kernel32's public API RtlPcToFileHeader which is internally is a
+#forward to ntdll's RtlPcToFileHeader, this avoids keeping the "ntldll.dll"
+#string in Win64 perl5**.dll and related overhead
+#LIBNTDLL = ntdllundec.lib
+LIBNTDLL =
+!ELSE
+LIBNTDLL = ntdlldec.lib
+!ENDIF
+
+
#EXTRACFLAGS = -nologo -GF -W4 -wd4127 -wd4706
EXTRACFLAGS = -nologo -GF -W3
!IF "$(__ICC)" == "define"
@@ -965,6 +976,19 @@ config.w32 : $(CFGSH_TMPL)
!ENDIF
@echo #endif>>$@
+ntdllundec.lib : ntdllundec.def
+ lib /def:ntdllundec.def /machine:$(ARCHITECTURE)
+
+!IF "$(WIN64)" == "undef"
+ntdlldec.lib : ntdlldec.def ntdllundec.lib
+#the right side of = alias is silently ignored by lib tool if right side symbol
+#doesn't exist and lib creates a .lib that wants "RtlPcToFileHeader@8" from
+#ntdll.dll which doesn't resolve since the export from ntdll.dll is
+#"RtlPcToFileHeader", using a 2nd .lib allows undecorated symbol to be "defined"
+#on Win64, due to __cdecl, the undec name is the symbol CL/win32.obj wants
+ lib /def:ntdlldec.def /machine:X86 ntdllundec.lib
+!ENDIF
+
..\git_version.h : $(MINIPERL) ..\make_patchnum.pl
cd .. && miniperl -Ilib make_patchnum.pl && cd win32
@@ -997,10 +1021,9 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL
# See the comment in Makefile.SH explaining this seemingly cranky ordering
$(MINIPERL) : ..\lib\buildcustomize.pl
-..\lib\buildcustomize.pl : $(MINIDIR) $(MINI_OBJ) ..\write_buildcustomize.pl
- $(LINK32) -subsystem:console -out:$(MINIPERL) @<<
- $(LINK_FLAGS) $(DELAYLOAD) $(LIBFILES) $(MINI_OBJ)
-<<
+..\lib\buildcustomize.pl : $(LIBNTDLL) $(MINIDIR) $(MINI_OBJ) ..\write_buildcustomize.pl
+ $(LINK32) -subsystem:console -out:$(MINIPERL) \
+ $(LINK_FLAGS) $(DELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ)
$(EMBED_EXE_MANI:..\lib\buildcustomize.pl=..\miniperl.exe)
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
@@ -1034,9 +1057,13 @@ perldll.def : $(MINIPERL) $(CONFIGPM) ..\embed.fnc ..\makedef.pl create_perllibs
$(MINIPERL) -I..\lib -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \
CCTYPE=$(CCTYPE) TARG_DIR=..\ > perldll.def
+#custom ntdll.lib must be before kernel32.lib, since RtlPcToFileHeader from
+#kernel32 (which is a forward to ntdll) is only on NT >= 5.2 64 bit-only
+#kernel32.dll, 32 bit WOW kernel32.dll do not have RtlPcToFileHeader and 32 bit
+#kernel32.libs dont have it
$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES) Extensions_static
$(LINK32) -dll -def:perldll.def -base:0x28000000 -out:$@ @Extensions_static @<<
- $(LINK_FLAGS) $(DELAYLOAD) $(LIBFILES) $(PERLDLL_OBJ) $(PERLDLL_RES)
+ $(LINK_FLAGS) $(DELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(PERLDLL_OBJ) $(PERLDLL_RES)
<<
$(EMBED_DLL_MANI)
$(XCOPY) $(PERLIMPLIB) $(COREDIR)
@@ -1085,7 +1112,8 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES)
$(PERLEXESTATIC): $(PERLSTATICLIB) $(CONFIGPM) $(PERLEXEST_OBJ) $(PERLEXE_RES)
$(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) \
- $(PERLEXEST_OBJ) $(PERLEXE_RES) $(PERLSTATICLIB) $(LIBFILES) $(SETARGV_OBJ)
+ $(PERLEXEST_OBJ) $(PERLEXE_RES) $(PERLSTATICLIB) $(LIBNTDLL) \
+ $(LIBFILES) $(SETARGV_OBJ)
$(EMBED_EXE_MANI)
MakePPPort: $(MINIPERL) $(CONFIGPM) Extensions_nonxs
diff --git a/win32/ntdlldec.def b/win32/ntdlldec.def
new file mode 100644
index 0000000..0b218f5
--- /dev/null
+++ b/win32/ntdlldec.def
@@ -0,0 +1,3 @@
+LIBRARY ntdll.dll
+EXPORTS
+ RtlPcToFileHeader@8 = RtlPcToFileHeader
diff --git a/win32/ntdllundec.def b/win32/ntdllundec.def
new file mode 100644
index 0000000..077deec
--- /dev/null
+++ b/win32/ntdllundec.def
@@ -0,0 +1,3 @@
+LIBRARY ntdll.dll
+EXPORTS
+ RtlPcToFileHeader
diff --git a/win32/win32.c b/win32/win32.c
index d82cf11..1239b7d 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -99,6 +99,16 @@ END_EXTERN_C
# define getlogin g_getlogin
#endif
+/* not present in old SDKs */
+
+NTSYSAPI
+PVOID
+NTAPI
+RtlPcToFileHeader(
+ PVOID PcValue,
+ PVOID *BaseOfImage
+ );
+
/* VS2005 (MSC version 14) provides a mechanism to set an invalid
* parameter handler. This functionality is not available in the
* 64-bit compiler from the Platform SDK, which unfortunately also
@@ -4205,6 +4215,36 @@ XS(w32_SetChildShowWindow)
XSRETURN(1);
}
+/* due to SxS and people building and upgraded XS modules using different CCs
+ than the core was built with, for example, VC core and later on CPAN shell
+ with Mingw GCC, or VC 6 core, later on VC 2008 modules, core's CRT can only
+ be determined from core, not Win32:: module */
+XS(w32_GetCRTDllHandle)
+{
+ dXSARGS;
+ if (items != 0)
+ croak_xs_usage(cv, "");
+ EXTEND(SP, 1);
+ {
+ dXSTARG;
+ PVOID handle;
+/* RtlPcToFileHeader is used as a replacement for
+ GetModuleHandleEx GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS. GetModuleHandleEx
+ is not available on Win2K. GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS is
+ wrapper around RtlPcToFileHeader which was undocumented introduced in
+ NT 3.51 and became public API through kernel32.dll in 64 bit only OSes.
+ Note, syswow64 32 bit kernel32 does not export RtlPcToFileHeader. To avoid
+ complexity, GetProcAddress and OS version checking isn't done for
+ GetModuleHandleEx, and use RtlPcToFileHeader on all platforms. Although this
+ code could be ifdefed to use GetModuleHandleEx on Win64 since all Win64s
+ ever made (>= NT 5.2) have GetModuleHandleEx. */
+ handle = RtlPcToFileHeader(__pioinfo, &handle);
+ PUSHi((IV)handle);
+ }
+ PUTBACK;
+ return;
+}
+
void
Perl_init_os_extras(void)
{
@@ -4226,6 +4266,7 @@ Perl_init_os_extras(void)
#endif
newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
+ newXS("Win32::GetCRTDllHandle", w32_GetCRTDllHandle, file);
}
void *
--
1.8.0.msysgit.0
|
@bulk88 barring you interest in rebasing or pursuing this, I don't see anything to be done here. |
Rebasing probably not as effective on modern Win OS as it used to be prior to ASLR: https://devblogs.microsoft.com/oldnewthing/20170120-00/?p=95225 |
Yeah, setting a base address opts out from ASLR and it's generally considered a bad practice on modern Windowses. |
Migrated from rt.perl.org#114704 (status was 'open')
Searchable as RT114704$
The text was updated successfully, but these errors were encountered: