If you configure perl with C<-Accflags=-DNO_PERL_INTERNAL_RAND_SEED>,
perl will ignore the C<PERL_INTERNAL_RAND_SEED> environment variable.
+=head2 C<-DNO_PERL_RAND_SEED>
+X<PERL_RAND_SEED>
+
+If you configure perl with C<-Accflags=-DNO_PERL_RAND_SEED>,
+perl will ignore the C<PERL_RAND_SEED> environment variable.
+
=head1 DOCUMENTATION
Read the manual entries before running perl. The main documentation
t/run/locale.t Tests related to locale handling
t/run/noswitch.t Test aliasing ARGV for other switch tests
t/run/runenv.t Test if perl honors its environment variables.
-t/run/runenv_hashseed.t Test if perl honors PERL_HASH_SEED.
+t/run/runenv_hashseed.t Test if perl honors PERL_HASH_SEED.
+t/run/runenv_randseed.t Test if perl honors PERL_RAND_SEED.
t/run/script.t See if script invocation works
t/run/switch0.t Test the -0 switch
t/run/switcha.t Test the -a switch
}
use ExtUtils::testlib;
+use Data::Dumper;
use threads;
rand(10);
threads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
$_->join foreach threads->list;
- ok((keys %rand >= 23), "Check that rand() is randomized in new threads");
+ ok((keys %rand >= 23), "Check that rand() is randomized in new threads")
+ or diag Dumper(\%rand);
}
# bugid #24165
use strict;
use warnings;
-use threads;
use Test::More;
+BEGIN {
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+}
+
+use threads;
+
# test that the version documented in threads.pm pod matches
# that of the code.
thread->gimme = gimme;
thread->state = exit_opt;
+
/* "Clone" our interpreter into the thread's interpreter.
* This gives thread access to "static data" and code.
*/
if (! thread) {
XSRETURN_UNDEF; /* Mutex already unlocked */
}
+ PERL_SRAND_OVERRIDE_NEXT_PARENT();
ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));
/* Let thread run. */
/* warning: releasing mutex 'thread->mutex' that was not held [-Wthread-safety-analysis] */
MUTEX_UNLOCK(&thread->mutex);
CLANG_DIAG_RESTORE_STMT;
-
/* XSRETURN(1); - implied */
#define PL_sortstash (vTHX->Isortstash)
#define PL_splitstr (vTHX->Isplitstr)
#define PL_srand_called (vTHX->Isrand_called)
+#define PL_srand_override (vTHX->Isrand_override)
+#define PL_srand_override_next (vTHX->Isrand_override_next)
#define PL_stack_base (vTHX->Istack_base)
#define PL_stack_max (vTHX->Istack_max)
#define PL_stack_sp (vTHX->Istack_sp)
* are very useful when you want an integer to "dance" in a random way,
* but you also never want it to become 0 and thus false.
*
- * Obviously they leave x unchanged if it starts out as 0. */
+ * Obviously they leave x unchanged if it starts out as 0.
+ *
+ * We have two variants just because that can be helpful in certain
+ * places. There is no advantage to either, they are equally bad as each
+ * other as far RNG's go. Sufficiently random for many purposes, but
+ * insufficiently random for serious use as they fail important tests in
+ * the Test01 BigCrush RNG test suite by L’Ecuyer and Simard. (Note
+ * that Drand48 also fails BigCrush). The main point is they produce
+ * different sequences and in places where we want some randomlike
+ * behavior they are cheap and easy.
+ *
+ * Marsaglia was one of the early researchers into RNG testing and wrote
+ * the Diehard RNG test suite, which after his death become the
+ * Dieharder RNG suite, and was generally supplanted by the Test01 suite
+ * by L'Ecruyer and associates.
+ *
+ * There are dozens of shift parameters that create a pseudo random ring
+ * of integers 1..2^N-1, if you need a different sequence just read the
+ * paper and select a set of parameters. In fact, simply reversing the
+ * shift order from L/R/L to R/L/R should result in another valid
+ * example, but read the paper before you do that.
+ *
+ * PDF of the original paper:
+ * https://www.jstatsoft.org/article/download/v008i14/916
+ * Wikipedia:
+ * https://en.wikipedia.org/wiki/Xorshift
+ * Criticism:
+ * https://www.iro.umontreal.ca/~lecuyer/myftp/papers/xorshift.pdf
+ * Test01:
+ * http://simul.iro.umontreal.ca/testu01/tu01.html
+ * Diehard:
+ * https://en.wikipedia.org/wiki/Diehard_tests
+ * Dieharder:
+ * https://webhome.phy.duke.edu/~rgb/General/rand_rate/rand_rate.abs
+ *
+ */
-#define PERL_XORSHIFT64(x) \
+/* 32 bit version */
+#define PERL_XORSHIFT32_A(x) \
STMT_START { \
- (x) ^= (x) << 13; \
- (x) ^= (x) >> 17; \
- (x) ^= (x) << 5; \
+ (x) ^= ((x) << 13); \
+ (x) ^= ((x) >> 17); \
+ (x) ^= ((x) << 5); \
+} STMT_END
+
+/* 64 bit version */
+#define PERL_XORSHIFT64_A(x) \
+STMT_START { \
+ (x) ^= ((x) << 13); \
+ (x) ^= ((x) >> 7); \
+ (x) ^= ((x) << 17); \
} STMT_END
/* 32 bit version */
-#define PERL_XORSHIFT32(x) \
+#define PERL_XORSHIFT32_B(x) \
+STMT_START { \
+ (x) ^= ((x) << 5); \
+ (x) ^= ((x) >> 27); \
+ (x) ^= ((x) << 8); \
+} STMT_END
+
+/* 64 bit version - currently this is unused,
+ * it is provided here to complement the 32 bit _B
+ * variant which IS used. */
+#define PERL_XORSHIFT64_B(x) \
STMT_START { \
- (x) ^= (x) << 13; \
- (x) ^= (x) >> 7; \
- (x) ^= (x) << 17; \
+ (x) ^= ((x) << 15); \
+ (x) ^= ((x) >> 49); \
+ (x) ^= ((x) << 26); \
} STMT_END
*/
#if IVSIZE == 8
/* 64 bit version */
-#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT64(x)
+#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT64_A(x)
#else
/* 32 bit version */
-#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT32(x)
+#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT32_A(x)
#endif
#define UPDATE_HASH_RAND_BITS_KEY(key,klen) \
PERLVAR(I, pad_reset_pending, bool) /* reset pad on next attempted alloc */
-PERLVAR(I, srand_called, bool)
+PERLVARI(I, srand_called, bool, false) /* has random_state been initialized yet? */
+PERLVARI(I, srand_override, U32, 0) /* Should we use a deterministic sequence? */
+PERLVARI(I, srand_override_next, U32, 0) /* Next item in the sequence */
PERLVARI(I, numeric_underlying, bool, TRUE)
/* Assume underlying locale numerics */
init_stacks();
-/* The PERL_INTERNAL_RAND_SEED set-up must be after init_stacks because it calls
+#if !defined(NO_PERL_RAND_SEED) || !defined(NO_PERL_INTERNAL_HASH_SEED)
+ bool sensitive_env_vars_allowed =
+ (PerlProc_getuid() == PerlProc_geteuid() &&
+ PerlProc_getgid() == PerlProc_getegid()) ? TRUE : FALSE;
+#endif
+
+/* The seed set-up must be after init_stacks because it calls
* things that may put SVs on the stack.
*/
+#ifndef NO_PERL_RAND_SEED
+ if (sensitive_env_vars_allowed) {
+ UV seed= 0;
+ const char *env_pv;
+ if ((env_pv = PerlEnv_getenv("PERL_RAND_SEED")) &&
+ grok_number(env_pv, strlen(env_pv), &seed) == IS_NUMBER_IN_UV)
+ {
+ PL_srand_override_next = seed;
+ PERL_SRAND_OVERRIDE_NEXT_INIT();
+ }
+ }
+#endif
+
+ /* This is NOT the state used for C<rand()>, this is only
+ * used in internal functionality */
#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() ||
+ if (
+ !sensitive_env_vars_allowed ||
!(env_pv = PerlEnv_getenv("PERL_INTERNAL_RAND_SEED")) ||
- grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV) {
+ grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV)
+ {
+ /* use a randomly generated seed */
seed = seed();
}
Perl_drand48_init_r(&PL_internal_random_state, (U32)seed);
# ifdef USE_THREAD_SAFE_LOCALE
" USE_THREAD_SAFE_LOCALE"
# endif
+# ifdef NO_PERL_RAND_SEED
+ " NO_PERL_RAND_SEED"
+# endif
+# ifdef NO_PERL_INTERNAL_RAND_SEED
+ " NO_PERL_INTERNAL_RAND_SEED"
+# endif
;
PERL_UNUSED_ARG(cv);
PERL_UNUSED_VAR(items);
# endif
#endif
-#endif /* DOUBLE_HAS_NAN */
+/* these are used to faciliate the env var PERL_RAND_SEED,
+ * which allows consistent behavior from code that calls
+ * srand() with no arguments, either explicitly or implicitly.
+ */
+#define PERL_SRAND_OVERRIDE_NEXT() PERL_XORSHIFT32_A(PL_srand_override_next);
+
+#define PERL_SRAND_OVERRIDE_NEXT_INIT() STMT_START { \
+ PL_srand_override = PL_srand_override_next; \
+ PERL_SRAND_OVERRIDE_NEXT(); \
+} STMT_END
+
+#define PERL_SRAND_OVERRIDE_GET(into) STMT_START { \
+ into= PL_srand_override; \
+ PERL_SRAND_OVERRIDE_NEXT_INIT(); \
+} STMT_END
+#define PERL_SRAND_OVERRIDE_NEXT_CHILD() STMT_START { \
+ PERL_XORSHIFT32_B(PL_srand_override_next); \
+ PERL_SRAND_OVERRIDE_NEXT_INIT(); \
+} STMT_END
+
+#define PERL_SRAND_OVERRIDE_NEXT_PARENT() \
+ PERL_SRAND_OVERRIDE_NEXT()
+
+#endif /* DOUBLE_HAS_NAN */
/*
[ List each enhancement as a =head2 entry ]
+=head2 PERL_RAND_SEED
+
+Added a new environment variable C<PERL_RAND_SEED> which can be used to
+cause a perl program which uses C<rand> without using C<srand()>
+explicitly or which uses C<srand()> with no arguments to be repeatable.
+See L<perlrun>. This feature can be disabled at compile time by passing
+
+ -Accflags=-DNO_PERL_RAND_SEED
+
+to F<Configure> during the build process.
+
=head1 Security
XXX Any security-related notices go here. In particular, any security
function so that L<C<rand>|/rand EXPR> can produce a different sequence
each time you run your program. When called with a parameter,
L<C<srand>|/srand EXPR> uses that for the seed; otherwise it
-(semi-)randomly chooses a seed. In either case, starting with Perl 5.14,
+(semi-)randomly chooses a seed (see below). In either case, starting with Perl 5.14,
it returns the seed. To signal that your code will work I<only> on Perls
of a recent vintage:
can test a random subset each time, and should there be a failure, log the seed
used for that run so that it can later be used to reproduce the same results.
+If the C<PERL_RAND_SEED> environment variable is set to a non-negative
+integer during process startup then calls to C<srand()> with no
+arguments will initialize the perl random number generator with a
+consistent seed each time it is called, whether called explicitly with
+no arguments or implicitly via use of C<rand()>. The exact seeding that
+a given C<PERL_RAND_SEED> will produce is deliberately unspecified, but
+using different values for C<PERL_RAND_SEED> should produce different
+results. This is intended for debugging and performance analysis and is
+only guaranteed to produce consistent results between invocations of the
+same perl executable running the same code when all other factors are
+equal. The environment variable is read only once during process
+startup, and changing it during the program flow will not affect the
+currently running process. See L<perlrun> for more details.
+
B<L<C<rand>|/rand EXPR> is not cryptographically secure. You should not rely
on it in security-sensitive situations.> As of this writing, a
number of third-party CPAN modules offer random number generators
Perl may be built to ignore this variable.
+=item PERL_RAND_SEED
+X<PERL_RAND_SEED>
+
+When set to an integer value this value will be used to seed the perl
+internal random number generator used for C<rand()> when it is used
+without an explicit C<srand()> call or for when an explicit no-argument
+C<srand()> call is made.
+
+Normally calling C<rand()> prior to calling C<srand()> or calling
+C<srand()> explicitly with no arguments should result in the random
+number generator using "best efforts" to seed the generator state with a
+relatively high quality random seed. When this environment variable is
+set then the seeds used will be deterministically computed from the
+value provided in the env var in such a way that the application process
+and any forks or threads should continue to have their own unique seed but
+that the program may be run twice with identical results as far as
+C<rand()> goes (assuming all else is equal).
+
+PERL_RAND_SEED is intended for performance measurements and debugging
+and is explicitly NOT intended for stable testing. The only guarantee is
+that a specific perl executable will produce the same results twice in a
+row, there is no guarantee that the results will be the same between
+perl releases or on different architectures.
+
+Ignored if perl is run setuid or setgid.
+
=back
Perl also has environment variables that control how Perl handles data
PP(pp_rand)
{
if (!PL_srand_called) {
- (void)seedDrand01((Rand_seed_t)seed());
+ Rand_seed_t s;
+ if (PL_srand_override) {
+ /* env var PERL_RAND_SEED has been set so the user wants
+ * consistent srand() initialization. */
+ PERL_SRAND_OVERRIDE_GET(s);
+ } else {
+ /* Pseudo random initialization from context state and possible
+ * random devices */
+ s= (Rand_seed_t)seed();
+ }
+ (void)seedDrand01(s);
PL_srand_called = TRUE;
}
{
}
}
else {
- anum = seed();
+ if (PL_srand_override) {
+ /* env var PERL_RAND_SEED has been set so the user wants
+ * consistent srand() initialization. */
+ PERL_SRAND_OVERRIDE_GET(anum);
+ } else {
+ anum = seed();
+ }
}
(void)seedDrand01((Rand_seed_t)anum);
sigset_t oldmask, newmask;
#endif
+
EXTEND(SP, 1);
PERL_FLUSHALL_FOR_CHILD;
#ifdef HAS_SIGPROCMASK
#ifdef PERL_USES_PL_PIDSTATUS
hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
#endif
+ PERL_SRAND_OVERRIDE_NEXT_CHILD();
+ } else {
+ PERL_SRAND_OVERRIDE_NEXT_PARENT();
}
PUSHi(childpid);
RETURN;
childpid = PerlProc_fork();
if (childpid == -1)
RETPUSHUNDEF;
+ else if (childpid) {
+ /* we are in the parent */
+ PERL_SRAND_OVERRIDE_NEXT_PARENT();
+ }
+ else {
+ /* This is part of the logic supporting the env var
+ * PERL_RAND_SEED which causes use of rand() without an
+ * explicit srand() to use a deterministic seed. This logic is
+ * intended to give most forked children of a process a
+ * deterministic but different srand seed.
+ */
+ PERL_SRAND_OVERRIDE_NEXT_CHILD();
+ }
PUSHi(childpid);
RETURN;
#else
PL_srand_called = proto_perl->Isrand_called;
Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
+ PL_srand_override = proto_perl->Isrand_override;
+ PL_srand_override_next = proto_perl->Isrand_override_next;
if (flags & CLONEf_COPY_STACKS) {
/* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
}
# This test checks whether Perl called srand for you.
-@first_run = `$^X -le "print int rand 100 for 1..100"`;
-sleep(1); # in case our srand() is too time-dependent
-@second_run = `$^X -le "print int rand 100 for 1..100"`;
+{
+ local $ENV{PERL_RAND_SEED};
+ @first_run = `$^X -le "print int rand 100 for 1..100"`;
+ sleep(1); # in case our srand() is too time-dependent
+ @second_run = `$^X -le "print int rand 100 for 1..100"`;
+}
ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically');
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+ require Config;
+ Config->import;
+}
+
+skip_all_without_config('d_fork');
+skip_all("This perl is built with NO_PERL_RAND_SEED")
+ if $Config{ccflags} =~ /-DNO_PERL_RAND_SEED\b/;
+use strict;
+use warnings;
+
+for (1..2) {
+ local $ENV{PERL_RAND_SEED} = 1;
+ fresh_perl_is("print map { chr(rand(26)+65) } 1..10",
+ "BLVIOAEZTJ", undef, "Test randomness with PERL_RAND_SEED=1");
+}
+
+for (1..2) {
+ local $ENV{PERL_RAND_SEED} = 2;
+ fresh_perl_is("print map { chr(rand(26)+65) } 1..10",
+ "XEOUOFRPQZ", undef, "Test randomness with PERL_RAND_SEED=2");
+}
+
+my %got;
+for my $try (1..10) {
+ local $ENV{PERL_RAND_SEED};
+ my ($out,$err)= runperl_and_capture({}, ['-e',"print map { chr(rand(26)+65) } 1..10;"]);
+ if ($err) { diag $err }
+ $got{$out}++;
+}
+ok(8 <= keys %got, "Got at least 8 different strings");
+for (1..2) {
+ local $ENV{PERL_RAND_SEED} = 1;
+ my ($out,$err)= runperl_and_capture({}, ['-le',
+ <<'EOF_TEST_CODE'
+ for my $l ("A".."E") {
+ my $pid= fork;
+ if ($pid) {
+ push @pids, $pid;
+ }
+ elsif (!defined $pid) {
+ print "$l:failed fork";
+ } elsif (!$pid) {
+ print "$l:", map { chr(rand(26)+65) } 1..10;
+ exit;
+ }
+ }
+ waitpid $_,0 for @pids;
+EOF_TEST_CODE
+ ]);
+ is($err, "", "No exceptions forking.");
+ my @parts= sort { $a cmp $b } split /\n/, $out;
+ my @want= (
+ "A:KNXDITWWJZ",
+ "B:WDQJGTBJQS",
+ "C:ZGYCCINIHE",
+ "D:UGLGAEXFBP",
+ "E:MQLTNZGZQB"
+ );
+ is("@parts","@want","Works as expected with forks.");
+}
+
+done_testing();
https://perl5.git.perl.org / perl5.git / commitdiff