mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
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
This commit is contained in:
Daniel Dragan
Tony Cook
parent
0517ed3816
commit
6937817d58
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
3
perl.c
3
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
|
||||
|
||||
@ -325,6 +325,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
|
||||
|
||||
@ -95,6 +95,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
|
||||
#
|
||||
@ -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 ..
|
||||
|
||||
@ -107,6 +107,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
|
||||
#
|
||||
@ -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 ..
|
||||
|
||||
@ -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*
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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";
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user