[PATCH] stop checking the Win32 registry if *"/Software/Perl" doesn't exist #14439
Comments
From @bulk88Created by @bulk88Need #. Perl Info |
From @bulk88On Fri Jan 23 00:26:22 2015, bulk88 wrote:
Patch attached. Some benchmarks I did. This patch probably saves 1 to 2 ms out of 10 to 30 ms per process start. C:\sources\perlbench>perl perlbench-run -c 100000 newreg=C:\perl521\newreg\bin\ oldreg) perl-5 new2) perl-5 old2) perl-5 newreg oldreg new2 old2 AVERAGE 100 103 99 102 Results saved in file:///C|/sources/perlbench/benchres-015/index.html C:\sources\perlbench> I judged the numbers by eye, INVALID means the test is contradictory on time, and is measuring something irrelavent 13 OLD IS FASTER C:\sources\perlbench>perl -MBenchmark=:all,:hireswallclock -E"cmpthese(10000, {' C:\sources\perlbench> I dont think I trust that number, with perl taking 1/1481=0.000675 seconds or 0.6 ms to start up and exit. But it does show an improvement. The procmon logs were generated by running "C:\perl521\oldreg\bin\perl.exe -e"print $ENV{PERLNOTHERE}.$ENV{PERLHERE}"" and "C:\perl521\newreg\bin\perl.exe -e"print $ENV{PERLNOTHERE}.$ENV{PERLHERE}"" from cmd.exe shell. I added PERLHERE to my registry for testing. The 4 calls to "RegQueryValue" are because RegQueryValueExA calls RegQueryValueExW once to get the length of the utf16 data, it them allocs a temp buffer, then calls RegQueryValueExW again, then does utf16 to ANSI conversion, then if a user supplied buffer exists ("LPBYTE lpData"), it copies its buffer over, and finally it writes the ANSI length count into the user supplied "LPDWORD lpcbData". Since Perl calls RegQueryValueExA twice, once to get the length, then allocate Perl buffer, then calls RegQueryValueExA again, the procmon log shows 4 "RegQueryValue" calls. Turning the value name into utf16 ourselves in get_regstr (but only if 1 or 2 of the root handles are true), since remember both HKCU and HKLM SOFTWARE/Perl might exist in worst case scenario, so the value name should not be converted by Perl once for HKCU and once for HKLM, and converting back the value data buffer back to ANSI ourselves in get_regstr_from would be the smarter solution but that is another day, for another patch (it also brings up alloca vs Newx and SAVEFREEPV, and should Perl use "MultiByteToWideChar(CP_ACP" or the more efficient "RtlMultiByteToUnicodeN" https://msdn.microsoft.com/en-us/library/windows/hardware/ff553113%28v=vs.85%29.aspx which is what all the "A" functions use on Win NT series OSes, or should all Win32 Perl OS APIs accept UTF8? and I dont want to open any of those things for discussion in this ticket). Plus since the env vars themselves are stored in utf16 in the PEB on win nt, going from ansi to utf16 ASAP in perl is preferable. If HKCU/HKLM SOFTWARE/Perl exists, getting a "found" in the registry is extremely rare compared to the number of not founds. After this patch, a notfound is 1 syscall, a found is 4, so patch at making notfound scenario faster is a much bigger improvement than making the rare "found" scenario faster. The found scenario is still faster than before since we didn't have to open and close the root handle to */SOFTWARE/Perl first. new .3768070-.3765673=0.0002397, .2 ms old .5819799-.5810787=0.0009012 .9ms There is some overhead in using procmon/any syscall tracer so i'll say its 1-3 ms saved per process start. Remember I have a HKLM/SOFTWARE/Perl on my normal dev machine, my alternate machine has no SOFTWARE/Perl in either HKCU or HKLM, so it would be even faster. -- |
From @bulk880001-stop-checking-the-Win32-registry-if-Software-Perl-do.patchFrom 01982e4cee7e9cfab83d1da527ad7cb630cec18d Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 23 Jan 2015 05:34:59 -0500
Subject: [PATCH] stop checking the Win32 registry if *"/Software/Perl"
doesn't exist
This stops each ENV var lookup (and 16 calls to get_regstr, most of which
are %ENV lookups, are done automatically each time a Win32 Perl process
starts) from querying the registry for usually failing lookups.
ActiveState is the only known major user of the Software/Perl reg key.
details:
-cache the root handles, so a typically failing env var lookup does only 1
system call instead of 3 if the parent key exists
-if the key exists, looking it up is slightly faster since it is 4
registry syscall instead of previously 6 (open "*\Software\Perl", 2
RegQueryValueExAs(on "found" behavior each RegQueryValueExA does 2
RegQueryValueExW calls), close "*\Software\Perl")
-dont make a system call to lookup a value if the parent key doesn't exist
-reuse the NULL value in the static handle var instead of explictly
assigning NULL to the retval, VC 2003 didn't optimize away the NULL
assignment branch like Clang wouldve, a HKEY type is a HANDLE type
which is a void *
-change "Software\\Perl" to "SOFTWARE\\Perl" since the reg is case
preserving but lookups are not case sensitive, this all caps casing is
what regedit shows, and might save a couple cpu cycles in the DB lookup
-use RegOpenKeyExW instead of RegOpenKeyEx (actually RegOpenKeyExA), this
avoids ansi to utf16 conversions at runtime
-Dont check HKEY handles for NULL before calling RegCloseKey.
MS and ReactOS RegCloseKey checks for NULL (zero) handle first thing and
returns ERROR_INVALID_HANDLE as the retval of RegCloseKey.
-Dont check the retval of RegCloseKey, there is no way to dispatch an error
at this point in the process, there are no interps, and no perlio, and
maybe no console if its a GUI, and the process is probably exiting anyway.
Calling Perl_noperl_die (no perl, no perlio, print to stderr) would not
be friendly to an embedder. A crash box with RaiseException with
EXCEPTION_INVALID_HANDLE is a bad UI.
-Dont bother to zero the HKEY handles, after a PERL_SYS_TERM until the
next (if any) PERL_SYS_INIT3, libperl is in an undefined state, it is the
embedders responsibility to refcount and serialize calls to
PERL_SYS_INIT3/PERL_SYS_TERM if necessery
See details in [perl #123658]
---
README.win32 | 11 +++++---
pod/perldelta.pod | 21 +++++++++++++-
win32/win32.c | 78 ++++++++++++++++++++++++++++++++++++-----------------
3 files changed, 79 insertions(+), 31 deletions(-)
diff --git a/README.win32 b/README.win32
index 403c517..659adaa 100644
--- a/README.win32
+++ b/README.win32
@@ -483,10 +483,13 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. Perl attempts to read entries from
-C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
-Entries in the former override entries in the latter. One or more of the
-following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
+values if you choose to put them there. On Perl process start Perl checks if
+C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
+exist. If the keys exists, they will be checked for remainder of the Perl
+process's run life for certain entries. Entries in
+C<HKEY_CURRENT_USER\Software\Perl> override entries in
+C<HKEY_LOCAL_MACHINE\Software\Perl>. One or more of the following entries
+(of type REG_SZ or REG_EXPAND_SZ) may be set in the keys:
lib-$] version-specific standard library path to add to @INC
lib standard library path to add to @INC
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 4b00f60..c56b253 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -305,9 +305,26 @@ L</Modules and Pragmata> section.
=over 4
-=item XXX-some-platform
+=item Win32
-XXX
+=over 4
+
+=item *
+
+The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
+C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
+C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
+checked for entries at all times through Perl processes life time even if they
+did not exist. For performance reasons, now, if the root key (i.e.
+C<HKEY_CURRENT_USER\Software\Perl> or C<HKEY_LOCAL_MACHINE\Software\Perl>) does
+not exist at process start time, it will not be checked again for C<%ENV>
+override entries for the remainder of the Perl processes life. This more
+closely matches Unix behaviour in that the enviroment is copied or inherited on
+startup and changing the variable in the parent process or another process or
+editing <.bashrc> will not change the enviromental variable in other existing,
+running, processes.
+
+=back
=back
diff --git a/win32/win32.c b/win32/win32.c
index 55a09e2..59faabb 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -188,6 +188,10 @@ Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
#endif
END_EXTERN_C
+/* initialized by Perl_win32_init/PERL_SYS_INIT */
+static HKEY HKCU_Perl_hnd;
+static HKEY HKLM_Perl_hnd;
+
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -277,34 +281,28 @@ set_w32_module_name(void)
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
-get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
+get_regstr_from(HKEY handle, const char *valuename, SV **svp)
{
/* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
- HKEY handle;
DWORD type;
- const char *subkey = "Software\\Perl";
char *str = NULL;
long retval;
+ DWORD datalen;
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if (retval == ERROR_SUCCESS) {
- DWORD datalen;
- retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
- if (retval == ERROR_SUCCESS
- && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- dTHX;
- if (!*svp)
- *svp = sv_2mortal(newSVpvs(""));
- SvGROW(*svp, datalen);
- retval = RegQueryValueEx(handle, valuename, 0, NULL,
- (PBYTE)SvPVX(*svp), &datalen);
- if (retval == ERROR_SUCCESS) {
- str = SvPVX(*svp);
- SvCUR_set(*svp,datalen-1);
- }
+ retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
+ if (retval == ERROR_SUCCESS
+ && (type == REG_SZ || type == REG_EXPAND_SZ))
+ {
+ dTHX;
+ if (!*svp)
+ *svp = sv_2mortal(newSVpvs(""));
+ SvGROW(*svp, datalen);
+ retval = RegQueryValueEx(handle, valuename, 0, NULL,
+ (PBYTE)SvPVX(*svp), &datalen);
+ if (retval == ERROR_SUCCESS) {
+ str = SvPVX(*svp);
+ SvCUR_set(*svp,datalen-1);
}
- RegCloseKey(handle);
}
return str;
}
@@ -313,10 +311,23 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
static char*
get_regstr(const char *valuename, SV **svp)
{
- char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
- if (!str)
- str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
- return str;
+ char *ptr;
+ if (HKCU_Perl_hnd) {
+ ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
+ if (!ptr) {
+ ptr = (char*)HKLM_Perl_hnd;
+ if (ptr)
+ ptr = get_regstr_from((HKEY)ptr, valuename, svp);
+ /* else pass through NULL */
+ }
+ }
+ else {
+ ptr = (char*)HKLM_Perl_hnd;
+ if (ptr)
+ ptr = get_regstr_from((HKEY)ptr, valuename, svp);
+ /* else pass through NULL */
+ }
+ return ptr;
}
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
@@ -4488,6 +4499,18 @@ Perl_win32_init(int *argcp, char ***argvp)
ansify_path();
{
+ LONG retval;
+ retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKCU_Perl_hnd = NULL;
+ }
+ retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKLM_Perl_hnd = NULL;
+ }
+ }
+
+ {
/* set the static flag in IsShimInfrastructureDisabled to 1 to disable shims for perl.exe alone
this makes starting cmd.exe faster */
char * f = (char*)GetProcAddress(GetModuleHandle("kernel32.dll"), "BaseQueryModuleData");
@@ -4519,6 +4542,11 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+ /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
+ but no point of checking and we can't die() at this point */
+ RegCloseKey(HKLM_Perl_hnd);
+ RegCloseKey(HKCU_Perl_hnd);
+ /* the handles are in an undefined state until the next PERL_SYS_INIT3 */
}
void
--
1.7.9.msysgit.0
|
From @bulk88 |
From @bulk88 |
From @steve-m-hay[Apologies for Outlook's top-posting...] At $work we actually remove the registry lookup of %ENV stuff altogether to prevent other installations of Perl on customers' machines from interfering with our own software's installation of Perl. The attached (very minimal) patch does the business. I would personally be very happy to see the %ENV registry lookup disappear completely, and I vaguely recall JDB saying the same years ago. If that's correct (apologies if I've misremembered!) then it's presumably not important to ActivePerl, so if you're correct in your patch comment that "ActiveState is the only known major user of the Software/Perl reg key" then maybe we can indeed get rid of it. That's probably a contentious change, though, so I'm just too late in thinking of this for 5.22. Could we add a deprecation notice in 5.22 and drop the feature for 5.23? -----Original Message----- On Fri Jan 23 00:26:22 2015, bulk88 wrote:
Patch attached. Some benchmarks I did. This patch probably saves 1 to 2 ms out of 10 to 30 ms per process start. |
From @steve-m-hay0001-Remove-registry-check.patchFrom 763bddb68bfb5f42eb01ab56cf3f26097ac4b4f4 Mon Sep 17 00:00:00 2001
From: Steve Hay <steve.m.hay@googlemail.com>
Date: Fri, 23 Jan 2015 11:50:34 +0000
Subject: [PATCH] Remove registry check
---
win32/win32.c | 6 ------
1 file changed, 6 deletions(-)
diff --git a/win32/win32.c b/win32/win32.c
index 1510805..2fc4602 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1821,12 +1821,6 @@ win32_getenv(const char *name)
}
FreeEnvironmentStrings(envv);
}
- else {
- /* last ditch: allow any environment variables that begin with 'PERL'
- to be obtained from the registry, if found there */
- if (strncmp(name, "PERL", 4) == 0)
- (void)get_regstr(name, &curitem);
- }
}
if (curitem && SvCUR(curitem))
return SvPVX(curitem);
--
1.9.5.msysgit.0
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @bulk88On Fri Jan 23 04:03:26 2015, Steve.Hay@verosoftware.com wrote:
AS PDK's GUI debugger installs itself as value name "PERL5DB" and "BEGIN {require q<C:\Program Files\ActiveState Perl Dev Kit 9.1\bin\lib\PerlDB.pl>}" as the value (and that is the only value I have in "HKLM/SOFTWARE/Perl"). I dont think the registry lookup feature can be removed. -- |
From @tonycozOn Fri Jan 23 10:26:04 2015, bulk88 wrote:
Maybe we could add a build define to disable it. As to your patch: + if (!ptr) { is this cast assignment to ptr an optimization for some compiler? I don't think it's acceptable code. I'm kind of surprised you didn't structure it closer to the original, something like: + if (HKCU_Perl_hnd) which is a lot easier to read, and should be about the same or smaller code size and speed. + /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE My main problem with this is that it will increase noise in tools that Adding conditional checks here for a function (Perl_win32_term()) that Tony |
From @steve-m-hayOn Mon Jan 26 15:06:22 2015, tonyc wrote:
If removing it completely is not an option then I would be very much in favour of a build option to disable it. Perhaps even have the option off |
From @bulk88On Mon Jan 26 15:06:22 2015, tonyc wrote:
I added the feature, IDK what the internal C name should be of the C macro control the feature. USE_* seems to be for Configure vars, this windows only build option is not the unix COnfigure script, WIN32_* shows its not a Configure var. If "USE_NO_REGISTRY" is okay to use as a name, even though it makes no sense on non-Win32 as to what it is to do, I can get rid of the WIN32_NO_REGISTRY internal C name and have it be called USE_NO_REGISTRY to the user, and USE_NO_REGISTRY in the C code. Or do you think the present 2 name way as I did it in the commit is fine?
You code above has var ptr uninitialized in a particular branch permutation. I removed the first void * statement "ptr = HKCU_Perl_hnd;" usage on the 1st branch, I couldn't on the 2nd test since otherwise I'd have to introduce a "ptr = NULL;" and avoiding "ptr = NULL;" statement was the point of writing it with void *s. AFAIK only clang knows that a false register contains the value NULL and can optimize away the assignment of NULL and generation of NULL ("xor eax, eax").
AppVerifier doesn't complain/notice (if I managed to get it to run/instrument the right binary, it was a month ago month I tested it). VC Debugger also doesn't give me popups about bad handles. -- |
From @bulk880001-stop-checking-the-Win32-registry-if-Software-Perl-do.patchFrom c23295d4d86c08e55b6890abfa895448553b325c Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Wed, 20 May 2015 21:22:08 -0400
Subject: [PATCH 1/2] stop checking the Win32 registry if *"/Software/Perl"
doesn't exist
This stops each ENV var lookup (and 16 calls to get_regstr, most of which
are %ENV lookups, are done automatically each time a Win32 Perl process
starts) from querying the registry for usually failing lookups.
ActiveState is the only known major user of the Software/Perl reg key.
details:
-cache the root handles, so a typically failing env var lookup does only 1
system call instead of 3 if the parent key exists
-if the key exists, looking it up is slightly faster since it is 4
registry syscall instead of previously 6 (open "*\Software\Perl", 2
RegQueryValueExAs(on "found" behavior each RegQueryValueExA does 2
RegQueryValueExW calls), close "*\Software\Perl")
-dont make a system call to lookup a value if the parent key doesn't exist
-reuse the NULL value in the static handle var instead of explictly
assigning NULL to the retval (saves machien code ops), VC 2003 didn't
optimize away the NULL assignment branch like Clang wouldve, a HKEY type
is a HANDLE type which is a void *
-change "Software\\Perl" to "SOFTWARE\\Perl" since the reg is case
preserving but lookups are not case sensitive, this all caps casing is
what regedit shows, and might save a couple cpu cycles in the DB lookup
in the kernel
-use RegOpenKeyExW instead of RegOpenKeyEx (actually RegOpenKeyExA), this
avoids ansi to utf16 conversions at runtime
-dont check HKEY handles for NULL before calling RegCloseKey.
MS and ReactOS RegCloseKey checks for NULL (zero) handle first thing and
returns ERROR_INVALID_HANDLE as the retval of RegCloseKey. MS App Verifier
does not complain about NULL handles.
-Dont check the retval of RegCloseKey, there is no way to dispatch an error
at this point in the process, there are no interps, and no perlio, and
maybe no console if its a GUI, and the process is probably exiting anyway.
Calling Perl_noperl_die (no perl, no perlio, print to stderr) would not
be friendly to an embedder. A crash box with RaiseException with
EXCEPTION_INVALID_HANDLE is a bad UI.
-Dont bother to zero the HKEY handles, after a PERL_SYS_TERM until the
next (if any) PERL_SYS_INIT3, libperl is in an undefined state, it is the
embedders responsibility to refcount and serialize calls to
PERL_SYS_INIT3/PERL_SYS_TERM if necessery
See details in [perl #123658]
---
README.win32 | 11 +++++---
pod/perldelta.pod | 15 ++++++++++
win32/win32.c | 76 +++++++++++++++++++++++++++++++++++-----------------
3 files changed, 73 insertions(+), 29 deletions(-)
diff --git a/README.win32 b/README.win32
index 605f980..5e6e39a 100644
--- a/README.win32
+++ b/README.win32
@@ -483,10 +483,13 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. Perl attempts to read entries from
-C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
-Entries in the former override entries in the latter. One or more of the
-following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
+values if you choose to put them there. On Perl process start Perl checks if
+C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
+exist. If the keys exists, they will be checked for remainder of the Perl
+process's run life for certain entries. Entries in
+C<HKEY_CURRENT_USER\Software\Perl> override entries in
+C<HKEY_LOCAL_MACHINE\Software\Perl>. One or more of the following entries
+(of type REG_SZ or REG_EXPAND_SZ) may be set in the keys:
lib-$] version-specific standard library path to add to @INC
lib standard library path to add to @INC
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 2c1d562..0f89a6b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1999,6 +1999,21 @@ a fix for legacy feature checking status.
=item *
+The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
+C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
+C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
+checked for entries at all times through Perl processes life time even if they
+did not exist. For performance reasons, now, if the root key (i.e.
+C<HKEY_CURRENT_USER\Software\Perl> or C<HKEY_LOCAL_MACHINE\Software\Perl>) does
+not exist at process start time, it will not be checked again for C<%ENV>
+override entries for the remainder of the Perl processes life. This more
+closely matches Unix behaviour in that the enviroment is copied or inherited on
+startup and changing the variable in the parent process or another process or
+editing <.bashrc> will not change the enviromental variable in other existing,
+running, processes.
+
+=item *
+
F<miniperl.exe> is now built with C<-fno-strict-aliasing>, allowing 64-bit
builds to complete on GCC 4.8.
L<[perl #123976]|https://rt.perl.org/Ticket/Display.html?id=123976>
diff --git a/win32/win32.c b/win32/win32.c
index 2c35b58..d87a610 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -182,6 +182,10 @@ Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
#endif
END_EXTERN_C
+/* initialized by Perl_win32_init/PERL_SYS_INIT */
+static HKEY HKCU_Perl_hnd;
+static HKEY HKLM_Perl_hnd;
+
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -271,34 +275,28 @@ set_w32_module_name(void)
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
-get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
+get_regstr_from(HKEY handle, const char *valuename, SV **svp)
{
/* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
- HKEY handle;
DWORD type;
- const char *subkey = "Software\\Perl";
char *str = NULL;
long retval;
+ DWORD datalen;
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if (retval == ERROR_SUCCESS) {
- DWORD datalen;
- retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
- if (retval == ERROR_SUCCESS
- && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- dTHX;
- if (!*svp)
- *svp = sv_2mortal(newSVpvs(""));
- SvGROW(*svp, datalen);
- retval = RegQueryValueEx(handle, valuename, 0, NULL,
- (PBYTE)SvPVX(*svp), &datalen);
- if (retval == ERROR_SUCCESS) {
- str = SvPVX(*svp);
- SvCUR_set(*svp,datalen-1);
- }
+ retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
+ if (retval == ERROR_SUCCESS
+ && (type == REG_SZ || type == REG_EXPAND_SZ))
+ {
+ dTHX;
+ if (!*svp)
+ *svp = sv_2mortal(newSVpvs(""));
+ SvGROW(*svp, datalen);
+ retval = RegQueryValueEx(handle, valuename, 0, NULL,
+ (PBYTE)SvPVX(*svp), &datalen);
+ if (retval == ERROR_SUCCESS) {
+ str = SvPVX(*svp);
+ SvCUR_set(*svp,datalen-1);
}
- RegCloseKey(handle);
}
return str;
}
@@ -307,11 +305,22 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
static char*
get_regstr(const char *valuename, SV **svp)
{
- char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
- if (!str)
- str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
- return str;
+ char *ptr;
+ if (HKCU_Perl_hnd) {
+ ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
+ if (!ptr)
+ goto try_HKLM;
+ }
+ else {
+ try_HKLM:
+ ptr = (char*)HKLM_Perl_hnd;
+ if (ptr)
+ ptr = get_regstr_from((HKEY)ptr, valuename, svp);
+ /* else pass through NULL from the HKEY, instead of NULL assignment op */
+ }
+ return ptr;
}
+#endif /* ifndef WIN32_NO_REGISTRY */
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
static char *
@@ -4494,6 +4503,18 @@ Perl_win32_init(int *argcp, char ***argvp)
ansify_path();
{
+ LONG retval;
+ retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKCU_Perl_hnd = NULL;
+ }
+ retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKLM_Perl_hnd = NULL;
+ }
+ }
+
+ {
/* set the static flag in IsShimInfrastructureDisabled to 1 to disable shims for perl.exe alone
this makes starting cmd.exe faster */
char * f = (char*)GetProcAddress(GetModuleHandle("kernel32.dll"), "BaseQueryModuleData");
@@ -4525,6 +4546,11 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+ /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
+ but no point of checking and we can't die() at this point */
+ RegCloseKey(HKLM_Perl_hnd);
+ RegCloseKey(HKCU_Perl_hnd);
+ /* the handles are in an undefined state until the next PERL_SYS_INIT3 */
}
void
--
1.7.9.msysgit.0
|
From @bulk880002-add-Win32-USE_NO_REGISTRY-build-option.patchFrom db8192ecf78d7f18a7fdbcc047f3dad0577bb287 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 21 May 2015 19:59:20 -0400
Subject: [PATCH 2/2] add Win32 USE_NO_REGISTRY build option
-the first arg of win32_get_privlib is not used if the registry is not
queried, create a macro to allow the arg to drop out on WIN32_NO_REGISTRY
builds for efficiency and not to have unused C litteral strings in the
binary
-This patch changes the ABI of
PerlEnv_lib_path/PerlEnvLibPath/win32_get_privlib between USE_NO_REGISTRY
and no USE_NO_REGISTRY. Since win32_get_privlib is not exported from
perl523.dll, assume it and PerlEnv_lib_path are not public API, note
technically PerlEnv_lib_path will be callable only on PERL_IMPLICIT_SYS
builds, on no PERL_IMPLICIT_SYS builds it will fail at link time since
win32_get_privlib isnt exported. Therefore place it in
non-[affecting]-binary compatibility even though it does affect binary
compatibility.
-delay load advapi32.dll to save startup time (loading the DLL and the DLL
calling its initializers in DllMain) and one 4 KB memory page for
advapi32's .data section (doing "perl -E"sleep 100" on WinXP shows
advapi32 has a 20KB long .data section, first 4 KB are unique to the
process, the remaining 16KB are COW shared between processes according
to vmmap tool), putting a DebugBreak() in pp_getlogin and doing a
"nmake all" shows miniperl never calls getlogin during the build process.
An nmake test shows only ext/POSIX/t/wrappers.t and lib/warnings.t execute
pp_getlogin. Keeping advapi32.dll out of the perl process requires
removing comctl32.dll, since comctrl32.dll loads advapi32.dll, from perl
which I always do as a custom patch.
filed as [perl #123658]
---
README.win32 | 3 ++-
iperlsys.h | 6 +++---
perl.c | 3 +++
pod/perldelta.pod | 8 ++++++++
win32/Makefile | 26 +++++++++++++++++++++++++-
win32/makefile.mk | 23 ++++++++++++++++++++++-
win32/perlhost.h | 4 ++--
win32/win32.c | 37 ++++++++++++++++++++++++++++++-------
win32/win32.h | 12 +++++++++++-
win32/wince.c | 2 +-
10 files changed, 107 insertions(+), 17 deletions(-)
diff --git a/README.win32 b/README.win32
index 5e6e39a..353cf87 100644
--- a/README.win32
+++ b/README.win32
@@ -483,7 +483,8 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. On Perl process start Perl checks if
+values if you choose to put them there unless disabled at build time with
+USE_NO_REGISTRY. On Perl process start Perl checks if
C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
exist. If the keys exists, they will be checked for remainder of the Perl
process's run life for certain entries. Entries in
diff --git a/iperlsys.h b/iperlsys.h
index 5ff1483..702a71c 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -478,7 +478,7 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*,
#endif
#ifdef WIN32
typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
-typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*,
+typedef char* (*LPEnvLibPath)(struct IPerlEnv*, WIN32_NO_REGISTRY_M_(const char*)
STRLEN *const len);
typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*,
STRLEN *const len);
@@ -550,7 +550,7 @@ struct IPerlEnvInfo
#define PerlEnv_os_id() \
(*PL_Env->pEnvOsID)(PL_Env)
#define PerlEnv_lib_path(str, lenp) \
- (*PL_Env->pLibPath)(PL_Env,(str),(lenp))
+ (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp))
#define PerlEnv_sitelib_path(str, lenp) \
(*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp))
#define PerlEnv_vendorlib_path(str, lenp) \
@@ -575,7 +575,7 @@ struct IPerlEnvInfo
#ifdef WIN32
#define PerlEnv_os_id() win32_os_id()
-#define PerlEnv_lib_path(str, lenp) win32_get_privlib(str, lenp)
+#define PerlEnv_lib_path(str, lenp) win32_get_privlib(WIN32_NO_REGISTRY_M_(str) lenp)
#define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp)
#define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp)
#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
diff --git a/perl.c b/perl.c
index 83ee6f4..612474e 100644
--- a/perl.c
+++ b/perl.c
@@ -1779,6 +1779,9 @@ S_Internals_V(pTHX_ CV *cv)
# ifdef USE_LOCALE_CTYPE
" USE_LOCALE_CTYPE"
# endif
+# ifdef WIN32_NO_REGISTRY
+ " USE_NO_REGISTRY"
+# endif
# ifdef USE_PERL_ATOF
" USE_PERL_ATOF"
# endif
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 0f89a6b..93e7b0b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1999,6 +1999,14 @@ a fix for legacy feature checking status.
=item *
+A new build option C<USE_NO_REGISTRY> has been added to the makefiles. This
+option is off by default, meaning the default is to do Windows registry lookups.
+This option stops Perl from looking inside the registry for anything. For what
+values are looked up in the registry see L<perlwin32>. Internally, in C, the
+name of this option is C<WIN32_NO_REGISTRY>.
+
+=item *
+
The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
diff --git a/win32/Makefile b/win32/Makefile
index 2f2165b..a110075 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -96,6 +96,13 @@ USE_LARGE_FILES = define
#USE_64_BIT_INT = define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY = define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.x (aka Visual C++ 98)
@@ -294,6 +301,10 @@ USE_LARGE_FILES = undef
USE_64_BIT_INT = undef
!ENDIF
+!IF "$(USE_NO_REGISTRY)" == ""
+USE_NO_REGISTRY = undef
+!ENDIF
+
!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
@@ -314,6 +325,10 @@ BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
!ENDIF
+!IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT = $(BUILDOPT) -DWIN32_NO_REGISTRY
+!ENDIF
+
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
PROCESSOR_ARCHITECTURE = x86
!ENDIF
@@ -388,7 +403,16 @@ ARCHNAME = $(ARCHNAME)-64int
# All but the free version of VC++ 7.x can load DLLs on demand. Makes the test
# suite run in about 10% less time.
!IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+!IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+!ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+!ENDIF
!ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and
@@ -1034,7 +1058,7 @@ $(MINIPERL) : ..\lib\buildcustomize.pl
..\lib\buildcustomize.pl : $(LIBNTDLL) $(MINIDIR) $(MINI_OBJ) ..\write_buildcustomize.pl
$(LINK32) -subsystem:console -out:$(MINIPERL) \
- $(LINK_FLAGS) $(DELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ)
+ $(LINK_FLAGS) $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ)
$(EMBED_EXE_MANI:..\lib\buildcustomize.pl=..\miniperl.exe)
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 78256b1..160b306 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -108,6 +108,13 @@ USE_LARGE_FILES *= define
#USE_LONG_DOUBLE *=define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY *=define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.x (aka Visual C++ 98)
@@ -310,6 +317,7 @@ USE_IMP_SYS *= undef
USE_LARGE_FILES *= undef
USE_64_BIT_INT *= undef
USE_LONG_DOUBLE *= undef
+USE_NO_REGISTRY *= undef
.IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
@@ -343,6 +351,10 @@ BUILDOPT += -DPERL_IMPLICIT_CONTEXT
BUILDOPT += -DPERL_IMPLICIT_SYS
.ENDIF
+.IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT += -DWIN32_NO_REGISTRY
+.ENDIF
+
PROCESSOR_ARCHITECTURE *= x86
.IF "$(WIN64)" == ""
@@ -523,7 +535,16 @@ TESTPREPGCC = test-prep-gcc
# All but the free version of VC++ 7.x can load DLLs on demand. Makes the test
# suite run in about 10% less time.
.IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+.IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+.ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+.ENDIF
.ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and
@@ -1131,7 +1152,7 @@ $(CONFIGPM): ..\config.sh config_h.PL
$(mktmp $(LKPRE) $(MINI_OBJ) $(LIBNTDLL) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -subsystem:console -out:$(MINIPERL) $(BLINK_FLAGS) \
- @$(mktmp $(DELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ))
+ @$(mktmp $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ))
$(EMBED_EXE_MANI:s/$@/$(MINIPERL)/)
.ENDIF
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 2ec48eb..084d661 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -514,9 +514,9 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
+PerlEnvLibPath(struct IPerlEnv* piPerl, WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
- return win32_get_privlib(pl, len);
+ return win32_get_privlib(WIN32_NO_REGISTRY_M_(pl) len);
}
char*
diff --git a/win32/win32.c b/win32/win32.c
index d87a610..473c291 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -131,12 +131,17 @@ static void my_invalid_parameter_handler(const wchar_t* expression,
unsigned int line, uintptr_t pReserved);
#endif
+#ifndef WIN32_NO_REGISTRY
static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp);
static char* get_regstr(const char *valuename, SV **svp);
+#endif
+
static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
char *trailing, ...);
-static char* win32_get_xlib(const char *pl, const char *xlib,
+static char* win32_get_xlib(const char *pl,
+ WIN32_NO_REGISTRY_M_(const char *xlib)
const char *libname, STRLEN *const len);
+
static BOOL has_shell_metachars(const char *ptr);
static long tokenize(const char *str, char **dest, char ***destv);
static void get_shell(void);
@@ -182,9 +187,11 @@ Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
#endif
END_EXTERN_C
+#ifndef WIN32_NO_REGISTRY
/* initialized by Perl_win32_init/PERL_SYS_INIT */
static HKEY HKCU_Perl_hnd;
static HKEY HKLM_Perl_hnd;
+#endif
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -273,6 +280,7 @@ set_w32_module_name(void)
}
}
+#ifndef WIN32_NO_REGISTRY
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
get_regstr_from(HKEY handle, const char *valuename, SV **svp)
@@ -390,41 +398,49 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
EXTERN_C char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
char *stdlib = "lib";
- char buffer[MAX_PATH+1];
SV *sv = NULL;
+#ifndef WIN32_NO_REGISTRY
+ char buffer[MAX_PATH+1];
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
if (!get_regstr(buffer, &sv))
(void)get_regstr(stdlib, &sv);
+#endif
/* $stdlib .= ";$EMD/../../lib" */
return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
}
static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname,
- STRLEN *const len)
+win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib)
+ const char *libname, STRLEN *const len)
{
+#ifndef WIN32_NO_REGISTRY
char regstr[40];
+#endif
char pathstr[MAX_PATH+1];
SV *sv1 = NULL;
SV *sv2 = NULL;
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
sprintf(regstr, "%s-%s", xlib, pl);
(void)get_regstr(regstr, &sv1);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
(void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
@@ -449,7 +465,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
EXTERN_C char *
win32_get_sitelib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "sitelib", "site", len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("sitelib") "site", len);
}
#ifndef PERL_VENDORLIB_NAME
@@ -459,7 +475,7 @@ win32_get_sitelib(const char *pl, STRLEN *const len)
EXTERN_C char *
win32_get_vendorlib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("vendorlib") PERL_VENDORLIB_NAME, len);
}
static BOOL
@@ -1840,12 +1856,14 @@ win32_getenv(const char *name)
}
FreeEnvironmentStrings(envv);
}
+#ifndef WIN32_NO_REGISTRY
else {
/* last ditch: allow any environment variables that begin with 'PERL'
to be obtained from the registry, if found there */
if (strncmp(name, "PERL", 4) == 0)
(void)get_regstr(name, &curitem);
}
+#endif
}
if (curitem && SvCUR(curitem))
return SvPVX(curitem);
@@ -4502,6 +4520,8 @@ Perl_win32_init(int *argcp, char ***argvp)
#endif
ansify_path();
+
+#ifndef WIN32_NO_REGISTRY
{
LONG retval;
retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
@@ -4513,6 +4533,7 @@ Perl_win32_init(int *argcp, char ***argvp)
HKLM_Perl_hnd = NULL;
}
}
+#endif
{
/* set the static flag in IsShimInfrastructureDisabled to 1 to disable shims for perl.exe alone
@@ -4546,11 +4567,13 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+#ifndef WIN32_NO_REGISTRY
/* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
but no point of checking and we can't die() at this point */
RegCloseKey(HKLM_Perl_hnd);
RegCloseKey(HKCU_Perl_hnd);
/* the handles are in an undefined state until the next PERL_SYS_INIT3 */
+#endif
}
void
diff --git a/win32/win32.h b/win32/win32.h
index 620b126..81df048 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -24,6 +24,9 @@
/* less I/O calls during each require */
# define PERL_DISABLE_PMC
+/* unnecessery for miniperl to lookup anything from an "installed" perl */
+# define WIN32_NO_REGISTRY
+
/* allow minitest to work */
/* # define USE_PERLIO disable for build performance */
/* # define PERL_TEXTMODE_SCRIPTS disable, causes bad behaviour with PerlIO off */
@@ -212,6 +215,13 @@ struct utsname {
# define PERL_SOCK_SYSWRITE_IS_SEND
#endif
+#ifdef WIN32_NO_REGISTRY
+/* the last _ in WIN32_NO_REGISTRY_M_ is like the _ in aTHX_ */
+# define WIN32_NO_REGISTRY_M_(x)
+#else
+# define WIN32_NO_REGISTRY_M_(x) x,
+#endif
+
#define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
#define ENV_IS_CASELESS
@@ -420,7 +430,7 @@ DllExport HWND win32_create_message_window(void);
DllExport int win32_async_check(pTHX);
extern int my_fclose(FILE *);
-extern char * win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len);
extern char * win32_get_sitelib(const char *pl, STRLEN *const len);
extern char * win32_get_vendorlib(const char *pl, STRLEN *const len);
diff --git a/win32/wince.c b/win32/wince.c
index b3c5b52..581a12b 100644
--- a/win32/wince.c
+++ b/win32/wince.c
@@ -232,7 +232,7 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
--
1.7.9.msysgit.0
|
From @bulk88On Mon Jan 26 15:06:22 2015, tonyc wrote:
I added the feature, IDK what the internal C name should be of the C macro control the feature. USE_* seems to be for Configure vars, WIN32_* shows its not a Configure var. If "USE_NO_REGISTRY" is okay to use as a name, even though it makes no sense on non-Win32, I can get rid of the WIN32_NO_REGISTRY internal C name and have it be called USE_NO_REGISTRY to the user, and USE_NO_REGISTRY in the C code.
You code above has var ptr uninitialized in a particular branch permutation. I removed the first void * statement "ptr = HKCU_Perl_hnd;" usage on the 1st branch, I couldn't on the 2nd test since otherwise I'd have to introduce a "ptr = NULL;" and avoiding "ptr = NULL;" statement was the point of writing it with void *s. AFAIK only clang knows that a false register contains the value NULL and can optimize away the assignment of NULL.
AppVerifier doesn't complain/notice (if I managed to get it to run/instrument the right binary, it was a ago month I tested it). VC Debugger also doesn't give me popups about bad handles. -- |
From @bulk880001-stop-checking-the-Win32-registry-if-Software-Perl-do.patchFrom c23295d4d86c08e55b6890abfa895448553b325c Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Wed, 20 May 2015 21:22:08 -0400
Subject: [PATCH 1/2] stop checking the Win32 registry if *"/Software/Perl"
doesn't exist
This stops each ENV var lookup (and 16 calls to get_regstr, most of which
are %ENV lookups, are done automatically each time a Win32 Perl process
starts) from querying the registry for usually failing lookups.
ActiveState is the only known major user of the Software/Perl reg key.
details:
-cache the root handles, so a typically failing env var lookup does only 1
system call instead of 3 if the parent key exists
-if the key exists, looking it up is slightly faster since it is 4
registry syscall instead of previously 6 (open "*\Software\Perl", 2
RegQueryValueExAs(on "found" behavior each RegQueryValueExA does 2
RegQueryValueExW calls), close "*\Software\Perl")
-dont make a system call to lookup a value if the parent key doesn't exist
-reuse the NULL value in the static handle var instead of explictly
assigning NULL to the retval (saves machien code ops), VC 2003 didn't
optimize away the NULL assignment branch like Clang wouldve, a HKEY type
is a HANDLE type which is a void *
-change "Software\\Perl" to "SOFTWARE\\Perl" since the reg is case
preserving but lookups are not case sensitive, this all caps casing is
what regedit shows, and might save a couple cpu cycles in the DB lookup
in the kernel
-use RegOpenKeyExW instead of RegOpenKeyEx (actually RegOpenKeyExA), this
avoids ansi to utf16 conversions at runtime
-dont check HKEY handles for NULL before calling RegCloseKey.
MS and ReactOS RegCloseKey checks for NULL (zero) handle first thing and
returns ERROR_INVALID_HANDLE as the retval of RegCloseKey. MS App Verifier
does not complain about NULL handles.
-Dont check the retval of RegCloseKey, there is no way to dispatch an error
at this point in the process, there are no interps, and no perlio, and
maybe no console if its a GUI, and the process is probably exiting anyway.
Calling Perl_noperl_die (no perl, no perlio, print to stderr) would not
be friendly to an embedder. A crash box with RaiseException with
EXCEPTION_INVALID_HANDLE is a bad UI.
-Dont bother to zero the HKEY handles, after a PERL_SYS_TERM until the
next (if any) PERL_SYS_INIT3, libperl is in an undefined state, it is the
embedders responsibility to refcount and serialize calls to
PERL_SYS_INIT3/PERL_SYS_TERM if necessery
See details in [perl #123658]
---
README.win32 | 11 +++++---
pod/perldelta.pod | 15 ++++++++++
win32/win32.c | 76 +++++++++++++++++++++++++++++++++++-----------------
3 files changed, 73 insertions(+), 29 deletions(-)
diff --git a/README.win32 b/README.win32
index 605f980..5e6e39a 100644
--- a/README.win32
+++ b/README.win32
@@ -483,10 +483,13 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. Perl attempts to read entries from
-C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
-Entries in the former override entries in the latter. One or more of the
-following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
+values if you choose to put them there. On Perl process start Perl checks if
+C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
+exist. If the keys exists, they will be checked for remainder of the Perl
+process's run life for certain entries. Entries in
+C<HKEY_CURRENT_USER\Software\Perl> override entries in
+C<HKEY_LOCAL_MACHINE\Software\Perl>. One or more of the following entries
+(of type REG_SZ or REG_EXPAND_SZ) may be set in the keys:
lib-$] version-specific standard library path to add to @INC
lib standard library path to add to @INC
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 2c1d562..0f89a6b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1999,6 +1999,21 @@ a fix for legacy feature checking status.
=item *
+The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
+C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
+C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
+checked for entries at all times through Perl processes life time even if they
+did not exist. For performance reasons, now, if the root key (i.e.
+C<HKEY_CURRENT_USER\Software\Perl> or C<HKEY_LOCAL_MACHINE\Software\Perl>) does
+not exist at process start time, it will not be checked again for C<%ENV>
+override entries for the remainder of the Perl processes life. This more
+closely matches Unix behaviour in that the enviroment is copied or inherited on
+startup and changing the variable in the parent process or another process or
+editing <.bashrc> will not change the enviromental variable in other existing,
+running, processes.
+
+=item *
+
F<miniperl.exe> is now built with C<-fno-strict-aliasing>, allowing 64-bit
builds to complete on GCC 4.8.
L<[perl #123976]|https://rt.perl.org/Ticket/Display.html?id=123976>
diff --git a/win32/win32.c b/win32/win32.c
index 2c35b58..d87a610 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -182,6 +182,10 @@ Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
#endif
END_EXTERN_C
+/* initialized by Perl_win32_init/PERL_SYS_INIT */
+static HKEY HKCU_Perl_hnd;
+static HKEY HKLM_Perl_hnd;
+
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -271,34 +275,28 @@ set_w32_module_name(void)
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
-get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
+get_regstr_from(HKEY handle, const char *valuename, SV **svp)
{
/* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
- HKEY handle;
DWORD type;
- const char *subkey = "Software\\Perl";
char *str = NULL;
long retval;
+ DWORD datalen;
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if (retval == ERROR_SUCCESS) {
- DWORD datalen;
- retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
- if (retval == ERROR_SUCCESS
- && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- dTHX;
- if (!*svp)
- *svp = sv_2mortal(newSVpvs(""));
- SvGROW(*svp, datalen);
- retval = RegQueryValueEx(handle, valuename, 0, NULL,
- (PBYTE)SvPVX(*svp), &datalen);
- if (retval == ERROR_SUCCESS) {
- str = SvPVX(*svp);
- SvCUR_set(*svp,datalen-1);
- }
+ retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
+ if (retval == ERROR_SUCCESS
+ && (type == REG_SZ || type == REG_EXPAND_SZ))
+ {
+ dTHX;
+ if (!*svp)
+ *svp = sv_2mortal(newSVpvs(""));
+ SvGROW(*svp, datalen);
+ retval = RegQueryValueEx(handle, valuename, 0, NULL,
+ (PBYTE)SvPVX(*svp), &datalen);
+ if (retval == ERROR_SUCCESS) {
+ str = SvPVX(*svp);
+ SvCUR_set(*svp,datalen-1);
}
- RegCloseKey(handle);
}
return str;
}
@@ -307,11 +305,22 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
static char*
get_regstr(const char *valuename, SV **svp)
{
- char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
- if (!str)
- str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
- return str;
+ char *ptr;
+ if (HKCU_Perl_hnd) {
+ ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
+ if (!ptr)
+ goto try_HKLM;
+ }
+ else {
+ try_HKLM:
+ ptr = (char*)HKLM_Perl_hnd;
+ if (ptr)
+ ptr = get_regstr_from((HKEY)ptr, valuename, svp);
+ /* else pass through NULL from the HKEY, instead of NULL assignment op */
+ }
+ return ptr;
}
+#endif /* ifndef WIN32_NO_REGISTRY */
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
static char *
@@ -4494,6 +4503,18 @@ Perl_win32_init(int *argcp, char ***argvp)
ansify_path();
{
+ LONG retval;
+ retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKCU_Perl_hnd = NULL;
+ }
+ retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKLM_Perl_hnd = NULL;
+ }
+ }
+
+ {
/* set the static flag in IsShimInfrastructureDisabled to 1 to disable shims for perl.exe alone
this makes starting cmd.exe faster */
char * f = (char*)GetProcAddress(GetModuleHandle("kernel32.dll"), "BaseQueryModuleData");
@@ -4525,6 +4546,11 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+ /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
+ but no point of checking and we can't die() at this point */
+ RegCloseKey(HKLM_Perl_hnd);
+ RegCloseKey(HKCU_Perl_hnd);
+ /* the handles are in an undefined state until the next PERL_SYS_INIT3 */
}
void
--
1.7.9.msysgit.0
|
From @bulk880002-add-Win32-USE_NO_REGISTRY-build-option.patchFrom db8192ecf78d7f18a7fdbcc047f3dad0577bb287 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 21 May 2015 19:59:20 -0400
Subject: [PATCH 2/2] add Win32 USE_NO_REGISTRY build option
-the first arg of win32_get_privlib is not used if the registry is not
queried, create a macro to allow the arg to drop out on WIN32_NO_REGISTRY
builds for efficiency and not to have unused C litteral strings in the
binary
-This patch changes the ABI of
PerlEnv_lib_path/PerlEnvLibPath/win32_get_privlib between USE_NO_REGISTRY
and no USE_NO_REGISTRY. Since win32_get_privlib is not exported from
perl523.dll, assume it and PerlEnv_lib_path are not public API, note
technically PerlEnv_lib_path will be callable only on PERL_IMPLICIT_SYS
builds, on no PERL_IMPLICIT_SYS builds it will fail at link time since
win32_get_privlib isnt exported. Therefore place it in
non-[affecting]-binary compatibility even though it does affect binary
compatibility.
-delay load advapi32.dll to save startup time (loading the DLL and the DLL
calling its initializers in DllMain) and one 4 KB memory page for
advapi32's .data section (doing "perl -E"sleep 100" on WinXP shows
advapi32 has a 20KB long .data section, first 4 KB are unique to the
process, the remaining 16KB are COW shared between processes according
to vmmap tool), putting a DebugBreak() in pp_getlogin and doing a
"nmake all" shows miniperl never calls getlogin during the build process.
An nmake test shows only ext/POSIX/t/wrappers.t and lib/warnings.t execute
pp_getlogin. Keeping advapi32.dll out of the perl process requires
removing comctl32.dll, since comctrl32.dll loads advapi32.dll, from perl
which I always do as a custom patch.
filed as [perl #123658]
---
README.win32 | 3 ++-
iperlsys.h | 6 +++---
perl.c | 3 +++
pod/perldelta.pod | 8 ++++++++
win32/Makefile | 26 +++++++++++++++++++++++++-
win32/makefile.mk | 23 ++++++++++++++++++++++-
win32/perlhost.h | 4 ++--
win32/win32.c | 37 ++++++++++++++++++++++++++++++-------
win32/win32.h | 12 +++++++++++-
win32/wince.c | 2 +-
10 files changed, 107 insertions(+), 17 deletions(-)
diff --git a/README.win32 b/README.win32
index 5e6e39a..353cf87 100644
--- a/README.win32
+++ b/README.win32
@@ -483,7 +483,8 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. On Perl process start Perl checks if
+values if you choose to put them there unless disabled at build time with
+USE_NO_REGISTRY. On Perl process start Perl checks if
C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
exist. If the keys exists, they will be checked for remainder of the Perl
process's run life for certain entries. Entries in
diff --git a/iperlsys.h b/iperlsys.h
index 5ff1483..702a71c 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -478,7 +478,7 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*,
#endif
#ifdef WIN32
typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
-typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*,
+typedef char* (*LPEnvLibPath)(struct IPerlEnv*, WIN32_NO_REGISTRY_M_(const char*)
STRLEN *const len);
typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*,
STRLEN *const len);
@@ -550,7 +550,7 @@ struct IPerlEnvInfo
#define PerlEnv_os_id() \
(*PL_Env->pEnvOsID)(PL_Env)
#define PerlEnv_lib_path(str, lenp) \
- (*PL_Env->pLibPath)(PL_Env,(str),(lenp))
+ (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp))
#define PerlEnv_sitelib_path(str, lenp) \
(*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp))
#define PerlEnv_vendorlib_path(str, lenp) \
@@ -575,7 +575,7 @@ struct IPerlEnvInfo
#ifdef WIN32
#define PerlEnv_os_id() win32_os_id()
-#define PerlEnv_lib_path(str, lenp) win32_get_privlib(str, lenp)
+#define PerlEnv_lib_path(str, lenp) win32_get_privlib(WIN32_NO_REGISTRY_M_(str) lenp)
#define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp)
#define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp)
#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
diff --git a/perl.c b/perl.c
index 83ee6f4..612474e 100644
--- a/perl.c
+++ b/perl.c
@@ -1779,6 +1779,9 @@ S_Internals_V(pTHX_ CV *cv)
# ifdef USE_LOCALE_CTYPE
" USE_LOCALE_CTYPE"
# endif
+# ifdef WIN32_NO_REGISTRY
+ " USE_NO_REGISTRY"
+# endif
# ifdef USE_PERL_ATOF
" USE_PERL_ATOF"
# endif
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 0f89a6b..93e7b0b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1999,6 +1999,14 @@ a fix for legacy feature checking status.
=item *
+A new build option C<USE_NO_REGISTRY> has been added to the makefiles. This
+option is off by default, meaning the default is to do Windows registry lookups.
+This option stops Perl from looking inside the registry for anything. For what
+values are looked up in the registry see L<perlwin32>. Internally, in C, the
+name of this option is C<WIN32_NO_REGISTRY>.
+
+=item *
+
The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
diff --git a/win32/Makefile b/win32/Makefile
index 2f2165b..a110075 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -96,6 +96,13 @@ USE_LARGE_FILES = define
#USE_64_BIT_INT = define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY = define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.x (aka Visual C++ 98)
@@ -294,6 +301,10 @@ USE_LARGE_FILES = undef
USE_64_BIT_INT = undef
!ENDIF
+!IF "$(USE_NO_REGISTRY)" == ""
+USE_NO_REGISTRY = undef
+!ENDIF
+
!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
@@ -314,6 +325,10 @@ BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
!ENDIF
+!IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT = $(BUILDOPT) -DWIN32_NO_REGISTRY
+!ENDIF
+
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
PROCESSOR_ARCHITECTURE = x86
!ENDIF
@@ -388,7 +403,16 @@ ARCHNAME = $(ARCHNAME)-64int
# All but the free version of VC++ 7.x can load DLLs on demand. Makes the test
# suite run in about 10% less time.
!IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+!IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+!ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+!ENDIF
!ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and
@@ -1034,7 +1058,7 @@ $(MINIPERL) : ..\lib\buildcustomize.pl
..\lib\buildcustomize.pl : $(LIBNTDLL) $(MINIDIR) $(MINI_OBJ) ..\write_buildcustomize.pl
$(LINK32) -subsystem:console -out:$(MINIPERL) \
- $(LINK_FLAGS) $(DELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ)
+ $(LINK_FLAGS) $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ)
$(EMBED_EXE_MANI:..\lib\buildcustomize.pl=..\miniperl.exe)
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 78256b1..160b306 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -108,6 +108,13 @@ USE_LARGE_FILES *= define
#USE_LONG_DOUBLE *=define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY *=define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.x (aka Visual C++ 98)
@@ -310,6 +317,7 @@ USE_IMP_SYS *= undef
USE_LARGE_FILES *= undef
USE_64_BIT_INT *= undef
USE_LONG_DOUBLE *= undef
+USE_NO_REGISTRY *= undef
.IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
@@ -343,6 +351,10 @@ BUILDOPT += -DPERL_IMPLICIT_CONTEXT
BUILDOPT += -DPERL_IMPLICIT_SYS
.ENDIF
+.IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT += -DWIN32_NO_REGISTRY
+.ENDIF
+
PROCESSOR_ARCHITECTURE *= x86
.IF "$(WIN64)" == ""
@@ -523,7 +535,16 @@ TESTPREPGCC = test-prep-gcc
# All but the free version of VC++ 7.x can load DLLs on demand. Makes the test
# suite run in about 10% less time.
.IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+.IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+.ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+.ENDIF
.ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and
@@ -1131,7 +1152,7 @@ $(CONFIGPM): ..\config.sh config_h.PL
$(mktmp $(LKPRE) $(MINI_OBJ) $(LIBNTDLL) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -subsystem:console -out:$(MINIPERL) $(BLINK_FLAGS) \
- @$(mktmp $(DELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ))
+ @$(mktmp $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBNTDLL) $(LIBFILES) $(MINI_OBJ))
$(EMBED_EXE_MANI:s/$@/$(MINIPERL)/)
.ENDIF
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 2ec48eb..084d661 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -514,9 +514,9 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
+PerlEnvLibPath(struct IPerlEnv* piPerl, WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
- return win32_get_privlib(pl, len);
+ return win32_get_privlib(WIN32_NO_REGISTRY_M_(pl) len);
}
char*
diff --git a/win32/win32.c b/win32/win32.c
index d87a610..473c291 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -131,12 +131,17 @@ static void my_invalid_parameter_handler(const wchar_t* expression,
unsigned int line, uintptr_t pReserved);
#endif
+#ifndef WIN32_NO_REGISTRY
static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp);
static char* get_regstr(const char *valuename, SV **svp);
+#endif
+
static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
char *trailing, ...);
-static char* win32_get_xlib(const char *pl, const char *xlib,
+static char* win32_get_xlib(const char *pl,
+ WIN32_NO_REGISTRY_M_(const char *xlib)
const char *libname, STRLEN *const len);
+
static BOOL has_shell_metachars(const char *ptr);
static long tokenize(const char *str, char **dest, char ***destv);
static void get_shell(void);
@@ -182,9 +187,11 @@ Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
#endif
END_EXTERN_C
+#ifndef WIN32_NO_REGISTRY
/* initialized by Perl_win32_init/PERL_SYS_INIT */
static HKEY HKCU_Perl_hnd;
static HKEY HKLM_Perl_hnd;
+#endif
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -273,6 +280,7 @@ set_w32_module_name(void)
}
}
+#ifndef WIN32_NO_REGISTRY
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
get_regstr_from(HKEY handle, const char *valuename, SV **svp)
@@ -390,41 +398,49 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
EXTERN_C char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
char *stdlib = "lib";
- char buffer[MAX_PATH+1];
SV *sv = NULL;
+#ifndef WIN32_NO_REGISTRY
+ char buffer[MAX_PATH+1];
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
if (!get_regstr(buffer, &sv))
(void)get_regstr(stdlib, &sv);
+#endif
/* $stdlib .= ";$EMD/../../lib" */
return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
}
static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname,
- STRLEN *const len)
+win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib)
+ const char *libname, STRLEN *const len)
{
+#ifndef WIN32_NO_REGISTRY
char regstr[40];
+#endif
char pathstr[MAX_PATH+1];
SV *sv1 = NULL;
SV *sv2 = NULL;
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
sprintf(regstr, "%s-%s", xlib, pl);
(void)get_regstr(regstr, &sv1);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
(void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
@@ -449,7 +465,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
EXTERN_C char *
win32_get_sitelib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "sitelib", "site", len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("sitelib") "site", len);
}
#ifndef PERL_VENDORLIB_NAME
@@ -459,7 +475,7 @@ win32_get_sitelib(const char *pl, STRLEN *const len)
EXTERN_C char *
win32_get_vendorlib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("vendorlib") PERL_VENDORLIB_NAME, len);
}
static BOOL
@@ -1840,12 +1856,14 @@ win32_getenv(const char *name)
}
FreeEnvironmentStrings(envv);
}
+#ifndef WIN32_NO_REGISTRY
else {
/* last ditch: allow any environment variables that begin with 'PERL'
to be obtained from the registry, if found there */
if (strncmp(name, "PERL", 4) == 0)
(void)get_regstr(name, &curitem);
}
+#endif
}
if (curitem && SvCUR(curitem))
return SvPVX(curitem);
@@ -4502,6 +4520,8 @@ Perl_win32_init(int *argcp, char ***argvp)
#endif
ansify_path();
+
+#ifndef WIN32_NO_REGISTRY
{
LONG retval;
retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
@@ -4513,6 +4533,7 @@ Perl_win32_init(int *argcp, char ***argvp)
HKLM_Perl_hnd = NULL;
}
}
+#endif
{
/* set the static flag in IsShimInfrastructureDisabled to 1 to disable shims for perl.exe alone
@@ -4546,11 +4567,13 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+#ifndef WIN32_NO_REGISTRY
/* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
but no point of checking and we can't die() at this point */
RegCloseKey(HKLM_Perl_hnd);
RegCloseKey(HKCU_Perl_hnd);
/* the handles are in an undefined state until the next PERL_SYS_INIT3 */
+#endif
}
void
diff --git a/win32/win32.h b/win32/win32.h
index 620b126..81df048 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -24,6 +24,9 @@
/* less I/O calls during each require */
# define PERL_DISABLE_PMC
+/* unnecessery for miniperl to lookup anything from an "installed" perl */
+# define WIN32_NO_REGISTRY
+
/* allow minitest to work */
/* # define USE_PERLIO disable for build performance */
/* # define PERL_TEXTMODE_SCRIPTS disable, causes bad behaviour with PerlIO off */
@@ -212,6 +215,13 @@ struct utsname {
# define PERL_SOCK_SYSWRITE_IS_SEND
#endif
+#ifdef WIN32_NO_REGISTRY
+/* the last _ in WIN32_NO_REGISTRY_M_ is like the _ in aTHX_ */
+# define WIN32_NO_REGISTRY_M_(x)
+#else
+# define WIN32_NO_REGISTRY_M_(x) x,
+#endif
+
#define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
#define ENV_IS_CASELESS
@@ -420,7 +430,7 @@ DllExport HWND win32_create_message_window(void);
DllExport int win32_async_check(pTHX);
extern int my_fclose(FILE *);
-extern char * win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len);
extern char * win32_get_sitelib(const char *pl, STRLEN *const len);
extern char * win32_get_vendorlib(const char *pl, STRLEN *const len);
diff --git a/win32/wince.c b/win32/wince.c
index b3c5b52..581a12b 100644
--- a/win32/wince.c
+++ b/win32/wince.c
@@ -232,7 +232,7 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
--
1.7.9.msysgit.0
|
From @bulk88I also have a dream, so that with-registry-on builds, do not use advapi32 for anything except GetUserNameA, the registry lookups instead use Native API, from ntdll.dll. ntdll.dll is in every process, advapi32 is optional. Advapi32's registry API allows you to read/write/modify the registry of another windows computer over a LAN, as easily as your own local registry. But nobody except for MSCE IT depts will ever use remote registry service and DCOM, and Perl has no business using a foreign machine's registry for its ENV var overrides. So the registry lookups go through ntdll.dll, the GetUserNameA stays as part of advapi32 and runs through a delay load of advapi32. (GetUserNameA is a RPC call to LSASS service using NT LPC ports in every implementation, there is no Native [user mode] (ntdll/ntoskrnl) API, the kernel driver API equivalent for GetUserNameA in ksecdd.sys also does LPC port RPC to LSASS, so there is no advantage in not using the public api and ksecdd.sys is not accessible from user mode (not in the SSDT)). GetUserNameA is a simple stub in advapi32 for secur32.dll's GetUserNameExA function. advapi32 itself delay loads secur32.dll if you call advapi32's GetUserNameA. The shim is BOOL __stdcall GetUserNameA(LPSTR lpBuffer, LPDWORD pcbBuffer) Looking at my winxp secur32.dll, I see secur32.dll loads advapi32.dll, so whether you delay load with Perl on GetUserNameA/advapi32.dll or GetUserNameExA/secur32.dll, when you call either both advapi32 and secur32 will wind up being loaded into the perl process in any case, the point is to keep advapi32/secur32.dll/rpcrt4.dll out of the process until you call getlogin. I need to do some research if calling GetUserNameExA/secur32.dll will trigger advapi32 to instantly delay load/bind itself to secur32 or not (perl->DelayLoadDLL@perl522.dll->GetUserNameExA@secur32.dll->FooBar@advapi32.dll->DelayLoadDLL@advapi32.dll->Baz@secur32.dll). If advapi32.dll stays unbound and unaware that secur32.dll is in the process even though secur32.dll is what loaded advapi32.dll into the process, some CPU and maybe a COW mem page (4KB) representing the delay import table in advapi32.dll is saved. Static dynamic linking is more efficient than the VC delay loader code I believe. For example the VC delay loader uses GetProcAddress, and each call to GetProcAddress has to get the DLL Loader mutex, while using static dynamic linking the lock is obtained once inside LoadLibrary() in kernel32/Ldr*() in ntdll. -- |
From @bulk88On Thu May 28 12:49:20 2015, bulk88 wrote:
The USERNAME env var could be used for getlogin instead of advapi32/secur32, but there is a tiny risk someone will mess with the env var in the parent process of perl (a cmd.exe process), or in the perl process at runtime. The USERNAME env var is created in Winlogon.exe, specifically in userenv.dll, userenv.dll calls GetUserNameExW from secur32.dll. No undocumented APIs there for me to try to use. USERNAME env var is then inherited down process tree. Both taskman and explorer, when launches from winlogon/ctl-alt-del screen get USERNAME. Service processes never have USERNAME in their env vars according to process explorer. -- |
From @tonycozOn Thu May 28 10:14:04 2015, bulk88 wrote:
Thanks.
Then initialize ptr at the declaration. Please don't reduce readability for tiny space improvements.
Ok. Tony |
From @bulk88Revised patches attached. Rebased and get_regstr was reworked to use 2 vars instead of 1. -- |
From @bulk880001-stop-checking-the-Win32-registry-if-Software-Perl-do.patchFrom 65bbcb0523102395972ece42cb9a28df8c5cc2fb Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 9 Jul 2015 05:26:33 -0400
Subject: [PATCH 1/2] stop checking the Win32 registry if *"/Software/Perl"
doesn't exist
This stops each ENV var lookup (and 16 calls to get_regstr, most of which
are %ENV lookups, are done automatically each time a Win32 Perl process
starts) from querying the registry for usually failing lookups.
ActiveState is the only known major user of the Software/Perl reg key.
details:
-cache the root handles, so a typically failing env var lookup does only 1
system call instead of 3 if the parent key exists
-if the key exists, looking it up is slightly faster since it is 4
registry syscall instead of previously 6 (open "*\Software\Perl", 2
RegQueryValueExAs(on "found" behavior each RegQueryValueExA does 2
RegQueryValueExW calls), close "*\Software\Perl")
-dont make a system call to lookup a value if the parent key doesn't exist
-reuse the NULL value in the static handle var instead of explictly
assigning NULL to the retval (might save machine code ops), VC 2003 didn't
optimize away the NULL assignment branch like Clang wouldve
-change "Software\\Perl" to "SOFTWARE\\Perl" since the reg is case
preserving but lookups are not case sensitive, this all caps casing is
what regedit shows, and might save a couple cpu cycles in the DB lookup
in the kernel
-use RegOpenKeyExW instead of RegOpenKeyEx (actually RegOpenKeyExA), this
avoids ansi to utf16 conversions at runtime
-dont check HKEY handles for NULL before calling RegCloseKey.
MS and ReactOS RegCloseKey checks for NULL (zero) handle first thing and
returns ERROR_INVALID_HANDLE as the retval of RegCloseKey. MS App Verifier
does not complain about NULL handles.
-Dont check the retval of RegCloseKey, there is no way to dispatch an error
at this point in the process, there are no interps, and no perlio, and
maybe no console if its a GUI, and the process is probably exiting anyway.
Calling Perl_noperl_die (no perl, no perlio, print to stderr) would not
be friendly to an embedder. A crash box with RaiseException with
EXCEPTION_INVALID_HANDLE is a bad UI.
-Dont bother to zero the HKEY handles, after a PERL_SYS_TERM until the
next (if any) PERL_SYS_INIT3, libperl is in an undefined state, it is the
embedders responsibility to refcount and serialize calls to
PERL_SYS_INIT3/PERL_SYS_TERM if necessery
See details in [perl #123658]
---
README.win32 | 11 +++++---
pod/perldelta.pod | 21 +++++++++++++++
win32/win32.c | 75 ++++++++++++++++++++++++++++++++++++-----------------
3 files changed, 79 insertions(+), 28 deletions(-)
diff --git a/README.win32 b/README.win32
index ec29cfa..758289a 100644
--- a/README.win32
+++ b/README.win32
@@ -483,10 +483,13 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. Perl attempts to read entries from
-C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
-Entries in the former override entries in the latter. One or more of the
-following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
+values if you choose to put them there. On Perl process start Perl checks if
+C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
+exist. If the keys exists, they will be checked for remainder of the Perl
+process's run life for certain entries. Entries in
+C<HKEY_CURRENT_USER\Software\Perl> override entries in
+C<HKEY_LOCAL_MACHINE\Software\Perl>. One or more of the following entries
+(of type REG_SZ or REG_EXPAND_SZ) may be set in the keys:
lib-$] version-specific standard library path to add to @INC
lib standard library path to add to @INC
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index ce8768b..320715a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -351,6 +351,27 @@ release of OpenVMS VAX was v7.3 in 2001.
=back
+=item Win32
+
+=over
+
+=item *
+
+The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
+C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
+C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
+checked for entries at all times through Perl processes life time even if they
+did not exist. For performance reasons, now, if the root key (i.e.
+C<HKEY_CURRENT_USER\Software\Perl> or C<HKEY_LOCAL_MACHINE\Software\Perl>) does
+not exist at process start time, it will not be checked again for C<%ENV>
+override entries for the remainder of the Perl processes life. This more
+closely matches Unix behaviour in that the enviroment is copied or inherited on
+startup and changing the variable in the parent process or another process or
+editing <.bashrc> will not change the enviromental variable in other existing,
+running, processes.
+
+=back
+
=back
=head1 Internal Changes
diff --git a/win32/win32.c b/win32/win32.c
index 0bb0348..cc22d8b 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -168,6 +168,10 @@ END_EXTERN_C
static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
+/* initialized by Perl_win32_init/PERL_SYS_INIT */
+static HKEY HKCU_Perl_hnd;
+static HKEY HKLM_Perl_hnd;
+
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -257,34 +261,28 @@ set_w32_module_name(void)
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
-get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
+get_regstr_from(HKEY handle, const char *valuename, SV **svp)
{
/* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
- HKEY handle;
DWORD type;
- const char *subkey = "Software\\Perl";
char *str = NULL;
long retval;
+ DWORD datalen;
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if (retval == ERROR_SUCCESS) {
- DWORD datalen;
- retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
- if (retval == ERROR_SUCCESS
- && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- dTHX;
- if (!*svp)
- *svp = sv_2mortal(newSVpvs(""));
- SvGROW(*svp, datalen);
- retval = RegQueryValueEx(handle, valuename, 0, NULL,
- (PBYTE)SvPVX(*svp), &datalen);
- if (retval == ERROR_SUCCESS) {
- str = SvPVX(*svp);
- SvCUR_set(*svp,datalen-1);
- }
+ retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
+ if (retval == ERROR_SUCCESS
+ && (type == REG_SZ || type == REG_EXPAND_SZ))
+ {
+ dTHX;
+ if (!*svp)
+ *svp = sv_2mortal(newSVpvs(""));
+ SvGROW(*svp, datalen);
+ retval = RegQueryValueEx(handle, valuename, 0, NULL,
+ (PBYTE)SvPVX(*svp), &datalen);
+ if (retval == ERROR_SUCCESS) {
+ str = SvPVX(*svp);
+ SvCUR_set(*svp,datalen-1);
}
- RegCloseKey(handle);
}
return str;
}
@@ -293,11 +291,24 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
static char*
get_regstr(const char *valuename, SV **svp)
{
- char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
- if (!str)
- str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
+ char *str;
+ if (HKCU_Perl_hnd) {
+ str = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
+ if (!str)
+ goto try_HKLM;
+ }
+ else {
+ HKEY hkey;
+ try_HKLM:
+ hkey = HKLM_Perl_hnd;
+ if (hkey)
+ str = get_regstr_from(hkey, valuename, svp);
+ else
+ str = (char*)hkey; /* source of NULL without litteral NULL constant */
+ }
return str;
}
+#endif /* ifndef WIN32_NO_REGISTRY */
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
static char *
@@ -4444,6 +4455,17 @@ Perl_win32_init(int *argcp, char ***argvp)
#endif
ansify_path();
+ {
+ LONG retval;
+ retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKCU_Perl_hnd = NULL;
+ }
+ retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKLM_Perl_hnd = NULL;
+ }
+ }
}
void
@@ -4453,6 +4475,11 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+ /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
+ but no point of checking and we can't die() at this point */
+ RegCloseKey(HKLM_Perl_hnd);
+ RegCloseKey(HKCU_Perl_hnd);
+ /* the handles are in an undefined state until the next PERL_SYS_INIT3 */
}
void
--
1.7.9.msysgit.0
|
From @bulk880002-add-Win32-USE_NO_REGISTRY-build-option.patchFrom fa4501d0da752ad188a78d4f42365784120390dd Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 9 Jul 2015 05:29:20 -0400
Subject: [PATCH 2/2] add Win32 USE_NO_REGISTRY build option
-the first arg of win32_get_privlib is not used if the registry is not
queried, create a macro to allow the arg to drop out on WIN32_NO_REGISTRY
builds for efficiency and not to have unused C litteral strings in the
binary
-This patch changes the ABI of
PerlEnv_lib_path/PerlEnvLibPath/win32_get_privlib between USE_NO_REGISTRY
and no USE_NO_REGISTRY. Since win32_get_privlib is not exported from
perl523.dll, assume it and PerlEnv_lib_path are not public API, note
technically PerlEnv_lib_path will be callable only on PERL_IMPLICIT_SYS
builds, on no PERL_IMPLICIT_SYS builds it will fail at link time since
win32_get_privlib isnt exported. Therefore place it in
non-[affecting]-binary compatibility even though it does affect binary
compatibility.
-delay load advapi32.dll to save startup time (loading the DLL and the DLL
calling its initializers in DllMain) and one 4 KB memory page for
advapi32's .data section (doing "perl -E"sleep 100" on WinXP shows
advapi32 has a 20KB long .data section, first 4 KB are unique to the
process, the remaining 16KB are COW shared between processes according
to vmmap tool), putting a DebugBreak() in pp_getlogin and doing a
"nmake all" shows miniperl never calls getlogin during the build process.
An nmake test shows only ext/POSIX/t/wrappers.t and lib/warnings.t execute
pp_getlogin. Keeping advapi32.dll out of the perl process requires
removing comctl32.dll, since comctrl32.dll loads advapi32.dll, from perl
which I always do as a custom patch.
filed as [perl #123658]
XXXXXXXXXXXXXXXXXXXXXXX
---
README.win32 | 3 ++-
iperlsys.h | 6 +++---
perl.c | 3 +++
pod/perldelta.pod | 8 ++++++++
win32/Makefile | 26 +++++++++++++++++++++++++-
win32/makefile.mk | 23 ++++++++++++++++++++++-
win32/perlhost.h | 4 ++--
win32/win32.c | 37 ++++++++++++++++++++++++++++++-------
win32/win32.h | 12 +++++++++++-
win32/wince.c | 2 +-
10 files changed, 107 insertions(+), 17 deletions(-)
diff --git a/README.win32 b/README.win32
index 758289a..0a63f8c 100644
--- a/README.win32
+++ b/README.win32
@@ -483,7 +483,8 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. On Perl process start Perl checks if
+values if you choose to put them there unless disabled at build time with
+USE_NO_REGISTRY. On Perl process start Perl checks if
C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
exist. If the keys exists, they will be checked for remainder of the Perl
process's run life for certain entries. Entries in
diff --git a/iperlsys.h b/iperlsys.h
index 57160e0..99f27c3 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -478,7 +478,7 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*,
#endif
#ifdef WIN32
typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
-typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*,
+typedef char* (*LPEnvLibPath)(struct IPerlEnv*, WIN32_NO_REGISTRY_M_(const char*)
STRLEN *const len);
typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*,
STRLEN *const len);
@@ -550,7 +550,7 @@ struct IPerlEnvInfo
#define PerlEnv_os_id() \
(*PL_Env->pEnvOsID)(PL_Env)
#define PerlEnv_lib_path(str, lenp) \
- (*PL_Env->pLibPath)(PL_Env,(str),(lenp))
+ (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp))
#define PerlEnv_sitelib_path(str, lenp) \
(*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp))
#define PerlEnv_vendorlib_path(str, lenp) \
@@ -575,7 +575,7 @@ struct IPerlEnvInfo
#ifdef WIN32
#define PerlEnv_os_id() win32_os_id()
-#define PerlEnv_lib_path(str, lenp) win32_get_privlib(str, lenp)
+#define PerlEnv_lib_path(str, lenp) win32_get_privlib(WIN32_NO_REGISTRY_M_(str) lenp)
#define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp)
#define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp)
#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
diff --git a/perl.c b/perl.c
index cbb66e0..659be60 100644
--- a/perl.c
+++ b/perl.c
@@ -1779,6 +1779,9 @@ S_Internals_V(pTHX_ CV *cv)
# ifdef USE_LOCALE_CTYPE
" USE_LOCALE_CTYPE"
# endif
+# ifdef WIN32_NO_REGISTRY
+ " USE_NO_REGISTRY"
+# endif
# ifdef USE_PERL_ATOF
" USE_PERL_ATOF"
# endif
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 320715a..db26974 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -357,6 +357,14 @@ release of OpenVMS VAX was v7.3 in 2001.
=item *
+A new build option C<USE_NO_REGISTRY> has been added to the makefiles. This
+option is off by default, meaning the default is to do Windows registry lookups.
+This option stops Perl from looking inside the registry for anything. For what
+values are looked up in the registry see L<perlwin32>. Internally, in C, the
+name of this option is C<WIN32_NO_REGISTRY>.
+
+=item *
+
The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
diff --git a/win32/Makefile b/win32/Makefile
index ac7c0b5..70df977 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -96,6 +96,13 @@ USE_LARGE_FILES = define
#USE_64_BIT_INT = define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY = define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.x (aka Visual C++ 98)
@@ -294,6 +301,10 @@ USE_LARGE_FILES = undef
USE_64_BIT_INT = undef
!ENDIF
+!IF "$(USE_NO_REGISTRY)" == ""
+USE_NO_REGISTRY = undef
+!ENDIF
+
!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
@@ -314,6 +325,10 @@ BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
!ENDIF
+!IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT = $(BUILDOPT) -DWIN32_NO_REGISTRY
+!ENDIF
+
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
PROCESSOR_ARCHITECTURE = x86
!ENDIF
@@ -388,7 +403,16 @@ ARCHNAME = $(ARCHNAME)-64int
# All but the free version of VC++ 7.x can load DLLs on demand. Makes the test
# suite run in about 10% less time.
!IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+!IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+!ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+!ENDIF
!ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and
@@ -1021,7 +1045,7 @@ $(MINIPERL) : ..\lib\buildcustomize.pl
..\lib\buildcustomize.pl : $(MINIDIR) $(MINI_OBJ) ..\write_buildcustomize.pl
$(LINK32) -out:$(MINIPERL) @<<
- $(BLINK_FLAGS) $(DELAYLOAD) $(LIBFILES) $(MINI_OBJ)
+ $(BLINK_FLAGS) $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBFILES) $(MINI_OBJ)
<<
$(EMBED_EXE_MANI:..\lib\buildcustomize.pl=..\miniperl.exe)
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 11a3ff7..4ba67c2 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -108,6 +108,13 @@ USE_LARGE_FILES *= define
#USE_LONG_DOUBLE *=define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY *=define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.x (aka Visual C++ 98)
@@ -310,6 +317,7 @@ USE_IMP_SYS *= undef
USE_LARGE_FILES *= undef
USE_64_BIT_INT *= undef
USE_LONG_DOUBLE *= undef
+USE_NO_REGISTRY *= undef
.IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
@@ -343,6 +351,10 @@ BUILDOPT += -DPERL_IMPLICIT_CONTEXT
BUILDOPT += -DPERL_IMPLICIT_SYS
.ENDIF
+.IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT += -DWIN32_NO_REGISTRY
+.ENDIF
+
PROCESSOR_ARCHITECTURE *= x86
.IF "$(WIN64)" == ""
@@ -519,7 +531,16 @@ TESTPREPGCC = test-prep-gcc
# All but the free version of VC++ 7.x can load DLLs on demand. Makes the test
# suite run in about 10% less time.
.IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+.IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+.ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+.ENDIF
.ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.x and 9.x) create manifest files for EXEs and
@@ -1261,7 +1282,7 @@ $(MINIPERL) : ..\lib\buildcustomize.pl
$(mktmp $(LKPRE) $(MINI_OBJ) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -out:$(MINIPERL) $(BLINK_FLAGS) \
- @$(mktmp $(DELAYLOAD) $(LIBFILES) $(MINI_OBJ))
+ @$(mktmp $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBFILES) $(MINI_OBJ))
$(EMBED_EXE_MANI:s/$@/$(MINIPERL)/)
.ENDIF
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 7a0c3b3..ce31f69 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -514,9 +514,9 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
+PerlEnvLibPath(struct IPerlEnv* piPerl, WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
- return win32_get_privlib(pl, len);
+ return win32_get_privlib(WIN32_NO_REGISTRY_M_(pl) len);
}
char*
diff --git a/win32/win32.c b/win32/win32.c
index cc22d8b..dedcef3 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -115,12 +115,17 @@ static void my_invalid_parameter_handler(const wchar_t* expression,
unsigned int line, uintptr_t pReserved);
#endif
+#ifndef WIN32_NO_REGISTRY
static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp);
static char* get_regstr(const char *valuename, SV **svp);
+#endif
+
static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
char *trailing, ...);
-static char* win32_get_xlib(const char *pl, const char *xlib,
+static char* win32_get_xlib(const char *pl,
+ WIN32_NO_REGISTRY_M_(const char *xlib)
const char *libname, STRLEN *const len);
+
static BOOL has_shell_metachars(const char *ptr);
static long tokenize(const char *str, char **dest, char ***destv);
static void get_shell(void);
@@ -168,9 +173,11 @@ END_EXTERN_C
static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
+#ifndef WIN32_NO_REGISTRY
/* initialized by Perl_win32_init/PERL_SYS_INIT */
static HKEY HKCU_Perl_hnd;
static HKEY HKLM_Perl_hnd;
+#endif
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -259,6 +266,7 @@ set_w32_module_name(void)
}
}
+#ifndef WIN32_NO_REGISTRY
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
get_regstr_from(HKEY handle, const char *valuename, SV **svp)
@@ -378,41 +386,49 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
EXTERN_C char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
char *stdlib = "lib";
- char buffer[MAX_PATH+1];
SV *sv = NULL;
+#ifndef WIN32_NO_REGISTRY
+ char buffer[MAX_PATH+1];
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
if (!get_regstr(buffer, &sv))
(void)get_regstr(stdlib, &sv);
+#endif
/* $stdlib .= ";$EMD/../../lib" */
return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
}
static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname,
- STRLEN *const len)
+win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib)
+ const char *libname, STRLEN *const len)
{
+#ifndef WIN32_NO_REGISTRY
char regstr[40];
+#endif
char pathstr[MAX_PATH+1];
SV *sv1 = NULL;
SV *sv2 = NULL;
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
sprintf(regstr, "%s-%s", xlib, pl);
(void)get_regstr(regstr, &sv1);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
(void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
@@ -437,7 +453,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
EXTERN_C char *
win32_get_sitelib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "sitelib", "site", len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("sitelib") "site", len);
}
#ifndef PERL_VENDORLIB_NAME
@@ -447,7 +463,7 @@ win32_get_sitelib(const char *pl, STRLEN *const len)
EXTERN_C char *
win32_get_vendorlib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("vendorlib") PERL_VENDORLIB_NAME, len);
}
static BOOL
@@ -1828,12 +1844,14 @@ win32_getenv(const char *name)
}
FreeEnvironmentStrings(envv);
}
+#ifndef WIN32_NO_REGISTRY
else {
/* last ditch: allow any environment variables that begin with 'PERL'
to be obtained from the registry, if found there */
if (strncmp(name, "PERL", 4) == 0)
(void)get_regstr(name, &curitem);
}
+#endif
}
if (curitem && SvCUR(curitem))
return SvPVX(curitem);
@@ -4455,6 +4473,8 @@ Perl_win32_init(int *argcp, char ***argvp)
#endif
ansify_path();
+
+#ifndef WIN32_NO_REGISTRY
{
LONG retval;
retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
@@ -4466,6 +4486,7 @@ Perl_win32_init(int *argcp, char ***argvp)
HKLM_Perl_hnd = NULL;
}
}
+#endif
}
void
@@ -4475,11 +4496,13 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+#ifndef WIN32_NO_REGISTRY
/* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
but no point of checking and we can't die() at this point */
RegCloseKey(HKLM_Perl_hnd);
RegCloseKey(HKCU_Perl_hnd);
/* the handles are in an undefined state until the next PERL_SYS_INIT3 */
+#endif
}
void
diff --git a/win32/win32.h b/win32/win32.h
index 3b35b6c..e997651 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -24,6 +24,9 @@
/* less I/O calls during each require */
# define PERL_DISABLE_PMC
+/* unnecessery for miniperl to lookup anything from an "installed" perl */
+# define WIN32_NO_REGISTRY
+
/* allow minitest to work */
# define PERL_TEXTMODE_SCRIPTS
#endif
@@ -206,6 +209,13 @@ struct utsname {
# define PERL_SOCK_SYSWRITE_IS_SEND
#endif
+#ifdef WIN32_NO_REGISTRY
+/* the last _ in WIN32_NO_REGISTRY_M_ is like the _ in aTHX_ */
+# define WIN32_NO_REGISTRY_M_(x)
+#else
+# define WIN32_NO_REGISTRY_M_(x) x,
+#endif
+
#define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
#define ENV_IS_CASELESS
@@ -394,7 +404,7 @@ DllExport HWND win32_create_message_window(void);
DllExport int win32_async_check(pTHX);
extern int my_fclose(FILE *);
-extern char * win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len);
extern char * win32_get_sitelib(const char *pl, STRLEN *const len);
extern char * win32_get_vendorlib(const char *pl, STRLEN *const len);
diff --git a/win32/wince.c b/win32/wince.c
index b3c5b52..581a12b 100644
--- a/win32/wince.c
+++ b/win32/wince.c
@@ -232,7 +232,7 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
--
1.7.9.msysgit.0
|
From @bulk88On Thu Jul 09 03:01:53 2015, bulk88 wrote:
Eghh "[PATCH 2/2] add Win32 USE_NO_REGISTRY build option "'s commit message has a line of "XXXXXXXXXXXXXXXXXXXXXXX" I left in by accident. I'll leave it to the committer to remove. -- |
From @bulk88On Thu Jul 09 03:17:40 2015, bulk88 wrote:
Bump. -- |
From @bulk88On Sun Aug 02 21:15:26 2015, bulk88 wrote:
-- |
From @tonycozOn Thu Jul 09 03:01:53 2015, bulk88 wrote:
You haven't addressed: Please don't reduce readability for tiny space improvements. get_regstr(const char *valuename, SV **svp) Tony |
From @bulk88On Sun Aug 16 18:30:18 2015, tonyc wrote:
revised get_regstr patches attached -- |
From @bulk880001-stop-checking-the-Win32-registry-if-Software-Perl-do.patchFrom 84c1f3d46cd6612a2ce796e645afaaba49feedee Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Wed, 30 Sep 2015 05:28:54 -0400
Subject: [PATCH 1/2] stop checking the Win32 registry if *"/Software/Perl"
doesn't exist
This stops each ENV var lookup (and 16 calls to get_regstr, most of which
are %ENV lookups, are done automatically each time a Win32 Perl process
starts) from querying the registry for usually failing lookups.
ActiveState is the only known major user of the Software/Perl reg key.
details:
-cache the root handles, so a typically failing env var lookup does only 1
system call instead of 3 if the parent key exists
-if the key exists, looking it up is slightly faster since it is 4
registry syscall instead of previously 6 (open "*\Software\Perl", 2
RegQueryValueExAs(on "found" behavior each RegQueryValueExA does 2
RegQueryValueExW calls), close "*\Software\Perl")
-dont make a system call to lookup a value if the parent key doesn't exist
-change "Software\\Perl" to "SOFTWARE\\Perl" since the reg is case
preserving but lookups are not case sensitive, this all caps casing is
what regedit shows, and might save a couple cpu cycles in the DB lookup
in the kernel
-use RegOpenKeyExW instead of RegOpenKeyEx (actually RegOpenKeyExA), this
avoids ansi to utf16 conversions at runtime
-dont check HKEY handles for NULL before calling RegCloseKey.
MS and ReactOS RegCloseKey checks for NULL (zero) handle first thing and
returns ERROR_INVALID_HANDLE as the retval of RegCloseKey. MS App Verifier
does not complain about NULL handles.
-Dont check the retval of RegCloseKey, there is no way to dispatch an error
at this point in the process, there are no interps, and no perlio, and
maybe no console if its a GUI, and the process is probably exiting anyway.
Calling Perl_noperl_die (no perl, no perlio, print to stderr) would not
be friendly to an embedder. A crash box with RaiseException with
EXCEPTION_INVALID_HANDLE is a bad UI.
-Dont bother to zero the HKEY handles, after a PERL_SYS_TERM until the
next (if any) PERL_SYS_INIT3, libperl is in an undefined state, it is the
embedders responsibility to refcount and serialize calls to
PERL_SYS_INIT3/PERL_SYS_TERM if necessary
See details in [perl #123658]
---
README.win32 | 11 +++++---
pod/perldelta.pod | 21 +++++++++++++++
win32/win32.c | 72 +++++++++++++++++++++++++++++++++++-----------------
3 files changed, 76 insertions(+), 28 deletions(-)
diff --git a/README.win32 b/README.win32
index 2a8651a..7e65653 100644
--- a/README.win32
+++ b/README.win32
@@ -485,10 +485,13 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. Perl attempts to read entries from
-C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
-Entries in the former override entries in the latter. One or more of the
-following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
+values if you choose to put them there. On Perl process start Perl checks if
+C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
+exist. If the keys exists, they will be checked for remainder of the Perl
+process's run life for certain entries. Entries in
+C<HKEY_CURRENT_USER\Software\Perl> override entries in
+C<HKEY_LOCAL_MACHINE\Software\Perl>. One or more of the following entries
+(of type REG_SZ or REG_EXPAND_SZ) may be set in the keys:
lib-$] version-specific standard library path to add to @INC
lib standard library path to add to @INC
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index db9e601..b798fe1 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -309,6 +309,27 @@ L</Modules and Pragmata> section.
XXX
+=item Win32
+
+=over
+
+=item *
+
+The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
+C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
+C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
+checked for entries at all times through Perl processes life time even if they
+did not exist. For performance reasons, now, if the root key (i.e.
+C<HKEY_CURRENT_USER\Software\Perl> or C<HKEY_LOCAL_MACHINE\Software\Perl>) does
+not exist at process start time, it will not be checked again for C<%ENV>
+override entries for the remainder of the Perl processes life. This more
+closely matches Unix behaviour in that the enviroment is copied or inherited on
+startup and changing the variable in the parent process or another process or
+editing <.bashrc> will not change the enviromental variable in other existing,
+running, processes.
+
+=back
+
=back
=head1 Internal Changes
diff --git a/win32/win32.c b/win32/win32.c
index 2b883a2..466922f 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -167,6 +167,10 @@ END_EXTERN_C
static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
+/* initialized by Perl_win32_init/PERL_SYS_INIT */
+static HKEY HKCU_Perl_hnd;
+static HKEY HKLM_Perl_hnd;
+
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -256,34 +260,28 @@ set_w32_module_name(void)
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
-get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
+get_regstr_from(HKEY handle, const char *valuename, SV **svp)
{
/* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
- HKEY handle;
DWORD type;
- const char *subkey = "Software\\Perl";
char *str = NULL;
long retval;
+ DWORD datalen;
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if (retval == ERROR_SUCCESS) {
- DWORD datalen;
- retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
- if (retval == ERROR_SUCCESS
- && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- dTHX;
- if (!*svp)
- *svp = sv_2mortal(newSVpvs(""));
- SvGROW(*svp, datalen);
- retval = RegQueryValueEx(handle, valuename, 0, NULL,
- (PBYTE)SvPVX(*svp), &datalen);
- if (retval == ERROR_SUCCESS) {
- str = SvPVX(*svp);
- SvCUR_set(*svp,datalen-1);
- }
+ retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
+ if (retval == ERROR_SUCCESS
+ && (type == REG_SZ || type == REG_EXPAND_SZ))
+ {
+ dTHX;
+ if (!*svp)
+ *svp = sv_2mortal(newSVpvs(""));
+ SvGROW(*svp, datalen);
+ retval = RegQueryValueEx(handle, valuename, 0, NULL,
+ (PBYTE)SvPVX(*svp), &datalen);
+ if (retval == ERROR_SUCCESS) {
+ str = SvPVX(*svp);
+ SvCUR_set(*svp,datalen-1);
}
- RegCloseKey(handle);
}
return str;
}
@@ -292,9 +290,19 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
static char*
get_regstr(const char *valuename, SV **svp)
{
- char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
- if (!str)
- str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
+ char *str;
+ if (HKCU_Perl_hnd) {
+ str = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
+ if (!str)
+ goto try_HKLM;
+ }
+ else {
+ try_HKLM:
+ if (HKLM_Perl_hnd)
+ str = get_regstr_from(HKLM_Perl_hnd, valuename, svp);
+ else
+ str = NULL;
+ }
return str;
}
@@ -4443,6 +4451,17 @@ Perl_win32_init(int *argcp, char ***argvp)
#endif
ansify_path();
+ {
+ LONG retval;
+ retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKCU_Perl_hnd = NULL;
+ }
+ retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd);
+ if (retval != ERROR_SUCCESS) {
+ HKLM_Perl_hnd = NULL;
+ }
+ }
}
void
@@ -4452,6 +4471,11 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+ /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
+ but no point of checking and we can't die() at this point */
+ RegCloseKey(HKLM_Perl_hnd);
+ RegCloseKey(HKCU_Perl_hnd);
+ /* the handles are in an undefined state until the next PERL_SYS_INIT3 */
}
void
--
1.7.9.msysgit.0
|
From @bulk880002-add-Win32-USE_NO_REGISTRY-build-option.patchFrom a9b9b2202aa94dcc05afa882e50c1a18f341ef43 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Wed, 30 Sep 2015 05:36:51 -0400
Subject: [PATCH 2/2] add Win32 USE_NO_REGISTRY build option
-the first arg of win32_get_privlib is not used if the registry is not
queried, create a macro to allow the arg to drop out on WIN32_NO_REGISTRY
builds for efficiency and not to have unused C litteral strings in the
binary
-This patch changes the ABI of
PerlEnv_lib_path/PerlEnvLibPath/win32_get_privlib between USE_NO_REGISTRY
and no USE_NO_REGISTRY. Since win32_get_privlib is not exported from
perl523.dll, assume it and PerlEnv_lib_path are not public API, note
technically PerlEnv_lib_path will be callable only on PERL_IMPLICIT_SYS
builds, on no PERL_IMPLICIT_SYS builds it will fail at link time since
win32_get_privlib isnt exported. Therefore place it in
non-[affecting]-binary compatibility even though it does affect binary
compatibility.
-delay load advapi32.dll to save startup time (loading the DLL and the DLL
calling its initializers in DllMain) and one 4 KB memory page for
advapi32's .data section (doing "perl -E"sleep 100" on WinXP shows
advapi32 has a 20KB long .data section, first 4 KB are unique to the
process, the remaining 16KB are COW shared between processes according
to vmmap tool), putting a DebugBreak() in pp_getlogin and doing a
"nmake all" shows miniperl never calls getlogin during the build process.
An nmake test shows only ext/POSIX/t/wrappers.t and lib/warnings.t execute
pp_getlogin. Keeping advapi32.dll out of the perl process requires
removing comctl32.dll, since comctrl32.dll loads advapi32.dll, from perl
which I always do as a custom patch.
filed as [perl #123658]
XXXXXXXXXXXXXXXXXXXXXXX
---
README.win32 | 3 ++-
iperlsys.h | 6 +++---
perl.c | 3 +++
pod/perldelta.pod | 8 ++++++++
win32/Makefile | 26 +++++++++++++++++++++++++-
win32/makefile.mk | 23 ++++++++++++++++++++++-
win32/perlhost.h | 4 ++--
win32/win32.c | 38 +++++++++++++++++++++++++++++++-------
win32/win32.h | 12 +++++++++++-
win32/wince.c | 2 +-
10 files changed, 108 insertions(+), 17 deletions(-)
diff --git a/README.win32 b/README.win32
index 7e65653..6726019 100644
--- a/README.win32
+++ b/README.win32
@@ -485,7 +485,8 @@ You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
-values if you choose to put them there. On Perl process start Perl checks if
+values if you choose to put them there unless disabled at build time with
+USE_NO_REGISTRY. On Perl process start Perl checks if
C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>
exist. If the keys exists, they will be checked for remainder of the Perl
process's run life for certain entries. Entries in
diff --git a/iperlsys.h b/iperlsys.h
index 3aee24f..86ab687 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -478,7 +478,7 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*,
#endif
#ifdef WIN32
typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
-typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*,
+typedef char* (*LPEnvLibPath)(struct IPerlEnv*, WIN32_NO_REGISTRY_M_(const char*)
STRLEN *const len);
typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*,
STRLEN *const len);
@@ -550,7 +550,7 @@ struct IPerlEnvInfo
#define PerlEnv_os_id() \
(*PL_Env->pEnvOsID)(PL_Env)
#define PerlEnv_lib_path(str, lenp) \
- (*PL_Env->pLibPath)(PL_Env,(str),(lenp))
+ (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp))
#define PerlEnv_sitelib_path(str, lenp) \
(*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp))
#define PerlEnv_vendorlib_path(str, lenp) \
@@ -575,7 +575,7 @@ struct IPerlEnvInfo
#ifdef WIN32
#define PerlEnv_os_id() win32_os_id()
-#define PerlEnv_lib_path(str, lenp) win32_get_privlib(str, lenp)
+#define PerlEnv_lib_path(str, lenp) win32_get_privlib(WIN32_NO_REGISTRY_M_(str) lenp)
#define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp)
#define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp)
#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
diff --git a/perl.c b/perl.c
index 1bd2cbb..1d2ec91 100644
--- a/perl.c
+++ b/perl.c
@@ -1787,6 +1787,9 @@ S_Internals_V(pTHX_ CV *cv)
# ifdef USE_LOCALE_CTYPE
" USE_LOCALE_CTYPE"
# endif
+# ifdef WIN32_NO_REGISTRY
+ " USE_NO_REGISTRY"
+# endif
# ifdef USE_PERL_ATOF
" USE_PERL_ATOF"
# endif
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index b798fe1..a5e7055 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -315,6 +315,14 @@ XXX
=item *
+A new build option C<USE_NO_REGISTRY> has been added to the makefiles. This
+option is off by default, meaning the default is to do Windows registry lookups.
+This option stops Perl from looking inside the registry for anything. For what
+values are looked up in the registry see L<perlwin32>. Internally, in C, the
+name of this option is C<WIN32_NO_REGISTRY>.
+
+=item *
+
The behavior of Perl using C<HKEY_CURRENT_USER\Software\Perl> and
C<HKEY_LOCAL_MACHINE\Software\Perl> to lookup certain values, including
C<%ENV> vars starting with C<PERL> has changed. Previously, the 2 keys were
diff --git a/win32/Makefile b/win32/Makefile
index 1a66403..787d888 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -96,6 +96,13 @@ USE_LARGE_FILES = define
#USE_64_BIT_INT = define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY = define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.0 (aka Visual C++ 98)
@@ -294,6 +301,10 @@ USE_LARGE_FILES = undef
USE_64_BIT_INT = undef
!ENDIF
+!IF "$(USE_NO_REGISTRY)" == ""
+USE_NO_REGISTRY = undef
+!ENDIF
+
!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
@@ -314,6 +325,10 @@ BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
!ENDIF
+!IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT = $(BUILDOPT) -DWIN32_NO_REGISTRY
+!ENDIF
+
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
PROCESSOR_ARCHITECTURE = x86
!ENDIF
@@ -388,7 +403,16 @@ ARCHNAME = $(ARCHNAME)-64int
# All but the free version of VC++ 7.1 can load DLLs on demand. Makes the test
# suite run in about 10% less time.
!IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+!IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+!ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+!ENDIF
!ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.0 and 9.0) create manifest files for EXEs and
@@ -1023,7 +1047,7 @@ $(MINIPERL) : ..\lib\buildcustomize.pl
..\lib\buildcustomize.pl : $(MINIDIR) $(MINI_OBJ) ..\write_buildcustomize.pl
$(LINK32) -out:$(MINIPERL) @<<
- $(BLINK_FLAGS) $(DELAYLOAD) $(LIBFILES) $(MINI_OBJ)
+ $(BLINK_FLAGS) $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBFILES) $(MINI_OBJ)
<<
$(EMBED_EXE_MANI:..\lib\buildcustomize.pl=..\miniperl.exe)
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 543cb93..83850c3 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -108,6 +108,13 @@ USE_LARGE_FILES *= define
#USE_LONG_DOUBLE *=define
#
+# Uncomment this if you want to disable looking up values from
+# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in
+# the Registry.
+#
+#USE_NO_REGISTRY *=define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 6.0 (aka Visual C++ 98)
@@ -310,6 +317,7 @@ USE_IMP_SYS *= undef
USE_LARGE_FILES *= undef
USE_64_BIT_INT *= undef
USE_LONG_DOUBLE *= undef
+USE_NO_REGISTRY *= undef
.IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
@@ -343,6 +351,10 @@ BUILDOPT += -DPERL_IMPLICIT_CONTEXT
BUILDOPT += -DPERL_IMPLICIT_SYS
.ENDIF
+.IF "$(USE_NO_REGISTRY)" != "undef"
+BUILDOPT += -DWIN32_NO_REGISTRY
+.ENDIF
+
PROCESSOR_ARCHITECTURE *= x86
.IF "$(WIN64)" == "undef"
@@ -524,7 +536,16 @@ TESTPREPGCC = test-prep-gcc
# All but the free version of VC++ 7.1 can load DLLs on demand. Makes the test
# suite run in about 10% less time.
.IF "$(CCTYPE)" != "MSVC70FREE"
+# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA
+# which is rare to execute
+.IF "$(USE_NO_REGISTRY)" != "undef"
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib
+MINIDELAYLOAD =
+.ELSE
DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib
+#miniperl never does any registry lookups
+MINIDELAYLOAD = -DELAYLOAD:advapi32.dll
+.ENDIF
.ENDIF
# Visual C++ 2005 and 2008 (VC++ 8.0 and 9.0) create manifest files for EXEs and
@@ -1116,7 +1137,7 @@ $(CONFIGPM): ..\config.sh config_h.PL
$(mktmp $(LKPRE) $(MINI_OBJ) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -out:$(MINIPERL) $(BLINK_FLAGS) \
- @$(mktmp $(DELAYLOAD) $(LIBFILES) $(MINI_OBJ))
+ @$(mktmp $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBFILES) $(MINI_OBJ))
$(EMBED_EXE_MANI:s/$@/$(MINIPERL)/)
.ENDIF
$(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl ..
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 7a0c3b3..ce31f69 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -514,9 +514,9 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
+PerlEnvLibPath(struct IPerlEnv* piPerl, WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
- return win32_get_privlib(pl, len);
+ return win32_get_privlib(WIN32_NO_REGISTRY_M_(pl) len);
}
char*
diff --git a/win32/win32.c b/win32/win32.c
index 466922f..a3e1754 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -114,12 +114,17 @@ static void my_invalid_parameter_handler(const wchar_t* expression,
unsigned int line, uintptr_t pReserved);
#endif
+#ifndef WIN32_NO_REGISTRY
static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp);
static char* get_regstr(const char *valuename, SV **svp);
+#endif
+
static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
char *trailing, ...);
-static char* win32_get_xlib(const char *pl, const char *xlib,
+static char* win32_get_xlib(const char *pl,
+ WIN32_NO_REGISTRY_M_(const char *xlib)
const char *libname, STRLEN *const len);
+
static BOOL has_shell_metachars(const char *ptr);
static long tokenize(const char *str, char **dest, char ***destv);
static void get_shell(void);
@@ -167,9 +172,11 @@ END_EXTERN_C
static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
+#ifndef WIN32_NO_REGISTRY
/* initialized by Perl_win32_init/PERL_SYS_INIT */
static HKEY HKCU_Perl_hnd;
static HKEY HKLM_Perl_hnd;
+#endif
#ifdef SET_INVALID_PARAMETER_HANDLER
static BOOL silent_invalid_parameter_handler = FALSE;
@@ -258,6 +265,7 @@ set_w32_module_name(void)
}
}
+#ifndef WIN32_NO_REGISTRY
/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
static char*
get_regstr_from(HKEY handle, const char *valuename, SV **svp)
@@ -305,6 +313,7 @@ get_regstr(const char *valuename, SV **svp)
}
return str;
}
+#endif /* ifndef WIN32_NO_REGISTRY */
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
static char *
@@ -374,41 +383,49 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
EXTERN_C char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
char *stdlib = "lib";
- char buffer[MAX_PATH+1];
SV *sv = NULL;
+#ifndef WIN32_NO_REGISTRY
+ char buffer[MAX_PATH+1];
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
if (!get_regstr(buffer, &sv))
(void)get_regstr(stdlib, &sv);
+#endif
/* $stdlib .= ";$EMD/../../lib" */
return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
}
static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname,
- STRLEN *const len)
+win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib)
+ const char *libname, STRLEN *const len)
{
+#ifndef WIN32_NO_REGISTRY
char regstr[40];
+#endif
char pathstr[MAX_PATH+1];
SV *sv1 = NULL;
SV *sv2 = NULL;
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
sprintf(regstr, "%s-%s", xlib, pl);
(void)get_regstr(regstr, &sv1);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
(void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
+#ifndef WIN32_NO_REGISTRY
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
+#endif
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
@@ -433,7 +450,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
EXTERN_C char *
win32_get_sitelib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "sitelib", "site", len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("sitelib") "site", len);
}
#ifndef PERL_VENDORLIB_NAME
@@ -443,7 +460,7 @@ win32_get_sitelib(const char *pl, STRLEN *const len)
EXTERN_C char *
win32_get_vendorlib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
+ return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("vendorlib") PERL_VENDORLIB_NAME, len);
}
static BOOL
@@ -1824,12 +1841,14 @@ win32_getenv(const char *name)
}
FreeEnvironmentStrings(envv);
}
+#ifndef WIN32_NO_REGISTRY
else {
/* last ditch: allow any environment variables that begin with 'PERL'
to be obtained from the registry, if found there */
if (strncmp(name, "PERL", 4) == 0)
(void)get_regstr(name, &curitem);
}
+#endif
}
if (curitem && SvCUR(curitem))
return SvPVX(curitem);
@@ -4451,6 +4470,8 @@ Perl_win32_init(int *argcp, char ***argvp)
#endif
ansify_path();
+
+#ifndef WIN32_NO_REGISTRY
{
LONG retval;
retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
@@ -4462,6 +4483,7 @@ Perl_win32_init(int *argcp, char ***argvp)
HKLM_Perl_hnd = NULL;
}
}
+#endif
}
void
@@ -4471,11 +4493,13 @@ Perl_win32_term(void)
OP_REFCNT_TERM;
PERLIO_TERM;
MALLOC_TERM;
+#ifndef WIN32_NO_REGISTRY
/* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
but no point of checking and we can't die() at this point */
RegCloseKey(HKLM_Perl_hnd);
RegCloseKey(HKCU_Perl_hnd);
/* the handles are in an undefined state until the next PERL_SYS_INIT3 */
+#endif
}
void
diff --git a/win32/win32.h b/win32/win32.h
index 3b35b6c..e997651 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -24,6 +24,9 @@
/* less I/O calls during each require */
# define PERL_DISABLE_PMC
+/* unnecessery for miniperl to lookup anything from an "installed" perl */
+# define WIN32_NO_REGISTRY
+
/* allow minitest to work */
# define PERL_TEXTMODE_SCRIPTS
#endif
@@ -206,6 +209,13 @@ struct utsname {
# define PERL_SOCK_SYSWRITE_IS_SEND
#endif
+#ifdef WIN32_NO_REGISTRY
+/* the last _ in WIN32_NO_REGISTRY_M_ is like the _ in aTHX_ */
+# define WIN32_NO_REGISTRY_M_(x)
+#else
+# define WIN32_NO_REGISTRY_M_(x) x,
+#endif
+
#define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
#define ENV_IS_CASELESS
@@ -394,7 +404,7 @@ DllExport HWND win32_create_message_window(void);
DllExport int win32_async_check(pTHX);
extern int my_fclose(FILE *);
-extern char * win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len);
extern char * win32_get_sitelib(const char *pl, STRLEN *const len);
extern char * win32_get_vendorlib(const char *pl, STRLEN *const len);
diff --git a/win32/wince.c b/win32/wince.c
index 1b58d40..bcc66c8 100644
--- a/win32/wince.c
+++ b/win32/wince.c
@@ -230,7 +230,7 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
}
char *
-win32_get_privlib(const char *pl, STRLEN *const len)
+win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
--
1.7.9.msysgit.0
|
From @bulk88On Wed Sep 30 03:27:41 2015, bulk88 wrote:
Bump. -- |
From @tonycozOn Wed Sep 30 03:27:41 2015, bulk88 wrote:
Thanks, applied as 0517ed3 and 6937817. Tony |
|
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#123658 (status was 'resolved')
Searchable as RT123658$
The text was updated successfully, but these errors were encountered: