[PATCH] Make sitecustomize relocatableinc aware #11761
Comments
From [email protected]This is a bug report for perl from hayter@usc.edu, From 94faaffd8a8d1bc17ec9c91351a4b26f676b0f8e Mon Sep 17 00:00:00 2001 When -Dusesitecustomize is used with -Duserelocatableinc, This patch refactors the path relocation code from S_incpush() into AUTHORS | 1 + Inline Patchdiff --git a/AUTHORS b/AUTHORS
index d0707b4..dd90b3f 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 6b22a3e..f4c9f43 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1731,6 +1731,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 d8d2776..fe93de0 100644
--- a/embed.h
+++ b/embed.h
@@ -1411,6 +1411,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 bbfae80..cfd277b 100644
--- a/perl.c
+++ b/perl.c
@@ -2013,6 +2013,13 @@ 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
@@ -2028,10 +2035,16 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
}
# 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));
+ assert (SvREFCNT(sitelib_sv) == 1);
+ SvREFCNT_dec(sitelib_sv);
# endif
}
#endif
@@ -2050,11 +2063,6 @@ 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();
{
@@ -4419,45 +4427,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
@@ -4583,6 +4561,50 @@ 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 *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
+
+ libdir = mayberelocate(dir, len, flags);
+
#ifndef PERL_IS_MINIPERL
/*
* BEFORE pushing libdir onto @INC we may first push version- and
diff --git a/proto.h b/proto.h
index 55f4b3b..d62514f 100644
--- a/proto.h
+++ b/proto.h
@@ -5846,6 +5846,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__;
--
Flags: Site configuration information for perl 5.15.5: Configured by hayter at Sun Nov 20 14:59:31 PST 2011. Summary of my perl5 (revision 5 version 15 subversion 5) configuration: Locally applied patches: @INC for perl 5.15.5: Environment for perl 5.15.5: |
From @nwc10On Sun, Nov 20, 2011 at 03:22:07PM -0800, Carl Hayter wrote:
Thanks for that patch. Is it coincidence that you've reported the same issue as I think that the patch is good, but I'm still pondering the corner cases. However, I think that fixing this bug opens up a bit of a security hole: $ cat >/home/nick/Sandpit/snap5.9.x-v5.15.5-181-g84573ee/lib/perl5/site_perl/5.15.5/sitecustomize.pl I have an idea how to fix this. Arguably the same hole exists already, but to be exploited the person
I'm tempted to leave that assertion in at that location. Nicholas Clark |
|
The RT System itself - Status changed from 'new' to 'open' |
From [email protected]On Thu, Nov 24, 2011 at 8:13 AM, Nicholas Clark <nick@ccl4.org> wrote:
Not a coincidence. Going back to cleaner, more proper patch and using
My original hackish solution was to make it 'sitecustomize.pm' and 'use' it
This move IIRC I only had to do when I tested along with -Dusethreads, but I Most of this is moot to me now, I had wanted to use it on Solaris but $ ssh zim 'uname -a;perl -e "print qq{$^X\n}"' $ ssh tak 'uname -a;perl -e "print qq{$^X\n}"' This sorta blows my planed use of relocatable sitecustomize out of the water. ____ |
From @nwc10On Thu, Nov 24, 2011 at 12:29:24PM -0800, zengargoyle wrote:
It does in blead now. I think you'd need to cherry-pick commits 9e68546 and Otherwise I think you need to force procselfexe=/proc/curproc/file You may be able to force that (not tested) by running ./Configure with Otherwise edit config.sh after Configure has run. Nicholas Clark |
From [email protected]On Thu, Nov 24, 2011 at 12:40 PM, Nicholas Clark <nick@ccl4.org> wrote:
Sweet! My $WORK Solaris playground isn't Git-ized so I'll have to read perlgit You mentioned 9e68546 twice, I'm guessing maybe needing the ____ |
From @nwc10On Thu, Nov 24, 2011 at 02:14:33PM -0800, zengargoyle wrote:
Yes. D'oh. I meant 698ca84 You can probably get most things from the gitweb interface, although possibly http://perl5.git.perl.org/perl.git (A twisty maze of links) Nicholas Clark |
From @cpansproutOn Sun Nov 20 15:22:06 2011, hayter@usc.edu wrote:
Nicholas Clark has applied your patch as c29067d. Thank you. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#104112 (status was 'resolved')
Searchable as RT104112$
The text was updated successfully, but these errors were encountered: