(perl #127663) provide limited control for the internal drand48()

perl can be built without PERL_INTERNAL_RAND_SEED support to reduce
it's attack surface.

1 files changed, 29 insertions, 0 deletions

diff --git a/perl.c b/perl.c
index 7db5f158d5..fd100cc64a 100644
--- a/perl.c
+++ b/perl.c
@@ -261,7 +261,21 @@ perl_construct(pTHXx)
 
     init_constants();
 
+#ifdef NO_PERL_INTERNAL_RAND_SEED
     Perl_drand48_init_r(&PL_internal_random_state, seed());
+#else
+    {
+        UV seed;
+        const char *env_pv;
+        if (PerlProc_getuid() != PerlProc_geteuid() ||
+            PerlProc_getgid() != PerlProc_getegid() ||
+            !(env_pv = PerlEnv_getenv("PERL_INTERNAL_RAND_SEED")) ||
+            grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV) {
+            seed = seed();
+        }
+        Perl_drand48_init_r(&PL_internal_random_state, (U32)seed);
+    }
+#endif
 
     SvREADONLY_on(&PL_sv_placeholder);
     SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL;
@@ -2204,6 +2218,21 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
     }
 
+#ifndef NO_PERL_INTERNAL_RAND_SEED
+    /* If we're not set[ug]id, we might have honored
+       PERL_INTERNAL_RAND_SEED in perl_construct().
+       At this point command-line options have been parsed, so if
+       we're now tainting and not set[ug]id re-seed.
+       This could possibly be wasteful if PERL_INTERNAL_RAND_SEED is invalid,
+       but avoids duplicating the logic from perl_construct().
+    */
+    if (PL_tainting &&
+        PerlProc_getuid() == PerlProc_geteuid() &&
+        PerlProc_getgid() == PerlProc_getegid()) {
+        Perl_drand48_init_r(&PL_internal_random_state, seed());
+    }
+#endif
+
     /* Set $^X early so that it can be used for relocatable paths in @INC  */
     /* and for SITELIB_EXP in USE_SITECUSTOMIZE                            */
     assert (!TAINT_get);