Skip Menu |
Report information
Id: 123658
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: bulk88 <bulk88 [at] hotmail.com>
Cc:
AdminCc:

Operating System: mswin32
PatchStatus: (no value)
Severity: low
Type:
Perl Version: 5.21.4
Fixed In: (no value)



Date: Fri, 23 Jan 2015 03:26:11 -0500
Subject: [PATCH] stop checking the Win32 registry if *"/Software/Perl" doesn't exist
To: perlbug [...] perl.org
From: bulk88 <bulk88 [...] hotmail.com>
Download (untitled) / with headers
text/plain 3.6k
This is a bug report for perl from bulk88@hotmail.com, generated with the help of perlbug 1.40 running under perl 5.21.4. ----------------------------------------------------------------- [Please describe your issue here] Need #. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.21.4: Configured by Owner at Thu Sep 18 12:08:58 2014. Summary of my perl5 (revision 5 version 21 subversion 4) configuration: Derived from: 7d2b2edb94ab56333b9049a3e26d15ea18445512 Ancestor: 19be3be6968e2337bcdfe480693fff795ecd1304 Platform: osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef useithreads=define, usemultiplicity=define use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -DWIN32 -D_CONSOLE -DNO_STRICT -DPERL_TEXTMODE_SCRIPTS -DPERL_HASH_FUNC_ONE_AT_A_TIME -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T', optimize='-O1 -MD -Zi -DNDEBUG', cppflags='-DWIN32' ccversion='12.00.8168', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8, longdblkind=0 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -libpath:"c:\perl521\lib\CORE" -machine:x86' libpth=C:\PROGRA~1\MIAF9D~1\VC98\lib libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl521.lib gnulibc_version='' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -libpath:"c:\perl521\lib\CORE" -machine:x86' Locally applied patches: uncommitted-changes a0fe7a7e75de29e59f1da0d6822dc06e5be658fe a261faffee83d0145642ab5d1d046c9f813bc497 6506ab86ad1602a9ca720fcd30446dce1461d23d 7d2b2edb94ab56333b9049a3e26d15ea18445512 --- @INC for perl 5.21.4: lib C:/perl521/srcnew/lib . --- Environment for perl 5.21.4: HOME (unset) LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH= PERL_BADLANG (unset) PERL_JSON_BACKEND=Cpanel::JSON::XS PERL_YAML_BACKEND=YAML SHELL (unset)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 7.2k
On Fri Jan 23 00:26:22 2015, bulk88 wrote: Show quoted text
> This is a bug report for perl from bulk88@hotmail.com, > generated with the help of perlbug 1.40 running under perl 5.21.4. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > Need #.
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\ perl.exe oldreg=C:\perl521\oldreg\bin\perl.exe new2=C:\perl521\newreg\bin\perl. exe old2=C:\perl521\oldreg\bin\perl.exe newreg) perl-5 version = 5.021008 path = C:\perl521\newreg\bin\perl.exe oldreg) perl-5 version = 5.021008 path = C:\perl521\oldreg\bin\perl.exe new2) perl-5 version = 5.021008 path = C:\perl521\newreg\bin\perl.exe old2) perl-5 version = 5.021008 path = C:\perl521\oldreg\bin\perl.exe newreg oldreg new2 old2 ------ ------ ---- ---- arith/mixed 100 102 98 103 INVALID arith/trig 100 99 100 98 OLD array/copy 100 94 106 102 OLD array/foreach 100 103 99 99 NEW array/index 100 106 98 97 INVALID array/pop 100 103 100 108 NEW array/shift 100 110 105 106 NEW array/sort-num 100 100 101 97 OLD array/sort 100 100 96 95 OLD call/0arg 100 105 97 105 NEW call/1arg 100 97 95 96 INVALID call/2arg 100 94 102 97 OLD call/9arg 100 99 98 97 OLD call/empty 100 100 105 100 INVALID call/fib 100 96 100 94 OLD call/method 100 100 100 97 OLD call/wantarray 100 100 99 99 INVALID hash/copy 100 94 94 106 INVALID hash/each 100 95 102 95 OLD hash/foreach-sort 100 100 98 108 NEW hash/foreach 100 112 99 116 NEW hash/get 100 101 92 104 NEW hash/set 100 97 101 100 OLD loop/for-c 100 120 96 118 NEW loop/for-range-const 100 94 102 97 OLD loop/for-range 100 94 99 97 OLD loop/getline 100 108 109 94 INVALID loop/while-my 100 104 101 104 NEW loop/while 100 101 97 96 INVALID re/const 100 99 102 103 INVALID re/w 100 104 101 101 NEW startup/fewmod 100 144 - 143 NEW startup/lotsofsub - - - - startup/noprog 100 109 90 90 NEW string/base64 100 105 91 98 NEW string/htmlparser 100 101 95 97 NEW string/index-const 100 102 99 102 NEW string/index-var 100 135 110 127 NEW string/ipol 100 99 99 101 INVALID string/tr 100 93 105 88 OLD 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 16 NEW IS FASTER 10 JITTER MAKES IT INVALID C:\sources\perlbench>perl -MBenchmark=:all,:hireswallclock -E"cmpthese(10000, {' old' => sub {system'C:\perl521\oldreg\bin\perl.exe -e\"0\"'}, 'new' => sub {syst em'C:\perl521\newreg\bin\perl.exe -e\"0\"'}})" Rate old new old 1481/s -- -9% new 1624/s 10% -- 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 from first call to lookup PERL_UNICODE "7:05:08.3765673 AM","perl.exe","3980","3084","RegQueryValue","HKLM\SOFTWARE\Perl\PERL_UNICODE","NAME NOT FOUND","Length: 144" to last (and first) call to lookup PERLLIB "7:05:08.3768070 AM","perl.exe","3980","3084","RegQueryValue","HKLM\SOFTWARE\Perl\PERLLIB","NAME NOT FOUND","Length: 144" .3768070-.3765673=0.0002397, .2 ms old from first call to lookup PERL_UNICODE "7:04:02.5810787 AM","perl.exe","312","3188","RegOpenKey","HKCU\Software\Perl","NAME NOT FOUND","Desired Access: Read" to last call to lookup PERLLIB "7:04:02.5819799 AM","perl.exe","312","3188","RegCloseKey","HKLM\SOFTWARE\Perl","SUCCESS","" .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. -- bulk88 ~ bulk88 at hotmail.com
Subject: 0001-stop-checking-the-Win32-registry-if-Software-Perl-do.patch
From 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
Subject: regnew.CSV
Download regnew.CSV
application/vnd.ms-excel 51.1k

Message body not shown because it is not plain text.

Subject: regold.CSV
Download regold.CSV
application/vnd.ms-excel 56.3k

Message body not shown because it is not plain text.

Date: Fri, 23 Jan 2015 12:02:29 +0000
To: "perlbug-followup [...] perl.org" <perlbug-followup [...] perl.org>
From: Steve Hay <Steve.Hay [...] verosoftware.com>
CC: "perl5-porters [...] perl.org" <perl5-porters [...] perl.org>, Jan Dubois <jand [...] activestate.com>
Subject: RE: [perl #123658] [PATCH] stop checking the Win32 registry if *"/Software/Perl" doesn't exist
Download (untitled) / with headers
text/plain 1.5k
[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? Show quoted text
-----Original Message----- From: bulk88 via RT [mailto:perlbug-followup@perl.org] Sent: 23 January 2015 11:45 Cc: perl5-porters@perl.org Subject: [perl #123658] [PATCH] stop checking the Win32 registry if *"/Software/Perl" doesn't exist On Fri Jan 23 00:26:22 2015, bulk88 wrote:
> This is a bug report for perl from bulk88@hotmail.com, generated with > the help of perlbug 1.40 running under perl 5.21.4. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > Need #.
Patch attached. Some benchmarks I did. This patch probably saves 1 to 2 ms out of 10 to 30 ms per process start.

Message body is not shown because sender requested not to inline it.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 974b
On Fri Jan 23 04:03:26 2015, Steve.Hay@verosoftware.com wrote: Show quoted text
> 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?
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. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.5k
On Fri Jan 23 10:26:04 2015, bulk88 wrote: Show quoted text
> 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.
Maybe we could add a build define to disable it. As to your patch: + if (!ptr) { + ptr = (char*)HKLM_Perl_hnd; + if (ptr) + ptr = get_regstr_from((HKEY)ptr, valuename, svp); + /* else pass through NULL */ 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) + ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp); + if (!ptr && HKLM_Perl_hnd) + ptr = get_regstr_from((HKLM_Perl_hnd, valuename, svp); + + return ptr; 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 + 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 */ My main problem with this is that it will increase noise in tools that check for bad API calls. Adding conditional checks here for a function (Perl_win32_term()) that executes *once* per perl invocation doesn't seem like a huge price to pay for reducing that noise. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 657b
On Mon Jan 26 15:06:22 2015, tonyc wrote: Show quoted text
> On Fri Jan 23 10:26:04 2015, bulk88 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.
> > Maybe we could add a build define to disable it. >
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 by default since most people probably don't have any need for it.
Download (untitled) / with headers
text/plain 2.9k
On Mon Jan 26 15:06:22 2015, tonyc wrote: Show quoted text
> On Fri Jan 23 10:26:04 2015, bulk88 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.
> > Maybe we could add a build define to disable it.
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? Show quoted text
> > As to your patch: > > + if (!ptr) { > + ptr = (char*)HKLM_Perl_hnd; > + if (ptr) > + ptr = get_regstr_from((HKEY)ptr, valuename, svp); > + /* else pass through NULL */ > > 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) > + ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp); > + if (!ptr && HKLM_Perl_hnd) > + ptr = get_regstr_from((HKLM_Perl_hnd, valuename, svp); > + > + return ptr;
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"). Show quoted text
> 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 > + 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 */ > > My main problem with this is that it will increase noise in tools that > check for bad API calls. > Adding conditional checks here for a function (Perl_win32_term()) that > executes *once* per perl invocation doesn't seem like a huge price to > pay > for reducing that noise. > > Tony
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. -- bulk88 ~ bulk88 at hotmail.com
Subject: 0001-stop-checking-the-Win32-registry-if-Software-Perl-do.patch
From 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
Subject: 0002-add-Win32-USE_NO_REGISTRY-build-option.patch

Message body is not shown because it is too large.

Download (untitled) / with headers
text/plain 2.7k
On Mon Jan 26 15:06:22 2015, tonyc wrote: Show quoted text
> On Fri Jan 23 10:26:04 2015, bulk88 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.
> > Maybe we could add a build define to disable it.
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. Show quoted text
> > As to your patch: > > + if (!ptr) { > + ptr = (char*)HKLM_Perl_hnd; > + if (ptr) > + ptr = get_regstr_from((HKEY)ptr, valuename, svp); > + /* else pass through NULL */ > > 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) > + ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp); > + if (!ptr && HKLM_Perl_hnd) > + ptr = get_regstr_from((HKLM_Perl_hnd, valuename, svp); > + > + return ptr;
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. Show quoted text
> 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 > + 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 */ > > My main problem with this is that it will increase noise in tools that > check for bad API calls. > Adding conditional checks here for a function (Perl_win32_term()) that > executes *once* per perl invocation doesn't seem like a huge price to > pay > for reducing that noise. > > Tony
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. -- bulk88 ~ bulk88 at hotmail.com
Subject: 0001-stop-checking-the-Win32-registry-if-Software-Perl-do.patch
From 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
Subject: 0002-add-Win32-USE_NO_REGISTRY-build-option.patch

Message body is not shown because it is too large.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.5k
I 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) { return GetUserNameExA((EXTENDED_NAME_FORMAT)65538, lpBuffer, 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. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.9k
On Thu May 28 12:49:20 2015, bulk88 wrote: Show quoted text
> 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.
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. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.9k
On Thu May 28 10:14:04 2015, bulk88 wrote: Show quoted text
> On Mon Jan 26 15:06:22 2015, tonyc wrote:
> > On Fri Jan 23 10:26:04 2015, bulk88 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.
> > > > Maybe we could add a build define to disable it.
> > 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.
Thanks. Show quoted text
>
> > > > As to your patch: > > > > + if (!ptr) { > > + ptr = (char*)HKLM_Perl_hnd; > > + if (ptr) > > + ptr = get_regstr_from((HKEY)ptr, valuename, svp); > > + /* else pass through NULL */ > > > > 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) > > + ptr = get_regstr_from(HKCU_Perl_hnd, valuename, svp); > > + if (!ptr && HKLM_Perl_hnd) > > + ptr = get_regstr_from((HKLM_Perl_hnd, valuename, svp); > > + > > + return ptr;
> > 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.
Then initialize ptr at the declaration. Please don't reduce readability for tiny space improvements. Show quoted text
> > + /* 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 */ > > > > My main problem with this is that it will increase noise in tools > > that > > check for bad API calls. > > Adding conditional checks here for a function (Perl_win32_term()) > > that > > executes *once* per perl invocation doesn't seem like a huge price to > > pay > > for reducing that noise. > > > > Tony
> > 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.
Ok. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 126b
Revised patches attached. Rebased and get_regstr was reworked to use 2 vars instead of 1. -- bulk88 ~ bulk88 at hotmail.com
Subject: 0001-stop-checking-the-Win32-registry-if-Software-Perl-do.patch
From 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
Subject: 0002-add-Win32-USE_NO_REGISTRY-build-option.patch

Message body is not shown because it is too large.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 354b
On Thu Jul 09 03:01:53 2015, bulk88 wrote: Show quoted text
> Revised patches attached. Rebased and get_regstr was reworked to use 2 > vars instead of 1.
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. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 422b
On Thu Jul 09 03:17:40 2015, bulk88 wrote: Show quoted text
> On Thu Jul 09 03:01:53 2015, bulk88 wrote:
> > Revised patches attached. Rebased and get_regstr was reworked to use > > 2 > > vars instead of 1.
> > 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.
Bump. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 493b
On Sun Aug 02 21:15:26 2015, bulk88 wrote: Show quoted text
> On Thu Jul 09 03:17:40 2015, bulk88 wrote:
> > On Thu Jul 09 03:01:53 2015, bulk88 wrote:
> > > Revised patches attached. Rebased and get_regstr was reworked to use > > > 2 > > > vars instead of 1.
> > > > 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.
> > Bump.
Bump. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 797b
On Thu Jul 09 03:01:53 2015, bulk88 wrote: Show quoted text
> Revised patches attached. Rebased and get_regstr was reworked to use 2 > vars instead of 1.
You haven't addressed: Please don't reduce readability for tiny space improvements. 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; } Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 355b
On Sun Aug 16 18:30:18 2015, tonyc wrote: Show quoted text
> On Thu Jul 09 03:01:53 2015, bulk88 wrote:
> > Revised patches attached. Rebased and get_regstr was reworked to use 2 > > vars instead of 1.
> > > You haven't addressed: > > Please don't reduce readability for tiny space improvements.
revised get_regstr patches attached -- bulk88 ~ bulk88 at hotmail.com
Subject: 0001-stop-checking-the-Win32-registry-if-Software-Perl-do.patch
From 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
Subject: 0002-add-Win32-USE_NO_REGISTRY-build-option.patch

Message body is not shown because it is too large.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 427b
On Wed Sep 30 03:27:41 2015, bulk88 wrote: Show quoted text
> On Sun Aug 16 18:30:18 2015, tonyc wrote:
> > On Thu Jul 09 03:01:53 2015, bulk88 wrote:
> > > Revised patches attached. Rebased and get_regstr was reworked to use 2 > > > vars instead of 1.
> > > > > > You haven't addressed: > > > > Please don't reduce readability for tiny space improvements.
> > revised get_regstr patches attached
Bump. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 497b
On Wed Sep 30 03:27:41 2015, bulk88 wrote: Show quoted text
> On Sun Aug 16 18:30:18 2015, tonyc wrote:
> > On Thu Jul 09 03:01:53 2015, bulk88 wrote:
> > > Revised patches attached. Rebased and get_regstr was reworked to use 2 > > > vars instead of 1.
> > > > > > You haven't addressed: > > > > Please don't reduce readability for tiny space improvements.
> > revised get_regstr patches attached
Thanks, applied as 0517ed3816767f5896256870b8cca4b856e4088a and 6937817d58b1688d689072cd112ed95fe62db2a7. Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org