Skip Menu |

Subject: Safety for -i option
Date: Sun, 6 Mar 2016 05:32:33 -0500
From: Yanyan Jiang <jiangyy [...] outlook.com>
To: perlbug [...] perl.org
Download inplace-safety.rep
application/octet-stream 3.6k

Message body not shown because it is not plain text.

Download (untitled) / with headers
text/plain 114b
Regards, Yanyan Jiang 蒋炎岩 Institute of Computer Software, Dept. of Computer Science, Nanjing University
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 410b
On Sun Mar 06 02:32:46 2016, jiangyy@outlook.com wrote: Show quoted text
> > > > Regards, > Yanyan Jiang 蒋炎岩 > Institute of Computer Software, > Dept. of Computer Science, Nanjing University >
Since the bug report was attached with a file extension which RT reports as a binary file, the report may not be visible. I am re-attaching as a plain-text file. Thank you very much. -- James E Keenan (jkeenan@cpan.org)
Subject: 127663.txt
Download 127663.txt
text/plain 3.6k
To: perlbug@perl.org Subject: Safety for -i option From: jiangyy@outlook.com Message-Id: <5.22.1_10199_1457258711@ubuntuvm> Reply-To: jiangyy@outlook.com This is a bug report for perl from jiangyy@outlook.com, generated with the help of perlbug 1.40 running under perl 5.22.1. ----------------------------------------------------------------- Like sed, perl can be used with -i to change files in-place. However, our tool discovered that the saving procedure is not as safe as sed. The system call trace (from 5.22.1): open("file.txt", O_RDONLY|O_LARGEFILE) = 3 _llseek(3, 0, [0], SEEK_CUR) = 0 unlink("file.txt") = 0 open("file.txt", O_WRONLY|O_CREAT|O_EXCL|O_LARGEFILE, 0600) = 4 read(3, ...) read(3, ...) write(4, ...) ... If the program terminates in between, the file-system runs out of space (when the replaced text is longer) or the system crashes, the contents may lost (the worst case, completely gone due to the unlink). sed uses a temporary file to get the job and rename it. But it seems difficult to work considering portability. Many infrastructures (e.g., gtk and qt) provide portable solution, but seems not to apply with perl. Thank you for your attention! ----------------------------------------------------------------- --- Flags: category=core severity=medium --- Site configuration information for perl 5.22.1: Configured by jyy at Sun Mar 6 04:34:47 EST 2016. Summary of my perl5 (revision 5 version 22 subversion 1) configuration: Platform: osname=linux, osvers=4.2.0-27-generic, archname=i686-linux uname='linux ubuntuvm 4.2.0-27-generic #32~14.04.1-ubuntu smp fri jan 22 15:32:27 utc 2016 i686 i686 i686 gnulinux ' config_args='-ds -e' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.8.4', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, doublekind=3 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12, longdblkind=3 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /usr/lib/gcc/i686-linux-gnu/4.8/include-fixed /usr/include/i386-linux-gnu /usr/lib /lib/i386-linux-gnu /lib/../lib /usr/lib/i386-linux-gnu /usr/lib/../lib /lib libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc libc=libc-2.19.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.19' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector' --- @INC for perl 5.22.1: /usr/local/lib/perl5/site_perl/5.22.1/i686-linux /usr/local/lib/perl5/site_perl/5.22.1 /usr/local/lib/perl5/5.22.1/i686-linux /usr/local/lib/perl5/5.22.1 . --- Environment for perl 5.22.1: HOME=/home/jyy LANG=en_US.UTF-8 LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games PERL_BADLANG (unset) SHELL=/bin/bash
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 852b
On Sun Mar 06 02:32:46 2016, jiangyy@outlook.com wrote: Show quoted text
> > > > Regards, > Yanyan Jiang 蒋炎岩 > Institute of Computer Software, > Dept. of Computer Science, Nanjing University >
From original report: ##### Like sed, perl can be used with -i to change files in-place. However, our tool discovered that the saving procedure is not as safe as sed. The system call trace (from 5.22.1): open("file.txt", O_RDONLY|O_LARGEFILE) = 3 _llseek(3, 0, [0], SEEK_CUR) = 0 unlink("file.txt") = 0 open("file.txt", O_WRONLY|O_CREAT|O_EXCL|O_LARGEFILE, 0600) = 4 read(3, ...) read(3, ...) write(4, ...) ... ##### Can you supply us with: (a) the list of commands you invoked at the command-line to get these results; (b) some idea of the size of the file in question relative to the size of memory? Thank you very much. -- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 526b
Show quoted text
> Can you supply us with: (a) the list of commands you invoked at the > command-line to get these results; (b) some idea of the size of the > file in question relative to the size of memory? > > Thank you very much.
Also: (c) You said: "sed uses a temporary file to get the job and rename it. But it seems difficult to work considering portability. Many infrastructures (e.g., gtk and qt) provide portable solution, but seems not to apply with perl." Can you elaborate on the portable solutions that gtk and qt provide?
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.2k
On Sun Mar 06 05:58:12 2016, jkeenan wrote: Show quoted text
> On Sun Mar 06 02:32:46 2016, jiangyy@outlook.com wrote:
> > > > > > > > Regards, > > Yanyan Jiang 蒋炎岩 > > Institute of Computer Software, > > Dept. of Computer Science, Nanjing University > >
> > From original report: > ##### > Like sed, perl can be used with -i to change files in-place. However, > our tool discovered that the saving procedure is not as safe as sed. > The system call trace (from 5.22.1): > > open("file.txt", O_RDONLY|O_LARGEFILE) = 3 > _llseek(3, 0, [0], SEEK_CUR) = 0 > unlink("file.txt") = 0 > > open("file.txt", O_WRONLY|O_CREAT|O_EXCL|O_LARGEFILE, 0600) = 4 > read(3, ...) > read(3, ...) > write(4, ...) ... > ##### > > Can you supply us with: (a) the list of commands you invoked at the > command-line to get these results; (b) some idea of the size of the > file in question relative to the size of memory?
Here's my attempt: % echo hi > tmp.txt % strace -o strace.log perl -i -pe '' tmp.txt Excerpt from strace.log: open("tmp.txt", O_RDONLY|O_LARGEFILE) = 3 ioctl(3, TCGETS, 0xbfdd070c) = -1 ENOTTY (Inappropriate ioctl for device) _llseek(3, 0, [0], SEEK_CUR) = 0 fstat64(3, {st_mode=S_IFREG|0644, st_size=3, ...}) = 0 fcntl64(3, F_SETFD, FD_CLOEXEC) = 0 unlink("tmp.txt") = 0 open("tmp.txt", O_WRONLY|O_CREAT|O_EXCL|O_LARGEFILE, 0600) = 4 ioctl(4, TCGETS, 0xbfdd070c) = -1 ENOTTY (Inappropriate ioctl for device) _llseek(4, 0, [0], SEEK_CUR) = 0 fstat64(4, {st_mode=S_IFREG|0600, st_size=0, ...}) = 0 fcntl64(4, F_SETFD, FD_CLOEXEC) = 0 fstat64(4, {st_mode=S_IFREG|0600, st_size=0, ...}) = 0 fchmod(4, 0100644) = 0 read(3, "hi\n", 8192) = 3 read(3, "", 8192) = 0 write(4, "hi\n", 3) = 3 close(4) = 0 close(3) = 0 So, the file is tiny in this case (not sure why that matters?). Perl opens the input file (fd #3), unlinks it, then opens the same name again (fd #4), then streams data from fd 3 to fd 4. If perl dies after the unlink() but before it is done writing to fd 4 and closing it, you get a truncated (or completely missing) output file.
Subject: Re: [perl #127663] Safety for -i option
CC: ;, perl5-porters [...] perl.org
From: Ricardo Signes <perl.p5p [...] rjbs.manxome.org>
To: "l.mai [...] web.de via RT" <perlbug-followup [...] perl.org>
Date: Sun, 6 Mar 2016 16:26:39 -0500
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.5k
On Sun Mar 06 07:15:04 2016, jhi wrote: Show quoted text
> > Can you supply us with: (a) the list of commands you invoked at the > > command-line to get these results; (b) some idea of the size of the > > file in question relative to the size of memory? > > > > Thank you very much.
> > Also: > > (c) You said: "sed uses a temporary file to get the job and rename it. > But it seems > difficult to work considering portability. Many infrastructures (e.g., > gtk and qt) provide portable solution, but seems not to apply with > perl." > > Can you elaborate on the portable solutions that gtk and qt provide?
I got the below email from jiangyy@outlook.com: -- cut here -- Hi Jarkko, My reply of bug #127663 is not appearing in the bug tracking system (I just replied the mail, sending to perlbug-followup@perl.org with subject “Re: [perl #127663] Safety for -i option”, and I have no idea why that does not work). I listed the comments below. Maybe you can post it. ------- Sed just uses rename() to replace the file with a temporary one, seems it is assuming a POSIX runtime, and this is POSIX safe. Gtk provides g_file_replace(), and Qt provides QSaveFile. Both are portable. We extensively tested these two implementations, and they are both safe in handling file overwrite. We believe that perl is an extremely portable software, and semantics of rename() may be different on other platforms, and this shall be handled with care (though I’m not an expert on portability). Regards, Yanyan Jiang 蒋炎岩 Institute of Computer Software, Dept. of Computer Science, Nanjing University
Subject: Re: [perl #127663] Safety for -i option
To: perlbug-followup [...] perl.org
From: Yanyan Jiang <jiangyy [...] outlook.com>
Date: Sun, 6 Mar 2016 13:41:20 -0500
Download (untitled) / with headers
text/plain 1.2k
Show quoted text
> Can you supply us with: (a) the list of commands you invoked at the command-line to get these results; (b) some idea of the size of the file in question relative to the size of memory?
For perl, I just used a simple case of in-place text replacement: perl5.22.1 -i -pe 's/old/new/g’ file.txt I get the system-call trace via strace COMMAND The file is small (just kilobytes). If the program terminates just after unlink(), the file is gone. I simulated this process by killing it immediately after unlink(), and the file is indeed gone. If the file contents are huge, the overwrite itself can cause inconsistency (the first half is updated, the second half is old, and there are some corruptions in the middle). Show quoted text
> Can you elaborate on the portable solutions that gtk and qt provide?
Sed just uses rename() to replace the file with a temporary one, seems it is assuming a POSIX runtime, and this is POSIX safe. Gtk provides g_file_replace(), and Qt provides QSaveFile. Both are portable. We extensively tested these two implementations, and they are both safe in handling file overwrite. We believe that perl is an extremely portable software, and semantics of rename() may be different on other platforms, and this shall be handled with care (though I’m not an expert on portability).
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 342b
On Sun Mar 06 02:32:46 2016, jiangyy@outlook.com wrote: Show quoted text
> the file-system runs out of space (when the replaced text is longer)
It isn't necessary for the replaced text to be longer. We're unlinking the file, but keeping a file handle open to it. On a POSIX system the file will continue to take space until the file handle is closed. Tony
CC: perl5-porters [...] perl.org
From: Dave Mitchell <davem [...] iabyn.com>
To: Tony Cook via RT <perlbug-followup [...] perl.org>
Date: Tue, 5 Apr 2016 15:54:43 +0100
Subject: Re: [perl #127663] Safety for -i option
Download (untitled) / with headers
text/plain 1.1k
On Mon, Mar 07, 2016 at 04:10:03PM -0800, Tony Cook via RT wrote: Show quoted text
> On Sun Mar 06 02:32:46 2016, jiangyy@outlook.com wrote:
> > the file-system runs out of space (when the replaced text is longer)
> > It isn't necessary for the replaced text to be longer. > > We're unlinking the file, but keeping a file handle open to it. On a > POSIX system the file will continue to take space until the file handle > is closed.
For anyone following this ticket, a simple demonstration of why -i is currently unsafe: Here foo gets completely truncated: $ echo "hello" > foo; ./perl -i -pe'die' foo Died at -e line 1, <> line 1. $ ls -l foo -rw-rw-r--. 1 davem davem 0 Apr 5 15:49 foo $ and here foo gets partially truncated: $ perl -le'print "a" x 80 for 1..10_000' > foo $ ls -l foo -rw-rw-r--. 1 davem davem 810000 Apr 5 15:51 foo $ ./perl -i -pe'die if $. == 9_900' foo Died at -e line 1, <> line 9900. $ ls -l foo -rw-rw-r--. 1 davem davem 801819 Apr 5 15:52 foo $ -- It's not that I'm afraid to die, I just don't want to be there when it happens. -- Woody Allen
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.6k
On Tue Apr 05 07:55:14 2016, davem wrote: Show quoted text
> On Mon, Mar 07, 2016 at 04:10:03PM -0800, Tony Cook via RT wrote:
> > On Sun Mar 06 02:32:46 2016, jiangyy@outlook.com wrote:
> > > the file-system runs out of space (when the replaced text is longer)
> > > > It isn't necessary for the replaced text to be longer. > > > > We're unlinking the file, but keeping a file handle open to it. On a > > POSIX system the file will continue to take space until the file handle > > is closed.
> > For anyone following this ticket, a simple demonstration of why -i is > currently unsafe: > > Here foo gets completely truncated: > > $ echo "hello" > foo; ./perl -i -pe'die' foo > Died at -e line 1, <> line 1. > $ ls -l foo > -rw-rw-r--. 1 davem davem 0 Apr 5 15:49 foo > $ > > and here foo gets partially truncated: > > $ perl -le'print "a" x 80 for 1..10_000' > foo > $ ls -l foo > -rw-rw-r--. 1 davem davem 810000 Apr 5 15:51 foo > $ ./perl -i -pe'die if $. == 9_900' foo > Died at -e line 1, <> line 9900. > $ ls -l foo > -rw-rw-r--. 1 davem davem 801819 Apr 5 15:52 foo > $
One problem I have with this example is I'm not sure die should be treated as a failure case. Should a similar case where exit() is called instead of die() revert any edits? If not, I don't see a reliable mechanism to distinguish the two. For the standard -n or -p generated loop it's fine because the user can expect iterating to the next in-place file will close the old ARGVOUT and do whatever extra cleanup is needed to replace the input file with the output (nothing currently, a rename for my working branch), but what if the user "last"s out of the inplace loop for some reason? Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 261b
The attached patch attempts to fix this issue. It also fixes an issue with nested in-place editing, where the inner in-place edit could overwrite the permissions referenced for the outer edit, which are used to restore set[gu]id flags on the output file. Tony
Subject: in-place-edit.patch
Download in-place-edit.patch
text/plain 33.6k

Message body is not shown because it is too large.

Subject: Re: [perl #127663] Safety for -i option
From: Petr Pisar <ppisar [...] redhat.com>
To: perl5-porters [...] perl.org
Date: Tue, 6 Dec 2016 08:48:32 +0000 (UTC)
Download (untitled) / with headers
text/plain 948b
On 2016-12-06, Tony Cook via RT <perlbug-followup@perl.org> wrote: Show quoted text
> The attached patch attempts to fix this issue. >
Thank you tackling this problem. Show quoted text
> The implementation (beyond some TODO issues below) has at least one > problem - if the user code changes directory between the file open and > the close then the final clean-up stage is going to fail if the input > name wasn't an absolute path. > > This might be fixable, but on some systems it may put the perl process > in a difficult to recover from position - if the system doesn't > implement getcwd() perl may change directory out of the original and not > have a way to return to it.
POSIX.1-2008 has renameat() that allows to specify a file by an opened directory descriptor and a relative file name. I know it won't help you if you need to deal with systems without getcwd(), but still it could avoid some races when people replace directories with files the perl works on. -- Petr
From: demerphq <demerphq [...] gmail.com>
To: Perl RT Bug Tracker <perlbug-followup [...] perl.org>
Date: Tue, 6 Dec 2016 11:09:40 +0100
Subject: Re: [perl #127663] Safety for -i option
CC: Perl5 Porteros <perl5-porters [...] perl.org>
Download (untitled) / with headers
text/plain 4.5k
On 6 December 2016 at 06:05, Tony Cook via RT <perlbug-followup@perl.org> wrote: Show quoted text
> The attached patch attempts to fix this issue. > > It also fixes an issue with nested in-place editing, where the inner > in-place edit could overwrite the permissions referenced for the outer > edit, which are used to restore set[gu]id flags on the output file. > > Tony > > --- > via perlbug: queue: perl5 status: open > https://rt.perl.org/Ticket/Display.html?id=127663 > > From ecdd0c8dc1cc35cdace9f67e5e08f7822e12813c Mon Sep 17 00:00:00 2001 > From: Tony Cook <tony@develop-help.com> > Date: Wed, 18 May 2016 15:03:14 +1000 > Subject: (perl #127663) create a separate random souce for internal use > > and use it to initialize hash randomization and to innoculate against > quadratic behaviour in pp_sort > --- > embedvar.h | 1 + > intrpvar.h | 8 ++++++++ > perl.c | 2 ++ > pp_sort.c | 2 +- > util.c | 4 +--- > util.h | 6 ++++++ > 6 files changed, 19 insertions(+), 4 deletions(-) > > diff --git a/embedvar.h b/embedvar.h > index c413932..7588807 100644 > --- a/embedvar.h > +++ b/embedvar.h > @@ -173,6 +173,7 @@ > #define PL_incgv (vTHX->Iincgv) > #define PL_initav (vTHX->Iinitav) > #define PL_inplace (vTHX->Iinplace) > +#define PL_internal_random_state (vTHX->Iinternal_random_state) > #define PL_isarev (vTHX->Iisarev) > #define PL_known_layers (vTHX->Iknown_layers) > #define PL_last_in_gv (vTHX->Ilast_in_gv) > diff --git a/intrpvar.h b/intrpvar.h > index 1aa94f7..532a458 100644 > --- a/intrpvar.h > +++ b/intrpvar.h > @@ -810,6 +810,14 @@ PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE) > > PERLVARI(I, dump_re_max_len, STRLEN, 0) > > +/* For internal uses of randomness, this ensures the sequence of > + * random numbers returned by rand() isn't modified by perl's internal > + * use of randomness. > + * This is important if the user has called srand() with a seed. > + */ > + > +PERLVAR(I, internal_random_state, PL_RANDOM_STATE_TYPE) > + > /* If you are adding a U8 or U16, check to see if there are 'Space' comments > * above on where there are gaps which currently will be structure padding. */ > > diff --git a/perl.c b/perl.c > index 3a647f7..dd67d4e 100644 > --- a/perl.c > +++ b/perl.c > @@ -261,6 +261,8 @@ perl_construct(pTHXx) > > init_constants(); > > + Perl_drand48_init_r(&PL_internal_random_state, seed()); > + > SvREADONLY_on(&PL_sv_placeholder); > SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL; > > diff --git a/pp_sort.c b/pp_sort.c > index 68e65f9..7aa44eb 100644 > --- a/pp_sort.c > +++ b/pp_sort.c > @@ -787,7 +787,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare) > size_t n; > SV ** const q = array; > for (n = num_elts; n > 1; ) { > - const size_t j = (size_t)(n-- * Drand01()); > + const size_t j = (size_t)(n-- * Perl_internal_drand48()); > temp = q[j]; > q[j] = q[n]; > q[n] = temp; > diff --git a/util.c b/util.c > index 02c84c8..ef13e8b 100644 > --- a/util.c > +++ b/util.c > @@ -4757,10 +4757,8 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) > else > #endif > { > - (void)seedDrand01((Rand_seed_t)seed()); > - > for( i = 0; i < PERL_HASH_SEED_BYTES; i++ ) { > - seed_buffer[i] = (unsigned char)(Drand01() * (U8_MAX+1)); > + seed_buffer[i] = (unsigned char)(Perl_internal_drand48() * (U8_MAX+1)); > } > } > #ifdef USE_PERL_PERTURB_KEYS > diff --git a/util.h b/util.h > index 8f4171b..c71eefd 100644 > --- a/util.h > +++ b/util.h > @@ -85,6 +85,12 @@ typedef struct PERL_DRAND48_T perl_drand48_t; > #define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed))) > #define Perl_drand48() (Perl_drand48_r(&PL_random_state)) > > +#ifdef PERL_CORE > +/* uses a different source of randomness to avoid interfering with the results > + * of rand() */ > +#define Perl_internal_drand48() (Perl_drand48_r(&PL_internal_random_state)) > +#endif > + > #ifdef USE_C_BACKTRACE > > typedef struct { > -- > 2.1.4
I like this patch a lot. I can think of other uses of the new Perl_internal_drand48() too. I do have one hazy question. Is it right to do this in qsort()? I wonder if a user might expect qsort() to be deterministic under srand(). We have ways of overriding the randomness in the hash seed, so should we not have a way to override or control the randomness in something like qsort()? Perhaps we should have a way to set the seed for the PL_internal_random_state from the env like we do for the hash seed. Yves
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.4k
On Tue, 06 Dec 2016 00:49:20 -0800, ppisar wrote: Show quoted text
> On 2016-12-06, Tony Cook via RT <perlbug-followup@perl.org> wrote:
> > The attached patch attempts to fix this issue. > >
> Thank you tackling this problem. >
> > The implementation (beyond some TODO issues below) has at least one > > problem - if the user code changes directory between the file open and > > the close then the final clean-up stage is going to fail if the input > > name wasn't an absolute path. > > > > This might be fixable, but on some systems it may put the perl process > > in a difficult to recover from position - if the system doesn't > > implement getcwd() perl may change directory out of the original and not > > have a way to return to it.
> > POSIX.1-2008 has renameat() that allows to specify a file by an opened > directory descriptor and a relative file name. I know it won't help you > if you need to deal with systems without getcwd(), but still it could > avoid some races when people replace directories with files the perl > works on.
getcwd() isn't enough to fix the possible issues. With the current implementation (ie. without the patch in this ticket) the current directory can be renamed, have its parent's permissions changed to prevent access or even be removed, with the inode staying live because it's the current directory. Using the *at() functions (along with dirfd()) can fix this, but getcwd() isn't enough. I think it's valuable to implement, but it adds another variation to test, so I've left it for now. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 5.5k
On Tue, 06 Dec 2016 02:10:28 -0800, demerphq wrote: Show quoted text
> On 6 December 2016 at 06:05, Tony Cook via RT <perlbug- > followup@perl.org> wrote:
> > The attached patch attempts to fix this issue. > > > > It also fixes an issue with nested in-place editing, where the inner > > in-place edit could overwrite the permissions referenced for the > > outer > > edit, which are used to restore set[gu]id flags on the output file. > > > > Tony > > > > --- > > via perlbug: queue: perl5 status: open > > https://rt.perl.org/Ticket/Display.html?id=127663 > > > > From ecdd0c8dc1cc35cdace9f67e5e08f7822e12813c Mon Sep 17 00:00:00 > > 2001 > > From: Tony Cook <tony@develop-help.com> > > Date: Wed, 18 May 2016 15:03:14 +1000 > > Subject: (perl #127663) create a separate random souce for internal > > use > > > > and use it to initialize hash randomization and to innoculate against > > quadratic behaviour in pp_sort > > --- > > embedvar.h | 1 + > > intrpvar.h | 8 ++++++++ > > perl.c | 2 ++ > > pp_sort.c | 2 +- > > util.c | 4 +--- > > util.h | 6 ++++++ > > 6 files changed, 19 insertions(+), 4 deletions(-) > > > > diff --git a/embedvar.h b/embedvar.h > > index c413932..7588807 100644 > > --- a/embedvar.h > > +++ b/embedvar.h > > @@ -173,6 +173,7 @@ > > #define PL_incgv (vTHX->Iincgv) > > #define PL_initav (vTHX->Iinitav) > > #define PL_inplace (vTHX->Iinplace) > > +#define PL_internal_random_state (vTHX-
> > >Iinternal_random_state)
> > #define PL_isarev (vTHX->Iisarev) > > #define PL_known_layers (vTHX->Iknown_layers) > > #define PL_last_in_gv (vTHX->Ilast_in_gv) > > diff --git a/intrpvar.h b/intrpvar.h > > index 1aa94f7..532a458 100644 > > --- a/intrpvar.h > > +++ b/intrpvar.h > > @@ -810,6 +810,14 @@ PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE) > > > > PERLVARI(I, dump_re_max_len, STRLEN, 0) > > > > +/* For internal uses of randomness, this ensures the sequence of > > + * random numbers returned by rand() isn't modified by perl's > > internal > > + * use of randomness. > > + * This is important if the user has called srand() with a seed. > > + */ > > + > > +PERLVAR(I, internal_random_state, PL_RANDOM_STATE_TYPE) > > + > > /* If you are adding a U8 or U16, check to see if there are 'Space' > > comments > > * above on where there are gaps which currently will be structure > > padding. */ > > > > diff --git a/perl.c b/perl.c > > index 3a647f7..dd67d4e 100644 > > --- a/perl.c > > +++ b/perl.c > > @@ -261,6 +261,8 @@ perl_construct(pTHXx) > > > > init_constants(); > > > > + Perl_drand48_init_r(&PL_internal_random_state, seed()); > > + > > SvREADONLY_on(&PL_sv_placeholder); > > SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL; > > > > diff --git a/pp_sort.c b/pp_sort.c > > index 68e65f9..7aa44eb 100644 > > --- a/pp_sort.c > > +++ b/pp_sort.c > > @@ -787,7 +787,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, > > SVCOMPARE_t compare) > > size_t n; > > SV ** const q = array; > > for (n = num_elts; n > 1; ) { > > - const size_t j = (size_t)(n-- * Drand01()); > > + const size_t j = (size_t)(n-- * Perl_internal_drand48()); > > temp = q[j]; > > q[j] = q[n]; > > q[n] = temp; > > diff --git a/util.c b/util.c > > index 02c84c8..ef13e8b 100644 > > --- a/util.c > > +++ b/util.c > > @@ -4757,10 +4757,8 @@ Perl_get_hash_seed(pTHX_ unsigned char * const > > seed_buffer) > > else > > #endif > > { > > - (void)seedDrand01((Rand_seed_t)seed()); > > - > > for( i = 0; i < PERL_HASH_SEED_BYTES; i++ ) { > > - seed_buffer[i] = (unsigned char)(Drand01() * > > (U8_MAX+1)); > > + seed_buffer[i] = (unsigned char)(Perl_internal_drand48() > > * (U8_MAX+1)); > > } > > } > > #ifdef USE_PERL_PERTURB_KEYS > > diff --git a/util.h b/util.h > > index 8f4171b..c71eefd 100644 > > --- a/util.h > > +++ b/util.h > > @@ -85,6 +85,12 @@ typedef struct PERL_DRAND48_T perl_drand48_t; > > #define Perl_drand48_init(seed) > > (Perl_drand48_init_r(&PL_random_state, (seed))) > > #define Perl_drand48() (Perl_drand48_r(&PL_random_state)) > > > > +#ifdef PERL_CORE > > +/* uses a different source of randomness to avoid interfering with > > the results > > + * of rand() */ > > +#define Perl_internal_drand48() > > (Perl_drand48_r(&PL_internal_random_state)) > > +#endif > > + > > #ifdef USE_C_BACKTRACE > > > > typedef struct { > > -- > > 2.1.4
> > I like this patch a lot. I can think of other uses of the new > Perl_internal_drand48() too.
Part of the impetus for adding it was your suggestion in #115928. Show quoted text
> I do have one hazy question. Is it right to do this in qsort()? I > wonder if a user might expect qsort() to be deterministic under > srand(). We have ways of overriding the randomness in the hash seed, > so should we not have a way to override or control the randomness in > something like qsort()? Perhaps we should have a way to set the seed > for the PL_internal_random_state from the env like we do for the hash > seed.
The use of randomness in qsort() is sufficiently internal that I don't see much point to providing a runtime mechanism like srand() to control the internal randomness. If a user does want such randomness they can do something like: srand($some_number); # or not @sorted = map $_->[0], sort { $a->[0] cmp $b->[1] || $a->[1] <=> $b->[1] } map [ $_, rand ], @input; An environment variable is suitable though, per the attached patch. I noticed there doesn't seem to be a way to build perl to have hash seed randomization but disable the PERL_HASH_SEED environment variable. Is that deliberate? Tony
Subject: 0001-perl-127663-provide-limited-control-for-the-internal.patch
From 9eb4256cbc54e7d68ce05ebc227afe254f2876db Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 7 Dec 2016 14:38:06 +1100 Subject: [PATCH] (perl #127663) provide limited control for the internal drand48() perl can be built without PERL_INTERNAL_SEED support to reduce it's attack surface. --- INSTALL | 6 ++++++ perl.c | 29 +++++++++++++++++++++++++++++ pod/perlrun.pod | 12 ++++++++++++ 3 files changed, 47 insertions(+) diff --git a/INSTALL b/INSTALL index 158b382..7267eb6 100644 --- a/INSTALL +++ b/INSTALL @@ -2685,6 +2685,12 @@ F<mathoms.c> will not be compiled in. Those functions are no longer used by perl itself; for source compatibility reasons, though, they weren't completely removed. +=head2 C<-DNO_PERL_INTERNAL_SEED> +X<PERL_INTERNAL_SEED> + +If you configure perl with C<-Accflags=-DNO_PERL_INTERNAL_SEED>, perl +will ignore the C<PERL_INTERNAL_SEED> enviroment variable. + =head1 DOCUMENTATION Read the manual entries before running perl. The main documentation diff --git a/perl.c b/perl.c index 6ff0e43..16dc2b6 100644 --- a/perl.c +++ b/perl.c @@ -261,7 +261,21 @@ perl_construct(pTHXx) init_constants(); +#ifdef NO_PERL_INTERNAL_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_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; @@ -2159,6 +2173,21 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } +#ifndef NO_PERL_INTERNAL_SEED + /* If we're not set[ug]id, we might have honored + PERL_INTERNAL_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_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); diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 9d59a6a..d92c899 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -1384,6 +1384,18 @@ X<SYS$LOGIN> Used if chdir has no argument and HOME and LOGDIR are not set. +=item PERL_INTERNAL_SEED +X<PERL_INTERNAL_SEED> + +Set to a non-negative integer to seed the random number generator used +internally by perl for a variety of purposes. + +Ignored if perl is run setuid or setgid. Used only for some limited +startup randomization (hash keys) if C<-T> or C<-t> perl is started +with tainting enabled. + +Perl may be built to ignore this variable. + =back Perl also has environment variables that control how Perl handles data -- 2.1.4
Subject: Re: [perl #127663] Safety for -i option
CC: Perl5 Porteros <perl5-porters [...] perl.org>
To: Perl RT Bug Tracker <perlbug-followup [...] perl.org>
Date: Wed, 7 Dec 2016 10:01:11 +0100
From: demerphq <demerphq [...] gmail.com>
Download (untitled) / with headers
text/plain 10.2k
On 7 December 2016 at 04:43, Tony Cook via RT <perlbug-followup@perl.org> wrote: Show quoted text
> On Tue, 06 Dec 2016 02:10:28 -0800, demerphq wrote:
>> On 6 December 2016 at 06:05, Tony Cook via RT <perlbug- >> followup@perl.org> wrote:
>> > The attached patch attempts to fix this issue. >> > >> > It also fixes an issue with nested in-place editing, where the inner >> > in-place edit could overwrite the permissions referenced for the >> > outer >> > edit, which are used to restore set[gu]id flags on the output file. >> > >> > Tony >> > >> > --- >> > via perlbug: queue: perl5 status: open >> > https://rt.perl.org/Ticket/Display.html?id=127663 >> > >> > From ecdd0c8dc1cc35cdace9f67e5e08f7822e12813c Mon Sep 17 00:00:00 >> > 2001 >> > From: Tony Cook <tony@develop-help.com> >> > Date: Wed, 18 May 2016 15:03:14 +1000 >> > Subject: (perl #127663) create a separate random souce for internal >> > use >> > >> > and use it to initialize hash randomization and to innoculate against >> > quadratic behaviour in pp_sort >> > --- >> > embedvar.h | 1 + >> > intrpvar.h | 8 ++++++++ >> > perl.c | 2 ++ >> > pp_sort.c | 2 +- >> > util.c | 4 +--- >> > util.h | 6 ++++++ >> > 6 files changed, 19 insertions(+), 4 deletions(-) >> > >> > diff --git a/embedvar.h b/embedvar.h >> > index c413932..7588807 100644 >> > --- a/embedvar.h >> > +++ b/embedvar.h >> > @@ -173,6 +173,7 @@ >> > #define PL_incgv (vTHX->Iincgv) >> > #define PL_initav (vTHX->Iinitav) >> > #define PL_inplace (vTHX->Iinplace) >> > +#define PL_internal_random_state (vTHX-
>> > >Iinternal_random_state)
>> > #define PL_isarev (vTHX->Iisarev) >> > #define PL_known_layers (vTHX->Iknown_layers) >> > #define PL_last_in_gv (vTHX->Ilast_in_gv) >> > diff --git a/intrpvar.h b/intrpvar.h >> > index 1aa94f7..532a458 100644 >> > --- a/intrpvar.h >> > +++ b/intrpvar.h >> > @@ -810,6 +810,14 @@ PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE) >> > >> > PERLVARI(I, dump_re_max_len, STRLEN, 0) >> > >> > +/* For internal uses of randomness, this ensures the sequence of >> > + * random numbers returned by rand() isn't modified by perl's >> > internal >> > + * use of randomness. >> > + * This is important if the user has called srand() with a seed. >> > + */ >> > + >> > +PERLVAR(I, internal_random_state, PL_RANDOM_STATE_TYPE) >> > + >> > /* If you are adding a U8 or U16, check to see if there are 'Space' >> > comments >> > * above on where there are gaps which currently will be structure >> > padding. */ >> > >> > diff --git a/perl.c b/perl.c >> > index 3a647f7..dd67d4e 100644 >> > --- a/perl.c >> > +++ b/perl.c >> > @@ -261,6 +261,8 @@ perl_construct(pTHXx) >> > >> > init_constants(); >> > >> > + Perl_drand48_init_r(&PL_internal_random_state, seed()); >> > + >> > SvREADONLY_on(&PL_sv_placeholder); >> > SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL; >> > >> > diff --git a/pp_sort.c b/pp_sort.c >> > index 68e65f9..7aa44eb 100644 >> > --- a/pp_sort.c >> > +++ b/pp_sort.c >> > @@ -787,7 +787,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, >> > SVCOMPARE_t compare) >> > size_t n; >> > SV ** const q = array; >> > for (n = num_elts; n > 1; ) { >> > - const size_t j = (size_t)(n-- * Drand01()); >> > + const size_t j = (size_t)(n-- * Perl_internal_drand48()); >> > temp = q[j]; >> > q[j] = q[n]; >> > q[n] = temp; >> > diff --git a/util.c b/util.c >> > index 02c84c8..ef13e8b 100644 >> > --- a/util.c >> > +++ b/util.c >> > @@ -4757,10 +4757,8 @@ Perl_get_hash_seed(pTHX_ unsigned char * const >> > seed_buffer) >> > else >> > #endif >> > { >> > - (void)seedDrand01((Rand_seed_t)seed()); >> > - >> > for( i = 0; i < PERL_HASH_SEED_BYTES; i++ ) { >> > - seed_buffer[i] = (unsigned char)(Drand01() * >> > (U8_MAX+1)); >> > + seed_buffer[i] = (unsigned char)(Perl_internal_drand48() >> > * (U8_MAX+1)); >> > } >> > } >> > #ifdef USE_PERL_PERTURB_KEYS >> > diff --git a/util.h b/util.h >> > index 8f4171b..c71eefd 100644 >> > --- a/util.h >> > +++ b/util.h >> > @@ -85,6 +85,12 @@ typedef struct PERL_DRAND48_T perl_drand48_t; >> > #define Perl_drand48_init(seed) >> > (Perl_drand48_init_r(&PL_random_state, (seed))) >> > #define Perl_drand48() (Perl_drand48_r(&PL_random_state)) >> > >> > +#ifdef PERL_CORE >> > +/* uses a different source of randomness to avoid interfering with >> > the results >> > + * of rand() */ >> > +#define Perl_internal_drand48() >> > (Perl_drand48_r(&PL_internal_random_state)) >> > +#endif >> > + >> > #ifdef USE_C_BACKTRACE >> > >> > typedef struct { >> > -- >> > 2.1.4
>> >> I like this patch a lot. I can think of other uses of the new >> Perl_internal_drand48() too.
> > Part of the impetus for adding it was your suggestion in #115928.
Oh, cool. Thanks. :-) Show quoted text
>> I do have one hazy question. Is it right to do this in qsort()? I >> wonder if a user might expect qsort() to be deterministic under >> srand(). We have ways of overriding the randomness in the hash seed, >> so should we not have a way to override or control the randomness in >> something like qsort()? Perhaps we should have a way to set the seed >> for the PL_internal_random_state from the env like we do for the hash >> seed.
> > The use of randomness in qsort() is sufficiently internal that I don't > see much point to providing a runtime mechanism like srand() to control > the internal randomness.
Oh sorry, I didn't mean runtime ala srand, I meant at-startup ala PERL_HASH_SEED. Show quoted text
> If a user does want such randomness they can do something like: > > srand($some_number); # or not > @sorted = map $_->[0], > sort { $a->[0] cmp $b->[1] || $a->[1] <=> $b->[1] } > map [ $_, rand ], @input;
Sure. But I was more thinking of being able to run perl in a mode where you can exactly replicate its behavior as a whole. Show quoted text
> An environment variable is suitable though, per the attached patch.
Yes I like. Show quoted text
> I noticed there doesn't seem to be a way to build perl to have hash seed > randomization but disable the PERL_HASH_SEED environment variable. Is that > deliberate?
No, an oversight. We should probably have build options to disable setting the seed from the env, and also probably one to disable PERL_HASH_SEED_DEBUG. I think at least one vendor hides some or all data from that, we might as well make that easy for all. Anyway I like the patch(es) with one slightly bikeshedding comment that maybe PERL_INTERNAL_SEED should be PERL_INTERNAL_RAND_SEED, or something? As is, it is a bit ambiguous what the SEED is for. Anyway, nice stuff. Thanks for doing this. yves Show quoted text
> Tony > > --- > via perlbug: queue: perl5 status: open > https://rt.perl.org/Ticket/Display.html?id=127663 > > From 9eb4256cbc54e7d68ce05ebc227afe254f2876db Mon Sep 17 00:00:00 2001 > From: Tony Cook <tony@develop-help.com> > Date: Wed, 7 Dec 2016 14:38:06 +1100 > Subject: [PATCH] (perl #127663) provide limited control for the internal > drand48() > > perl can be built without PERL_INTERNAL_SEED support to reduce > it's attack surface. > --- > INSTALL | 6 ++++++ > perl.c | 29 +++++++++++++++++++++++++++++ > pod/perlrun.pod | 12 ++++++++++++ > 3 files changed, 47 insertions(+) > > diff --git a/INSTALL b/INSTALL > index 158b382..7267eb6 100644 > --- a/INSTALL > +++ b/INSTALL > @@ -2685,6 +2685,12 @@ F<mathoms.c> will not be compiled in. Those functions are no longer used > by perl itself; for source compatibility reasons, though, they weren't > completely removed. > > +=head2 C<-DNO_PERL_INTERNAL_SEED> > +X<PERL_INTERNAL_SEED> > + > +If you configure perl with C<-Accflags=-DNO_PERL_INTERNAL_SEED>, perl > +will ignore the C<PERL_INTERNAL_SEED> enviroment variable. > + > =head1 DOCUMENTATION > > Read the manual entries before running perl. The main documentation > diff --git a/perl.c b/perl.c > index 6ff0e43..16dc2b6 100644 > --- a/perl.c > +++ b/perl.c > @@ -261,7 +261,21 @@ perl_construct(pTHXx) > > init_constants(); > > +#ifdef NO_PERL_INTERNAL_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_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; > @@ -2159,6 +2173,21 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) > } > } > > +#ifndef NO_PERL_INTERNAL_SEED > + /* If we're not set[ug]id, we might have honored > + PERL_INTERNAL_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_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); > diff --git a/pod/perlrun.pod b/pod/perlrun.pod > index 9d59a6a..d92c899 100644 > --- a/pod/perlrun.pod > +++ b/pod/perlrun.pod > @@ -1384,6 +1384,18 @@ X<SYS$LOGIN> > > Used if chdir has no argument and HOME and LOGDIR are not set. > > +=item PERL_INTERNAL_SEED > +X<PERL_INTERNAL_SEED> > + > +Set to a non-negative integer to seed the random number generator used > +internally by perl for a variety of purposes. > + > +Ignored if perl is run setuid or setgid. Used only for some limited > +startup randomization (hash keys) if C<-T> or C<-t> perl is started > +with tainting enabled. > + > +Perl may be built to ignore this variable. > + > =back > > Perl also has environment variables that control how Perl handles data > -- > 2.1.4 > >
-- perl -Mre=debug -e "/just|another|perl|hacker/"
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 568b
On Wed, 07 Dec 2016 01:01:51 -0800, demerphq wrote: Show quoted text
> No, an oversight. We should probably have build options to disable > setting the seed from the env, and also probably one to disable > PERL_HASH_SEED_DEBUG. I think at least one vendor hides some or all > data from that, we might as well make that easy for all.
Patch attached. Show quoted text
> Anyway I like the patch(es) with one slightly bikeshedding comment > that maybe PERL_INTERNAL_SEED should be PERL_INTERNAL_RAND_SEED, or > something? As is, it is a bit ambiguous what the SEED is for.
Modified patch attached. Tony
Subject: 0001-add-build-options-to-disable-the-PERL_HASH-and-PERL_.patch
From 8a3a5768f9c76a0c300645855725ea8553c4b1a3 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Thu, 8 Dec 2016 14:14:11 +1100 Subject: add build options to disable the PERL_HASH* and PERL_PERTURB_KEYS env vars These variables either control or reveal information used in perl's hash implementation that a careful user may not want controlled or exposed. --- INSTALL | 7 +++ perl.c | 4 +- t/run/runenv.t | 145 +++++++++++++++++++++++++++++++-------------------------- util.c | 12 +++-- 4 files changed, 97 insertions(+), 71 deletions(-) diff --git a/INSTALL b/INSTALL index 158b382..a5b1d48 100644 --- a/INSTALL +++ b/INSTALL @@ -423,6 +423,13 @@ See L<perlrun/PERL_HASH_SEED> and L<perlrun/PERL_PERTURB_KEYS> for details on the environment variables, and L<perlsec/Algorithmic Complexity Attacks> for further security details. +The C<PERL_HASH_SEED> and PERL_PERTURB_KEYS> environment variables can +be disabled by building configuring perl with +C<-Accflags=-DNO_PERL_HASH_ENV>. + +The C<PERL_HASH_SEED_DEBUG> environment variable can be disabled by +configuring perl with C<-Accflags=-DNO_PERL_HASH_SEED_DEBUG>. + =head3 SOCKS Perl can be configured to be 'socksified', that is, to use the SOCKS diff --git a/perl.c b/perl.c index 3a647f7..0d12759 100644 --- a/perl.c +++ b/perl.c @@ -1535,7 +1535,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) #ifndef MULTIPLICITY PERL_UNUSED_ARG(my_perl); #endif -#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) || defined(USE_HASH_SEED_DEBUG) +#if (defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) || defined(USE_HASH_SEED_DEBUG)) && !defined(NO_PERL_HASH_SEED_DEBUG) { const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); @@ -1554,7 +1554,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) PerlIO_printf(Perl_debug_log, "\n"); } } -#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */ +#endif /* #if (defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) ... */ #ifdef __amigaos4__ { diff --git a/t/run/runenv.t b/t/run/runenv.t index 6f235d2..611e012 100644 --- a/t/run/runenv.t +++ b/t/run/runenv.t @@ -204,74 +204,87 @@ try({PERL5LIB => "foo", '', ''); -try({PERL_HASH_SEED_DEBUG => 1}, - ['-e','1'], - '', - qr/HASH_FUNCTION =/); - -try({PERL_HASH_SEED_DEBUG => 1}, - ['-e','1'], - '', - qr/HASH_SEED =/); - -# special case, seed "0" implies disabled hash key traversal randomization -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 0/); - -# check that setting it to a different value with the same logical value -# triggers the normal "deterministic mode". -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 2/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 0/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 1/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 2/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"}, - ['-e','1'], - '', - qr/HASH_SEED = 0x12345678/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"}, - ['-e','1'], - '', - qr/HASH_SEED = 0x12000000/); +SKIP: +{ + skip "NO_PERL_HASH_SEED_DEBUG set", 4 + if $Config{ccflags} =~ /-DNO_PERL_HASH_SEED_DEBUG\b/; + + try({PERL_HASH_SEED_DEBUG => 1}, + ['-e','1'], + '', + qr/HASH_FUNCTION =/); + + try({PERL_HASH_SEED_DEBUG => 1}, + ['-e','1'], + '', + qr/HASH_SEED =/); +} -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"}, - ['-e','1'], - '', - qr/HASH_SEED = 0x12345678/); - -# Test that PERL_PERTURB_KEYS works as expected. We check that we get the same -# results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run. -my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_'); -for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively - my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ), - my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]); - if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) { - my $seed = $1; - my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]); - if ( $mode == 1 ) { - isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key"); - } else { - is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash"); +SKIP: +{ + skip "NO_PERL_HASH_ENV or NO_PERL_HASH_SEED_DEBUG set", 16 + if $Config{ccflags} =~ /-DNO_PERL_HASH_ENV\b/ || + $Config{ccflags} =~ /-DNO_PERL_HASH_SEED_DEBUG\b/; + + # special case, seed "0" implies disabled hash key traversal randomization + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 0/); + + # check that setting it to a different value with the same logical value + # triggers the normal "deterministic mode". + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 2/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 0/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 1/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 2/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"}, + ['-e','1'], + '', + qr/HASH_SEED = 0x12345678/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"}, + ['-e','1'], + '', + qr/HASH_SEED = 0x12000000/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"}, + ['-e','1'], + '', + qr/HASH_SEED = 0x12345678/); + + # Test that PERL_PERTURB_KEYS works as expected. We check that we get the same + # results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run. + my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_'); + for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively + my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ), + my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]); + if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) { + my $seed = $1; + my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]); + if ( $mode == 1 ) { + isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key"); + } else { + is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash"); + } + is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS"); } - is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS"); } } diff --git a/util.c b/util.c index 02c84c8..a1306c6 100644 --- a/util.c +++ b/util.c @@ -4712,20 +4712,23 @@ Perl_seed(pTHX) void Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) { +#ifndef NO_PERL_HASH_ENV const char *env_pv; +#endif unsigned long i; PERL_ARGS_ASSERT_GET_HASH_SEED; +#ifndef NO_PERL_HASH_ENV env_pv= PerlEnv_getenv("PERL_HASH_SEED"); if ( env_pv ) -#ifndef USE_HASH_SEED_EXPLICIT +# ifndef USE_HASH_SEED_EXPLICIT { /* ignore leading spaces */ while (isSPACE(*env_pv)) env_pv++; -#ifdef USE_PERL_PERTURB_KEYS +# ifdef USE_PERL_PERTURB_KEYS /* if they set it to "0" we disable key traversal randomization completely */ if (strEQ(env_pv,"0")) { PL_hash_rand_bits_enabled= 0; @@ -4733,7 +4736,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) /* otherwise switch to deterministic mode */ PL_hash_rand_bits_enabled= 2; } -#endif +# endif /* ignore a leading 0x... if it is there */ if (env_pv[0] == '0' && env_pv[1] == 'x') env_pv += 2; @@ -4755,6 +4758,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) /* should we warn about insufficient hex? */ } else +# endif #endif { (void)seedDrand01((Rand_seed_t)seed()); @@ -4774,6 +4778,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,8); } } +# ifndef NO_PERL_HASH_ENV env_pv= PerlEnv_getenv("PERL_PERTURB_KEYS"); if (env_pv) { if (strEQ(env_pv,"0") || strEQ(env_pv,"NO")) { @@ -4786,6 +4791,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) Perl_warn(aTHX_ "perl: warning: strange setting in '$ENV{PERL_PERTURB_KEYS}': '%s'\n", env_pv); } } +# endif #endif } -- 2.1.4
Subject: 0001-perl-127663-provide-limited-control-for-the-internal.patch
From 5bd0a3f37a303e2f4b2d8add4c4beb64a7a363a2 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Thu, 8 Dec 2016 09:38:55 +1100 Subject: (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. --- INSTALL | 6 ++++++ perl.c | 29 +++++++++++++++++++++++++++++ pod/perlrun.pod | 12 ++++++++++++ 3 files changed, 47 insertions(+) diff --git a/INSTALL b/INSTALL index 158b382..7220911 100644 --- a/INSTALL +++ b/INSTALL @@ -2685,6 +2685,12 @@ F<mathoms.c> will not be compiled in. Those functions are no longer used by perl itself; for source compatibility reasons, though, they weren't completely removed. +=head2 C<-DNO_PERL_INTERNAL_RAND_SEED> +X<PERL_INTERNAL_RAND_SEED> + +If you configure perl with C<-Accflags=-DNO_PERL_INTERNAL_RAND_SEED>, +perl will ignore the C<PERL_INTERNAL_RAND_SEED> enviroment variable. + =head1 DOCUMENTATION Read the manual entries before running perl. The main documentation diff --git a/perl.c b/perl.c index 6ff0e43..b5be5e2 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; @@ -2159,6 +2173,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); diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 9d59a6a..7382aad 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -1384,6 +1384,18 @@ X<SYS$LOGIN> Used if chdir has no argument and HOME and LOGDIR are not set. +=item PERL_INTERNAL_RAND_SEED +X<PERL_INTERNAL_RAND_SEED> + +Set to a non-negative integer to seed the random number generator used +internally by perl for a variety of purposes. + +Ignored if perl is run setuid or setgid. Used only for some limited +startup randomization (hash keys) if C<-T> or C<-t> perl is started +with tainting enabled. + +Perl may be built to ignore this variable. + =back Perl also has environment variables that control how Perl handles data -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 455b
On Wed, 07 Dec 2016 19:26:42 -0800, tonyc wrote: Show quoted text
> On Wed, 07 Dec 2016 01:01:51 -0800, demerphq wrote:
> > No, an oversight. We should probably have build options to disable > > setting the seed from the env, and also probably one to disable > > PERL_HASH_SEED_DEBUG. I think at least one vendor hides some or all > > data from that, we might as well make that easy for all.
> > Patch attached.
Applied as 95309d6ba0f3066cdc457f5fb82ab4e6e01a2c98. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 962b
On Tue, 06 Dec 2016 15:25:18 -0800, tonyc wrote: Show quoted text
> Using the *at() functions (along with dirfd()) can fix this, but getcwd() > isn't enough. > > I think it's valuable to implement, but it adds another variation to test, > so I've left it for now.
Here's an updated patch set, this includes a number of enhancements: - support for using renameat() etc on platforms that support them to avoid problems with changing directory in the inplace edit loop. - use symbolic contants for the AV kept in magic - provide some limited control over the internal rand() per the earlier discussion and some fixes: - don't do the close processing in child threads, since this could result in multiple renames of the work file to the output file (one of which would fail) and avoid double-closedir()ing the DIR for the *at() version of the code - don't do the close processing in child processes, to avoid double-renaming as above. - add some cleanup for the tests Tony
Subject: inplace-edit.patch
Download inplace-edit.patch
text/plain 78.4k

Message body is not shown because it is too large.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.2k
On Thu, 12 Jan 2017 15:55:24 -0800, tonyc wrote: Show quoted text
> On Tue, 06 Dec 2016 15:25:18 -0800, tonyc wrote:
> > Using the *at() functions (along with dirfd()) can fix this, but > > getcwd() > > isn't enough. > > > > I think it's valuable to implement, but it adds another variation to > > test, > > so I've left it for now.
> > Here's an updated patch set, this includes a number of enhancements: > > - support for using renameat() etc on platforms that support them to > avoid problems with changing directory in the inplace edit loop. > > - use symbolic contants for the AV kept in magic > > - provide some limited control over the internal rand() per the > earlier discussion > > and some fixes: > > - don't do the close processing in child threads, since this could > result in multiple renames of the work file to the output file (one of > which would fail) and avoid double-closedir()ing the DIR for the *at() > version of the code > > - don't do the close processing in child processes, to avoid double- > renaming as above. > > - add some cleanup for the tests
This, hopefully final, patch set also: - if the *at() functions aren't available, and the names are relative, fail early if the current directory has changed. I plan to apply this in a week or so unless someone objects. Tony
Subject: 127663-rework-inplace-edit
Download 127663-rework-inplace-edit
application/octet-stream 88.9k

Message body not shown because it is not plain text.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.5k
On Sun, 03 Sep 2017 17:50:02 -0700, tonyc wrote: Show quoted text
> On Thu, 12 Jan 2017 15:55:24 -0800, tonyc wrote:
> > On Tue, 06 Dec 2016 15:25:18 -0800, tonyc wrote:
> > > Using the *at() functions (along with dirfd()) can fix this, but > > > getcwd() > > > isn't enough. > > > > > > I think it's valuable to implement, but it adds another variation > > > to > > > test, > > > so I've left it for now.
> > > > Here's an updated patch set, this includes a number of enhancements: > > > > - support for using renameat() etc on platforms that support them to > > avoid problems with changing directory in the inplace edit loop. > > > > - use symbolic contants for the AV kept in magic > > > > - provide some limited control over the internal rand() per the > > earlier discussion > > > > and some fixes: > > > > - don't do the close processing in child threads, since this could > > result in multiple renames of the work file to the output file (one > > of > > which would fail) and avoid double-closedir()ing the DIR for the > > *at() > > version of the code > > > > - don't do the close processing in child processes, to avoid double- > > renaming as above. > > > > - add some cleanup for the tests
> > This, hopefully final, patch set also: > > - if the *at() functions aren't available, and the names are relative, > fail early if the current directory has changed. > > I plan to apply this in a week or so unless someone objects.
Applied as merge commit 9c6681cc159f89641fc077464b7f7b3fcf64e6f1. Leaving this open a bit for any breakages. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 418b
On Sun, 10 Sep 2017 22:43:05 -0700, tonyc wrote: Show quoted text
> Applied as merge commit 9c6681cc159f89641fc077464b7f7b3fcf64e6f1. > > Leaving this open a bit for any breakages.
Reported as broken on FreeBSD: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=222258 possibly due to a FreeBSD bug, but from the description and what I understand of the FreeBSD code this might occur in a container where rename() would work. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 555b
On Tue, 12 Sep 2017 16:56:55 -0700, tonyc wrote: Show quoted text
> On Sun, 10 Sep 2017 22:43:05 -0700, tonyc wrote:
> > Applied as merge commit 9c6681cc159f89641fc077464b7f7b3fcf64e6f1. > > > > Leaving this open a bit for any breakages.
> > Reported as broken on FreeBSD: > > https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=222258 > > possibly due to a FreeBSD bug, but from the description and what I > understand of the FreeBSD code this might occur in a container where > rename() would work.
Added a workaround in 84dbe61c9ddf90f31e473e6a6d04ad91139c88b1. Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org