In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5a702b9ac51e9c840d6b8bac0725b156789b8972?hp=7e1dab6a61131a77ad847a43dacb66e48b0ab716>
- Log ----------------------------------------------------------------- commit 5a702b9ac51e9c840d6b8bac0725b156789b8972 Author: Nicholas Clark <[email protected]> Date: Thu Nov 24 20:38:08 2011 +0100 Small tidyups in S_incpush() and S_mayberelocate() Following commit 816005240f1a3b99, which moved VMS-specific code, we can now assign to subdir at the point of declaration. After the refactoring that moved code into S_mayberelocate(), we can assign to libdir at the point of declaration. In turn, this allows the merging of two #ifndef PERL_IS_MINIPERL blocks. Remove a blank line from S_mayberelocate(). M perl.c commit fc81b7184d0fd04bc43121a2a4a96d7863dfc569 Author: Nicholas Clark <[email protected]> Date: Thu Nov 24 18:11:32 2011 +0100 Avoid attacks on sitecustomize by using NUL delimiters to wrap filenames. Previously the generated code used regular '' strings, which meant that a crafted pathname containing ' characters could be used to inject code. Until the previous commit, this was only a problem if building in or Configuring to install to such a directory. Which, hopefully, would be "obviously wrong" to anyone capable of building Perl from source. However, fixing the bug that prevented sitecustomize being subject to relocatable include now means that for a relocatable pearl, an end-user controlled path can now reach the sitecusomize code. M perl.c commit c29067d7797853039f1acba2cddf71786ecd4b16 Author: Carl Hayter <[email protected]> Date: Thu Nov 24 17:49:50 2011 +0100 Make sitecustomize relocatableinc aware When -Dusesitecustomize is used with -Duserelocatableinc, SITELIB_EXP/sitecustomize.pl is not found due to SITELIB_EXP having a '.../..' relocation path. This patch refactors the path relocation code from S_incpush() into S_mayberelocate() so that it can be used in both S_incpush() and in usesitecustomize's use of SITELIB_EXP. M AUTHORS M embed.fnc M embed.h M perl.c M proto.h ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + embed.fnc | 2 + embed.h | 1 + perl.c | 111 +++++++++++++++++++++++++++++++++++++------------------------ proto.h | 5 +++ 5 files changed, 76 insertions(+), 44 deletions(-) diff --git a/AUTHORS b/AUTHORS index ac6ad77..11d8f5c 100644 --- a/AUTHORS +++ b/AUTHORS @@ -174,6 +174,7 @@ Calle Dybedahl <[email protected]> Campo Weijerman <[email protected]> Carl Eklof <[email protected]> Carl M. Fongheiser <[email protected]> +Carl Hayter <[email protected]> Carl Witty <[email protected]> Cary D. Renzema <[email protected]> Casey R. Tweten <[email protected]> diff --git a/embed.fnc b/embed.fnc index da62c5f..0c3c3f8 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1743,6 +1743,8 @@ s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp s |void |forbid_setid |const char flag|const bool suidscript s |void |incpush |NN const char *const dir|STRLEN len \ |U32 flags +s |SV* |mayberelocate |NN const char *const dir|STRLEN len \ + |U32 flags s |void |incpush_use_sep|NN const char *p|STRLEN len|U32 flags s |void |init_interp s |void |init_ids diff --git a/embed.h b/embed.h index b741b1c..d29c18a 100644 --- a/embed.h +++ b/embed.h @@ -1415,6 +1415,7 @@ #define init_perllib() S_init_perllib(aTHX) #define init_postdump_symbols(a,b,c) S_init_postdump_symbols(aTHX_ a,b,c) #define init_predump_symbols() S_init_predump_symbols(aTHX) +#define mayberelocate(a,b,c) S_mayberelocate(aTHX_ a,b,c) #define my_exit_jump() S_my_exit_jump(aTHX) #define nuke_stacks() S_nuke_stacks(aTHX) #define open_script(a,b,c,d) S_open_script(aTHX_ a,b,c,d) diff --git a/perl.c b/perl.c index 27e80ac..013549e 100644 --- a/perl.c +++ b/perl.c @@ -2013,10 +2013,19 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } + /* Set $^X early so that it can be used for relocatable paths in @INC */ + /* and for SITELIB_EXP in USE_SITECUSTOMIZE */ + assert (!PL_tainted); + TAINT; + S_set_caret_X(aTHX); + TAINT_NOT; + #if defined(USE_SITECUSTOMIZE) if (!minus_f) { /* The games with local $! are to avoid setting errno if there is no - sitecustomize script. */ + sitecustomize script. "q%c...%c", 0, ..., 0 becomes "q\0...\0", + ie a q() operator with a NUL byte as a the delimiter. This avoids + problems with pathnames containing (say) ' */ # ifdef PERL_IS_MINIPERL AV *const inc = GvAV(PL_incgv); SV **const inc0 = inc ? av_fetch(inc, 0, FALSE) : NULL; @@ -2024,14 +2033,24 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) if (inc0) { (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav, Perl_newSVpvf(aTHX_ - "BEGIN { do {local $!; -f '%"SVf"/buildcustomize.pl'} && do '%"SVf"/buildcustomize.pl' }", *inc0, *inc0)); + "BEGIN { do {local $!; -f q%c%"SVf"/buildcustomize.pl%c} && do q%c%"SVf"/buildcustomize.pl%c }", + 0, *inc0, 0, + 0, *inc0, 0)); } # else /* SITELIB_EXP is a function call on Win32. */ - const char *const sitelib = SITELIB_EXP; + const char *const raw_sitelib = SITELIB_EXP; + /* process .../.. if PERL_RELOCATABLE_INC is defined */ + SV *sitelib_sv = mayberelocate(raw_sitelib, strlen(raw_sitelib), + INCPUSH_CAN_RELOCATE); + const char *const sitelib = SvPVX(sitelib_sv); (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav, Perl_newSVpvf(aTHX_ - "BEGIN { do {local $!; -f '%s/sitecustomize.pl'} && do '%s/sitecustomize.pl' }", sitelib, sitelib)); + "BEGIN { do {local $!; -f q%c%s/sitecustomize.pl%c} && do q%c%s/sitecustomize.pl%c }", + 0, sitelib, 0, + 0, sitelib, 0)); + assert (SvREFCNT(sitelib_sv) == 1); + SvREFCNT_dec(sitelib_sv); # endif } #endif @@ -2050,11 +2069,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) scriptname = "-"; } - /* Set $^X early so that it can be used for relocatable paths in @INC */ assert (!PL_tainted); - TAINT; - S_set_caret_X(aTHX); - TAINT_NOT; init_perllib(); { @@ -4415,45 +4430,15 @@ S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem) } #endif -STATIC void -S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) +STATIC SV * +S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) { - dVAR; -#ifndef PERL_IS_MINIPERL - const U8 using_sub_dirs - = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS - |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS); - const U8 add_versioned_sub_dirs - = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS; - const U8 add_archonly_sub_dirs - = (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS; -#ifdef PERL_INC_VERSION_LIST - const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS; -#endif -#endif const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE; - const U8 unshift = (U8)flags & INCPUSH_UNSHIFT; - const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1; - AV *const inc = GvAVn(PL_incgv); + SV *libdir; - PERL_ARGS_ASSERT_INCPUSH; + PERL_ARGS_ASSERT_MAYBERELOCATE; assert(len > 0); - /* Could remove this vestigial extra block, if we don't mind a lot of - re-indenting diff noise. */ - { - SV *libdir; - /* Change 20189146be79a0596543441fa369c6bf7f85103f, to fix RT#6665, - arranged to unshift #! line -I onto the front of @INC. However, - -I can add version and architecture specific libraries, and they - need to go first. The old code assumed that it was always - pushing. Hence to make it work, need to push the architecture - (etc) libraries onto a temporary array, then "unshift" that onto - the front of @INC. */ -#ifndef PERL_IS_MINIPERL - AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NULL; -#endif - if (len) { /* I am not convinced that this is valid when PERLLIB_MANGLE is defined to so something (in os2/os2.c), but the code has been @@ -4579,19 +4564,57 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) } #endif } + return libdir; +} + +STATIC void +S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags) +{ + dVAR; +#ifndef PERL_IS_MINIPERL + const U8 using_sub_dirs + = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS + |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS); + const U8 add_versioned_sub_dirs + = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS; + const U8 add_archonly_sub_dirs + = (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS; +#ifdef PERL_INC_VERSION_LIST + const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS; +#endif +#endif + const U8 unshift = (U8)flags & INCPUSH_UNSHIFT; + const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1; + AV *const inc = GvAVn(PL_incgv); + + PERL_ARGS_ASSERT_INCPUSH; + assert(len > 0); + + /* Could remove this vestigial extra block, if we don't mind a lot of + re-indenting diff noise. */ + { + SV *const libdir = mayberelocate(dir, len, flags); + /* Change 20189146be79a0596543441fa369c6bf7f85103f, to fix RT#6665, + arranged to unshift #! line -I onto the front of @INC. However, + -I can add version and architecture specific libraries, and they + need to go first. The old code assumed that it was always + pushing. Hence to make it work, need to push the architecture + (etc) libraries onto a temporary array, then "unshift" that onto + the front of @INC. */ #ifndef PERL_IS_MINIPERL + AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NULL; + /* * BEFORE pushing libdir onto @INC we may first push version- and * archname-specific sub-directories. */ if (using_sub_dirs) { - SV *subdir; + SV *subdir = newSVsv(libdir); #ifdef PERL_INC_VERSION_LIST /* Configure terminates PERL_INC_VERSION_LIST with a NULL */ const char * const incverlist[] = { PERL_INC_VERSION_LIST }; const char * const *incver; #endif - subdir = newSVsv(libdir); if (add_versioned_sub_dirs) { /* .../version/archname if -d .../version/archname */ diff --git a/proto.h b/proto.h index b9689e6..7cc4c08 100644 --- a/proto.h +++ b/proto.h @@ -5860,6 +5860,11 @@ STATIC void S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env) assert(argv) STATIC void S_init_predump_symbols(pTHX); +STATIC SV* S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_MAYBERELOCATE \ + assert(dir) + STATIC void S_my_exit_jump(pTHX) __attribute__noreturn__; -- Perl5 Master Repository
