perl 2.0 patch #16
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sat Nov 19 19:42:02 AEST 1988
System: perl version 2.0
Patch #: 16
Priority: MEDIUM
Subject: now makes use of setre[ug]id() if available
Subject: now creates taintperl for taint checks without setuid emulation
Subject: added "taint" checks for setuid scripts
Subject: added getc function
Subject: added $] to return rcsid and patchlevel
Subject: documented how to write secure setuid perl scripts
Subject: added code to check for kernel setuid script bug
Subject: added redundant prohibitions on certain switches in setuid scripts
Subject: replaced insecure access()
Subject: doesn't blow up finding suidperl on bad PATH now
Subject: $@ now reports correct error line after do EXPR
Subject: added stab_line field
Subject: variables in patterns are no longer hidden from -w typo detection
Subject: return type of vsprintf() now depends on CHARSPRINTF
Subject: several variables weren't declared EXT
Description:
(NOTE: this patch is the first of two that must be applied together.)
Some machines don't have setruid() or seteuid(), but do have
setreuid(). Likewise for setregid(). No reason not to use
them if they're available.
Perl can now check setuid perl scripts for stupid dependencies
that are obviously security holes, such as not setting PATH or
using "tainted" variables in a pipe or system call, etc. Since this
checking is extra overhead, it's done in a different copy of
perl so that most perl scripts aren't penalized.
There's now a getc() function to return one character from an
input filehandle. It's not too efficient, but for certain
applications having to do with terminal input, it's nice.
There's a perl library routine contributed by Wayne Thompson that
does word completion (using getc).
You can now determine which version of perl you are executing
from within a perl script by examininng $], the current rcsid
and patchlevel, just as it's printed out with -v.
There's a section in the manual about writing secure setuid perl
scripts now. Perl now complains if you haven't fixed the kernel
setuid script bug. Certain switches are now redundantly outlawed
in setuid scripts, and I fixed a minor security hole that could let
you (if you worked at it real hard) run a setuid script from a
directory you didn't have search permission to.
(NOTE: if you are the first discoverer of a security hole in perl's
mechanism for emulating setuid/setgid scripts (assuming the kernel
is patched to disallow such scripts), I will pay you $10. I don't
think I'll have to pay anything, but I'd like you to try to break it.
I'm just talking about the emulation mechanism here, not the "tainting"
mechanism--I can't guarantee every setuid script to be secure,
though I think I come closer than C does with the "tainting".)
The problem of normal perl not being able to find suidperl if
PATH wasn't set right has been fixed. It now uses an absolute
path name for suidperl. This wasn't a security hole, but was
irritating when a user with no PATH tried to login through our
password aging scheme, and it couldn't find the interpreter.
$@ incorrectly reported error line numbers from do EXPR evaluations
due to incrementing the line number in two places. This has been
fixed now.
The -w (warning) switch was fooled into thinking there were
typos when it didn't see variable references embedded in search
patterns. This has been remedied. Additionally, when it does
find a potential typo, it's much more likely to give you the
correct line number, rather than one line past EOF.
It appears that systems that declare sprintf() to return int also
declare vsprintf() the same way. Assuming these two functions
are always declared the same, the return type of vsprintf() now
depends on the symbol CHARSPRINTF as determined by Configure.
In util.h, several variables weren't declared EXT.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING ***
Apply patch17 instead, which is a continuation of this patch.
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 2.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.8.43).
Index: patchlevel.h
Prereq: 15
1c1
< #define PATCHLEVEL 15
---
> #define PATCHLEVEL 16
Index: Configure
Prereq: 2.0.1.6
*** Configure.old Sat Nov 19 00:32:15 1988
--- Configure Sat Nov 19 00:32:19 1988
***************
*** 8,14 ****
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
! # $Header: Configure,v 2.0.1.6 88/10/31 16:21:11 lwall Locked $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
--- 8,14 ----
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
! # $Header: Configure,v 2.0.1.7 88/11/18 23:39:26 lwall Locked $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
***************
*** 86,91 ****
--- 86,93 ----
d_rename=''
d_setegid=''
d_seteuid=''
+ d_setregid=''
+ d_setreuid=''
d_setrgid=''
d_setruid=''
d_statblks=''
***************
*** 668,673 ****
--- 670,705 ----
chmod +x filexp
$eunicefix filexp
+ : determine where public executables go
+ case "$bin" in
+ '')
+ dflt=`loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin`
+ ;;
+ *) dflt="$bin"
+ ;;
+ esac
+ cont=true
+ while $test "$cont" ; do
+ echo " "
+ rp="Where do you want to put the public executables? [$dflt]"
+ $echo $n "$rp $c"
+ . myread
+ bin="$ans"
+ bin=`filexp $bin`
+ if test -d $bin; then
+ cont=''
+ else
+ dflt=n
+ rp="Directory $bin doesn't exist. Use that name anyway? [$dflt]"
+ $echo $n "$rp $c"
+ . myread
+ dflt=''
+ case "$ans" in
+ y*) cont='';;
+ esac
+ fi
+ done
+
: determine where manual pages go
case "$mansrc" in
'')
***************
*** 1215,1220 ****
--- 1247,1272 ----
d_seteuid="$undef"
fi
+ : see if setregid exists
+ echo " "
+ if $contains '^setregid$' libc.list >/dev/null 2>&1; then
+ echo 'setregid() found.'
+ d_setregid="$define"
+ else
+ echo 'setregid() not found.'
+ d_setregid="$undef"
+ fi
+
+ : see if setreuid exists
+ echo " "
+ if $contains '^setreuid$' libc.list >/dev/null 2>&1; then
+ echo 'setreuid() found.'
+ d_setreuid="$define"
+ else
+ echo 'setreuid() not found.'
+ d_setreuid="$undef"
+ fi
+
: see if setrgid exists
echo " "
if $contains '^setrgid$' libc.list >/dev/null 2>&1; then
***************
*** 1545,1580 ****
Log='$Log'
Header='$Header'
- : determine where public executables go
- case "$bin" in
- '')
- dflt=`loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin`
- ;;
- *) dflt="$bin"
- ;;
- esac
- cont=true
- while $test "$cont" ; do
- echo " "
- rp="Where do you want to put the public executables? [$dflt]"
- $echo $n "$rp $c"
- . myread
- bin="$ans"
- bin=`filexp $bin`
- if test -d $bin; then
- cont=''
- else
- dflt=n
- rp="Directory $bin doesn't exist. Use that name anyway? [$dflt]"
- $echo $n "$rp $c"
- . myread
- dflt=''
- case "$ans" in
- y*) cont='';;
- esac
- fi
- done
-
: see if we should include -lnm
echo " "
if $test -r /usr/lib/libnm.a || $test -r /usr/local/lib/libnm.a ; then
--- 1597,1602 ----
***************
*** 1682,1687 ****
--- 1704,1711 ----
d_rename='$d_rename'
d_setegid='$d_setegid'
d_seteuid='$d_seteuid'
+ d_setregid='$d_setregid'
+ d_setreuid='$d_setreuid'
d_setrgid='$d_setrgid'
d_setruid='$d_setruid'
d_statblks='$d_statblks'
Index: Makefile.SH
Prereq: 2.0.1.5
*** Makefile.SH.old Sat Nov 19 00:32:28 1988
--- Makefile.SH Sat Nov 19 00:32:29 1988
***************
*** 25,33 ****
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.5 88/09/07 16:29:26 lwall Locked $
#
# $Log: Makefile.SH,v $
# Revision 2.0.1.5 88/09/07 16:29:26 lwall
# patch14: make realclean now deletes perl.man
#
--- 25,36 ----
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.6 88/11/18 23:41:43 lwall Locked $
#
# $Log: Makefile.SH,v $
+ # Revision 2.0.1.6 88/11/18 23:41:43 lwall
+ # patch16: now creates taintperl for taint checks without setuid emulation
+ #
# Revision 2.0.1.5 88/09/07 16:29:26 lwall
# patch14: make realclean now deletes perl.man
#
***************
*** 66,72 ****
libs = $libnm -lm
! public = perl perldb $suidperl
!GROK!THIS!
--- 69,75 ----
libs = $libnm -lm
! public = perl perldb taintperl $suidperl
!GROK!THIS!
***************
*** 85,99 ****
h = $(h1) $(h2)
c1 = arg.c array.c cmd.c dump.c eval.c form.c hash.c $(mallocsrc)
! c2 = perly.c regexp.c stab.c str.c toke.c util.c version.c
c = $(c1) $(c2)
obj1 = arg.o array.o cmd.o dump.o eval.o form.o hash.o $(mallocobj)
! obj2 = regexp.o stab.o str.o toke.o util.o version.o
obj = $(obj1) $(obj2)
lintflags = -phbvxac
addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
--- 88,107 ----
h = $(h1) $(h2)
c1 = arg.c array.c cmd.c dump.c eval.c form.c hash.c $(mallocsrc)
! c2 = perly.c regexp.c stab.c str.c toke.c util.c
c = $(c1) $(c2)
obj1 = arg.o array.o cmd.o dump.o eval.o form.o hash.o $(mallocobj)
! obj2 = perly.o regexp.o stab.o str.o toke.o util.o
obj = $(obj1) $(obj2)
+ tobj1 = targ.o tarray.o tcmd.o tdump.o teval.o tform.o thash.o $(mallocobj)
+ tobj2 = tregexp.o tstab.o tstr.o ttoke.o tutil.o
+
+ tobj = $(tobj1) $(tobj2)
+
lintflags = -phbvxac
addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
***************
*** 107,135 ****
all: $(public) $(private) $(util) perl.man
touch all
! perl: perly.o $(obj) perl.o
! $(CC) $(LDFLAGS) $(LARGE) perly.o $(obj) perl.o $(libs) -o perl
! !NO!SUBS!
! case "$d_dosuid" in
! *define*)
! cat >>Makefile <<'!NO!SUBS!'
! suidperl: sperly.o $(obj) perl.o
! $(CC) $(LDFLAGS) $(LARGE) sperly.o $(obj) perl.o $(libs) -o suidperl
sperly.o: perly.c
/bin/rm -f sperly.c
ln perly.c sperly.c
! $(CC) -c -DIAMSUID $(CFLAGS) $(LARGE) sperly.c
/bin/rm -f sperly.c
- !NO!SUBS!
- ;;
- esac
! cat >>Makefile <<'!NO!SUBS!'
perl.c perly.h: perl.y
@ echo Expect 23 shift/reduce errors...
yacc -d perl.y
--- 115,234 ----
all: $(public) $(private) $(util) perl.man
touch all
! # This is the standard version that contains no "taint" checks and is
! # used for all scripts that aren't set-id or running under something set-id.
! perl: $(obj) perl.o
! $(CC) $(LDFLAGS) $(LARGE) $(obj) perl.o $(libs) -o perl
! # This version, if specified in Configure, does ONLY those scripts which need
! # set-id emulation. Suidperl must be setuid root. It contains the "taint"
! # checks as well as the special code to validate that the script in question
! # has been invoked correctly.
! suidperl: sperly.o $(tobj) tperl.o
! $(CC) $(LDFLAGS) $(LARGE) sperly.o $(tobj) tperl.o $(libs) -o suidperl
+ # This version interprets scripts that are already set-id either via a wrapper
+ # or through the kernel allowing set-id scripts (bad idea). Taintperl must
+ # NOT be setuid to root or anything else. The only difference between it
+ # and normal perl is the presence of the "taint" checks.
+
+ taintperl: tperly.o $(tobj) tperl.o
+ $(CC) $(LDFLAGS) $(LARGE) tperly.o $(tobj) tperl.o $(libs) -o taintperl
+
+ # Replicating all this junk is yucky, but I don't see a portable way to fix it.
+
+ tperl.o: perl.o
+ /bin/rm -f tperl.c
+ ln perl.c tperl.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tperl.c
+ /bin/rm -f tperl.c
+
+ tperly.o: perly.c
+ /bin/rm -f tperly.c
+ ln perly.c tperly.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tperly.c
+ /bin/rm -f tperly.c
+
sperly.o: perly.c
/bin/rm -f sperly.c
ln perly.c sperly.c
! $(CC) -c -DTAINT -DIAMSUID $(CFLAGS) $(LARGE) sperly.c
/bin/rm -f sperly.c
! targ.o: arg.c
! /bin/rm -f targ.c
! ln arg.c targ.c
! $(CC) -c -DTAINT $(CFLAGS) $(LARGE) targ.c
! /bin/rm -f targ.c
+ tarray.o: array.c
+ /bin/rm -f tarray.c
+ ln array.c tarray.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tarray.c
+ /bin/rm -f tarray.c
+
+ tcmd.o: cmd.c
+ /bin/rm -f tcmd.c
+ ln cmd.c tcmd.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tcmd.c
+ /bin/rm -f tcmd.c
+
+ tdump.o: dump.c
+ /bin/rm -f tdump.c
+ ln dump.c tdump.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tdump.c
+ /bin/rm -f tdump.c
+
+ teval.o: eval.c
+ /bin/rm -f teval.c
+ ln eval.c teval.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) teval.c
+ /bin/rm -f teval.c
+
+ tform.o: form.c
+ /bin/rm -f tform.c
+ ln form.c tform.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tform.c
+ /bin/rm -f tform.c
+
+ thash.o: hash.c
+ /bin/rm -f thash.c
+ ln hash.c thash.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) thash.c
+ /bin/rm -f thash.c
+
+ tregexp.o: regexp.c
+ /bin/rm -f tregexp.c
+ ln regexp.c tregexp.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tregexp.c
+ /bin/rm -f tregexp.c
+
+ tstab.o: stab.c
+ /bin/rm -f tstab.c
+ ln stab.c tstab.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tstab.c
+ /bin/rm -f tstab.c
+
+ tstr.o: str.c
+ /bin/rm -f tstr.c
+ ln str.c tstr.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tstr.c
+ /bin/rm -f tstr.c
+
+ ttoke.o: toke.c
+ /bin/rm -f ttoke.c
+ ln toke.c ttoke.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) ttoke.c
+ /bin/rm -f ttoke.c
+
+ tutil.o: util.c
+ /bin/rm -f tutil.c
+ ln util.c tutil.c
+ $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tutil.c
+ /bin/rm -f tutil.c
+
perl.c perly.h: perl.y
@ echo Expect 23 shift/reduce errors...
yacc -d perl.y
***************
*** 149,154 ****
--- 248,254 ----
install: all
# won't work with csh
export PATH || exit 1
+ - rm -f $(bin)/perl.old $(bin)/suidperl $(bin)/taintperl
- mv $(bin)/perl $(bin)/perl.old 2>/dev/null
- if test `pwd` != $(bin); then cp $(public) $(bin); fi
- cd $(bin); \
***************
*** 155,160 ****
--- 255,261 ----
for pub in $(public); do \
chmod +x `basename $$pub`; \
done
+ - chmod 755 $(bin)/taintperl 2>/dev/null
!NO!SUBS!
case "$d_dosuid" in
Index: arg.c
Prereq: 2.0.1.5
*** arg.c.old Sat Nov 19 00:32:39 1988
--- arg.c Sat Nov 19 00:32:43 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 2.0.1.5 88/10/31 16:24:18 lwall Exp $
*
* $Log: arg.c,v $
* Revision 2.0.1.5 88/10/31 16:24:18 lwall
* patch15: some support for defective 286 compilers
* patch15: printf "%%" now works more consistently
--- 1,10 ----
! /* $Header: arg.c,v 2.0.1.6 88/11/18 23:44:15 lwall Locked $
*
* $Log: arg.c,v $
+ * Revision 2.0.1.6 88/11/18 23:44:15 lwall
+ * patch16: "taint" checks for setuid scripts
+ * patch16: added getc function
+ *
* Revision 2.0.1.5 88/10/31 16:24:18 lwall
* patch15: some support for defective 286 compilers
* patch15: printf "%%" now works more consistently
***************
*** 592,597 ****
--- 596,605 ----
stio->type = *name;
if (*name == '|') {
for (name++; isspace(*name); name++) ;
+ #ifdef TAINT
+ taintenv();
+ taintproper("Insecure dependency in piped open");
+ #endif
if (strNE(name,"-"))
fp = popen(name,"w");
else {
***************
*** 601,611 ****
--- 609,625 ----
}
}
else if (*name == '>' && name[1] == '>') {
+ #ifdef TAINT
+ taintproper("Insecure dependency in open");
+ #endif
mode[0] = stio->type = 'a';
for (name += 2; isspace(*name); name++) ;
fp = fopen(name, mode);
}
else if (*name == '>' && name[1] == '&') {
+ #ifdef TAINT
+ taintproper("Insecure dependency in open");
+ #endif
for (name += 2; isspace(*name); name++) ;
if (isdigit(*name))
fd = atoi(name);
***************
*** 622,627 ****
--- 636,644 ----
(stio->type == '<' ? "r" : "w") );
}
else if (*name == '>') {
+ #ifdef TAINT
+ taintproper("Insecure dependency in open");
+ #endif
for (name++; isspace(*name); name++) ;
if (strEQ(name,"-")) {
fp = stdout;
***************
*** 645,650 ****
--- 662,671 ----
}
}
else if (name[len-1] == '|') {
+ #ifdef TAINT
+ taintenv();
+ taintproper("Insecure dependency in piped open");
+ #endif
name[--len] = '\0';
while (len && isspace(name[len-1]))
name[--len] = '\0';
***************
*** 704,709 ****
--- 725,733 ----
oldname = str_get(stab->stab_val);
if (do_open(stab,oldname)) {
if (inplace) {
+ #ifdef TAINT
+ taintproper("Insecure dependency in inplace open");
+ #endif
filemode = statbuf.st_mode;
fileuid = statbuf.st_uid;
filegid = statbuf.st_gid;
***************
*** 1282,1287 ****
--- 1306,1314 ----
register int items;
char **argv;
+ #ifdef TAINT
+ taintenv(); /* testing IFS here is overkill, probably */
+ #endif
(void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
items = (int)str_gnum(*tmpary);
if (items) {
***************
*** 1310,1315 ****
--- 1337,1347 ----
char **argv;
char *cmd = str_get(str);
+ #ifdef TAINT
+ taintenv();
+ taintproper("Insecure dependency in exec");
+ #endif
+
/* see if there are shell metacharacters in it */
for (s = cmd; *s; s++) {
***************
*** 1402,1409 ****
--- 1434,1448 ----
(void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
items = (int)str_gnum(*tmpary);
}
+ #ifdef TAINT
+ for (elem = tmpary+1; *elem; elem++)
+ tainted |= (*elem)->str_tainted;
+ #endif
switch (type) {
case O_CHMOD:
+ #ifdef TAINT
+ taintproper("Insecure dependency in chmod");
+ #endif
if (--items > 0) {
val = (int)str_gnum(tmpary[1]);
for (elem = tmpary+2; *elem; elem++)
***************
*** 1412,1417 ****
--- 1451,1459 ----
}
break;
case O_CHOWN:
+ #ifdef TAINT
+ taintproper("Insecure dependency in chown");
+ #endif
if (items > 2) {
items -= 2;
val = (int)str_gnum(tmpary[1]);
***************
*** 1424,1429 ****
--- 1466,1474 ----
items = 0;
break;
case O_KILL:
+ #ifdef TAINT
+ taintproper("Insecure dependency in kill");
+ #endif
if (--items > 0) {
val = (int)str_gnum(tmpary[1]);
if (val < 0) {
***************
*** 1444,1449 ****
--- 1489,1497 ----
}
break;
case O_UNLINK:
+ #ifdef TAINT
+ taintproper("Insecure dependency in unlink");
+ #endif
for (elem = tmpary+1; *elem; elem++) {
s = str_get(*elem);
if (euid || unsafe) {
***************
*** 1466,1471 ****
--- 1514,1522 ----
}
break;
case O_UTIME:
+ #ifdef TAINT
+ taintproper("Insecure dependency in utime");
+ #endif
if (items > 2) {
struct {
long atime,
***************
*** 1955,1961 ****
opargs[O_VALUES] = A(0,0,0);
opargs[O_EACH] = A(0,0,0);
opargs[O_CHOP] = A(1,0,0);
! opargs[O_FORK] = A(1,0,0);
opargs[O_EXEC] = A(1,0,0);
opargs[O_SYSTEM] = A(1,0,0);
opargs[O_OCT] = A(1,0,0);
--- 2006,2012 ----
opargs[O_VALUES] = A(0,0,0);
opargs[O_EACH] = A(0,0,0);
opargs[O_CHOP] = A(1,0,0);
! opargs[O_FORK] = A(0,0,0);
opargs[O_EXEC] = A(1,0,0);
opargs[O_SYSTEM] = A(1,0,0);
opargs[O_OCT] = A(1,0,0);
***************
*** 2008,2011 ****
--- 2059,2063 ----
opargs[O_SRAND] = A(1,0,0);
opargs[O_POW] = A(1,1,0);
opargs[O_RETURN] = A(1,0,0);
+ opargs[O_GETC] = A(1,0,0);
}
Index: arg.h
Prereq: 2.0.1.1
*** arg.h.old Sat Nov 19 00:32:51 1988
--- arg.h Sat Nov 19 00:32:52 1988
***************
*** 1,6 ****
! /* $Header: arg.h,v 2.0.1.1 88/07/11 22:25:55 root Exp $
*
* $Log: arg.h,v $
* Revision 2.0.1.1 88/07/11 22:25:55 root
* patch2: added ATAN2, SIN, COS, RAND, SRAND, POW and RETURN
*
--- 1,9 ----
! /* $Header: arg.h,v 2.0.1.2 88/11/18 23:45:37 lwall Locked $
*
* $Log: arg.h,v $
+ * Revision 2.0.1.2 88/11/18 23:45:37 lwall
+ * patch16: added getc function
+ *
* Revision 2.0.1.1 88/07/11 22:25:55 root
* patch2: added ATAN2, SIN, COS, RAND, SRAND, POW and RETURN
*
***************
*** 153,159 ****
#define O_SRAND 141
#define O_POW 142
#define O_RETURN 143
! #define MAXO 144
#ifndef DOINIT
extern char *opname[];
--- 156,163 ----
#define O_SRAND 141
#define O_POW 142
#define O_RETURN 143
! #define O_GETC 144
! #define MAXO 145
#ifndef DOINIT
extern char *opname[];
***************
*** 303,309 ****
"SRAND",
"POW",
"RETURN",
! "144"
};
#endif
--- 307,314 ----
"SRAND",
"POW",
"RETURN",
! "GETC",
! "145"
};
#endif
Index: cmd.c
Prereq: 2.0.1.3
*** cmd.c.old Sat Nov 19 00:32:58 1988
--- cmd.c Sat Nov 19 00:32:59 1988
***************
*** 1,6 ****
! /* $Header: cmd.c,v 2.0.1.3 88/10/31 16:26:07 lwall Exp $
*
* $Log: cmd.c,v $
* Revision 2.0.1.3 88/10/31 16:26:07 lwall
* patch15: varargs supported
* patch15: some support for defective 286 compilers
--- 1,9 ----
! /* $Header: cmd.c,v 2.0.1.4 88/11/18 23:52:06 lwall Locked $
*
* $Log: cmd.c,v $
+ * Revision 2.0.1.4 88/11/18 23:52:06 lwall
+ * patch16: "taint" checks for setuid scripts
+ *
* Revision 2.0.1.3 88/10/31 16:26:07 lwall
* patch15: varargs supported
* patch15: some support for defective 286 compilers
***************
*** 61,66 ****
--- 64,72 ----
tail_recursion_entry:
#ifdef DEBUGGING
dlevel = entdlevel;
+ #endif
+ #ifdef TAINT
+ tainted = 0; /* Each statement is presumed innocent */
#endif
if (cmd == Nullcmd)
return retstr;
Index: lib/complete.pl
*** lib/complete.pl.old Sat Nov 19 00:33:27 1988
--- lib/complete.pl Sat Nov 19 00:33:28 1988
***************
*** 0 ****
--- 1,82 ----
+ ;#
+ ;# @(#)complete.pl 1.0 (sun!waynet) 11/11/88
+ ;#
+ ;# Author: Wayne Thompson
+ ;#
+ ;# Description:
+ ;# This routine provides word completion.
+ ;# (TAB) attempts word completion.
+ ;# (^D) prints completion list.
+ ;#
+ ;# Diagnostics:
+ ;# Bell when word completion fails.
+ ;#
+ ;# Dependencies:
+ ;# The tty driver is put into raw mode.
+ ;#
+ ;# Bugs:
+ ;# The erase and kill characters are hard coded.
+ ;#
+ ;# Usage:
+ ;# $input = do Complete('prompt_string', @completion_list);
+ ;#
+
+ sub Complete {
+ local ($prompt) = shift (@_);
+ local ($c, $cmp, $l, $r, $ret, $return, $test);
+ @_ = sort @_;
+ system 'stty raw -echo';
+ loop: {
+ print $prompt, $return;
+ while (($c = getc(stdin)) ne "\r") {
+ if ($c eq "\t") { # (TAB) attempt completion
+ @_match = ();
+ foreach $cmp (@_) {
+ push (@_match, $cmp) if $cmp =~ /^$return/;
+ }
+ $test = $_match[0];
+ $l = length ($test);
+ unless ($#_match == 0) {
+ shift (@_match);
+ foreach $cmp (@_match) {
+ until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
+ $l--;
+ }
+ }
+ print "\007";
+ }
+ print $test = substr ($test, $r, $l - $r);
+ $r = length ($return .= $test);
+ }
+ elsif ($c eq "\004") { # (^D) completion list
+ print "\r\n";
+ foreach $cmp (@_) {
+ print "$cmp\r\n" if $cmp =~ /^$return/;
+ }
+ redo loop;
+ }
+ elsif ($c eq "\025" && $r) { # (^U) kill
+ $return = '';
+ $r = 0;
+ print "\r\n";
+ redo loop;
+ }
+ # (DEL) || (BS) erase
+ elsif ($c eq "\177" || $c eq "\010") {
+ if($r) {
+ print "\b \b";
+ chop ($return);
+ $r--;
+ }
+ }
+ elsif ($c =~ /\S/) { # printable char
+ $return .= $c;
+ $r++;
+ print $c;
+ }
+ }
+ }
+ system 'stty -raw echo';
+ print "\n";
+ $return;
+ }
Index: config.h.SH
*** config.h.SH.old Sat Nov 19 00:33:04 1988
--- config.h.SH Sat Nov 19 00:33:05 1988
***************
*** 37,42 ****
--- 37,49 ----
#$d_eunice EUNICE /**/
#$d_eunice VMS /**/
+ /* BIN:
+ * This symbol holds the name of the directory in which the user wants
+ * to put publicly executable images for the package in question. It
+ * is most often a local directory such as /usr/local/bin.
+ */
+ #define BIN "$bin" /**/
+
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
* the C preprocessor on the standard input and produce to standard
***************
*** 148,153 ****
--- 155,172 ----
* to change the effective uid of the current program.
*/
#$d_seteuid SETEUID /**/
+
+ /* SETREGID:
+ * This symbol, if defined, indicates that the setregid routine is available
+ * to change the real and effective gid of the current program.
+ */
+ #$d_setregid SETREGID /**/
+
+ /* SETREUID:
+ * This symbol, if defined, indicates that the setreuid routine is available
+ * to change the real and effective uid of the current program.
+ */
+ #$d_setreuid SETREUID /**/
/* SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
Index: eval.c
Prereq: 2.0.1.7
*** eval.c.old Sat Nov 19 00:33:16 1988
--- eval.c Sat Nov 19 00:33:20 1988
***************
*** 1,6 ****
! /* $Header: eval.c,v 2.0.1.7 88/10/31 16:27:56 lwall Exp $
*
* $Log: eval.c,v $
* Revision 2.0.1.7 88/10/31 16:27:56 lwall
* patch15: some support for defective 286 compilers
*
--- 1,10 ----
! /* $Header: eval.c,v 2.0.1.8 88/11/18 23:54:42 lwall Locked $
*
* $Log: eval.c,v $
+ * Revision 2.0.1.8 88/11/18 23:54:42 lwall
+ * patch16: "taint" checks for setuid scripts
+ * patch16: added getc function
+ *
* Revision 2.0.1.7 88/10/31 16:27:56 lwall
* patch15: some support for defective 286 compilers
*
***************
*** 260,266 ****
break;
case A_BACKTICK:
tmps = str_get(argptr.arg_str);
! fp = popen(str_get(interp(str,tmps)),"r");
tmpstr = str_new(80);
str_set(str,"");
if (fp) {
--- 264,274 ----
break;
case A_BACKTICK:
tmps = str_get(argptr.arg_str);
! tmps = str_get(interp(str,tmps));
! #ifdef TAINT
! taintproper("Insecure dependency in ``");
! #endif
! fp = popen(tmps,"r");
tmpstr = str_new(80);
str_set(str,"");
if (fp) {
***************
*** 350,355 ****
--- 358,366 ----
else {
last_in_stab->stab_io->lines++;
sarg[anum] = str;
+ #ifdef TAINT
+ str->str_tainted = 1; /* Anything from the outside world...*/
+ #endif
if (argflags & AF_POST) {
if (str->str_cur > 0)
str->str_cur--;
***************
*** 913,922 ****
goto donumset;
case O_CHDIR:
tmps = str_get(sarg[1]);
! if (!tmps || !*tmps)
! tmps = getenv("HOME");
! if (!tmps || !*tmps)
! tmps = getenv("LOGDIR");
value = (double)(chdir(tmps) >= 0);
goto donumset;
case O_DIE:
--- 924,942 ----
goto donumset;
case O_CHDIR:
tmps = str_get(sarg[1]);
! if (!tmps || !*tmps) {
! tmpstr = hfetch(envstab->stab_hash,"HOME");
! if (tmpstr)
! tmps = str_get(tmpstr);
! }
! if (!tmps || !*tmps) {
! tmpstr = hfetch(envstab->stab_hash,"LOGDIR");
! if (tmpstr)
! tmps = str_get(tmpstr);
! }
! #ifdef TAINT
! taintproper("Insecure dependency in chdir");
! #endif
value = (double)(chdir(tmps) >= 0);
goto donumset;
case O_DIE:
***************
*** 956,961 ****
--- 976,999 ----
str_set(str, do_eof(stab) ? Yes : No);
STABSET(str);
break;
+ case O_GETC:
+ if (maxarg <= 0)
+ stab = last_in_stab;
+ else if (arg[1].arg_type == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(sarg[1]),TRUE);
+ if (do_eof(stab)) /* make sure we have fp with something */
+ str_set(str, No);
+ else {
+ #ifdef TAINT
+ tainted = 1;
+ #endif
+ str_set(str," ");
+ *str->str_ptr = getc(stab->stab_io->fp); /* should never be EOF */
+ }
+ STABSET(str);
+ break;
case O_TELL:
if (maxarg <= 0)
stab = last_in_stab;
***************
*** 1170,1175 ****
--- 1208,1220 ----
statusvalue = (unsigned short)argflags;
goto donumset;
case O_SYSTEM:
+ #ifdef TAINT
+ if (!(arg[1].arg_flags & AF_SPECIAL)) {
+ taintenv();
+ tainted |= sarg[1]->str_tainted;
+ taintproper("Insecure dependency in system");
+ }
+ #endif
while ((anum = vfork()) == -1) {
if (errno != EAGAIN) {
value = -1.0;
***************
*** 1258,1270 ****
goto donumset;
case O_UMASK:
value = (double)umask((int)str_gnum(sarg[1]));
goto donumset;
case O_RENAME:
tmps = str_get(sarg[1]);
#ifdef RENAME
! value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
#else
- tmps2 = str_get(sarg[2]);
if (euid || stat(tmps2,&statbuf) < 0 ||
(statbuf.st_mode & S_IFMT) != S_IFDIR )
UNLINK(tmps2); /* avoid unlinking a directory */
--- 1303,1321 ----
goto donumset;
case O_UMASK:
value = (double)umask((int)str_gnum(sarg[1]));
+ #ifdef TAINT
+ taintproper("Insecure dependency in umask");
+ #endif
goto donumset;
case O_RENAME:
tmps = str_get(sarg[1]);
+ tmps2 = str_get(sarg[2]);
+ #ifdef TAINT
+ taintproper("Insecure dependency in rename");
+ #endif
#ifdef RENAME
! value = (double)(rename(tmps,tmps2) >= 0);
#else
if (euid || stat(tmps2,&statbuf) < 0 ||
(statbuf.st_mode & S_IFMT) != S_IFDIR )
UNLINK(tmps2); /* avoid unlinking a directory */
***************
*** 1275,1281 ****
goto donumset;
case O_LINK:
tmps = str_get(sarg[1]);
! value = (double)(link(tmps,str_get(sarg[2])) >= 0);
goto donumset;
case O_UNSHIFT:
ary = arg[2].arg_ptr.arg_stab->stab_array;
--- 1326,1336 ----
goto donumset;
case O_LINK:
tmps = str_get(sarg[1]);
! tmps2 = str_get(sarg[2]);
! #ifdef TAINT
! taintproper("Insecure dependency in link");
! #endif
! value = (double)(link(tmps,tmps2) >= 0);
goto donumset;
case O_UNSHIFT:
ary = arg[2].arg_ptr.arg_stab->stab_array;
***************
*** 1291,1299 ****
break;
case O_DOFILE:
case O_EVAL:
! str_sset(str,
! do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val,
! optype) );
STABSET(str);
break;
--- 1346,1357 ----
break;
case O_DOFILE:
case O_EVAL:
! tmpstr = arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val;
! #ifdef TAINT
! tainted |= tmpstr->str_tainted;
! taintproper("Insecure dependency in eval");
! #endif
! str_sset(str, do_eval(tmpstr, optype));
STABSET(str);
break;
***************
*** 1401,1407 ****
case O_SYMLINK:
#ifdef SYMLINK
tmps = str_get(sarg[1]);
! value = (double)(symlink(tmps,str_get(sarg[2])) >= 0);
goto donumset;
#else
fatal("Unsupported function symlink()");
--- 1459,1469 ----
case O_SYMLINK:
#ifdef SYMLINK
tmps = str_get(sarg[1]);
! tmps2 = str_get(sarg[2]);
! #ifdef TAINT
! taintproper("Insecure dependency in symlink");
! #endif
! value = (double)(symlink(tmps,tmps2) >= 0);
goto donumset;
#else
fatal("Unsupported function symlink()");
Index: perl.h
Prereq: 2.0.1.4
*** perl.h.old Sat Nov 19 00:33:32 1988
--- perl.h Sat Nov 19 00:33:33 1988
***************
*** 1,6 ****
! /* $Header: perl.h,v 2.0.1.4 88/10/31 16:30:40 lwall Exp $
*
* $Log: perl.h,v $
* Revision 2.0.1.4 88/10/31 16:30:40 lwall
* patch15: some support for defective 286 compilers
*
--- 1,9 ----
! /* $Header: perl.h,v 2.0.1.5 88/11/18 23:58:38 lwall Locked $
*
* $Log: perl.h,v $
+ * Revision 2.0.1.5 88/11/18 23:58:38 lwall
+ * patch16: "taint" checks for setuid scripts
+ *
* Revision 2.0.1.4 88/10/31 16:30:40 lwall
* patch15: some support for defective 286 compilers
*
***************
*** 27,32 ****
--- 30,41 ----
#define VOIDUSED 1
#include "config.h"
+ #ifdef IAMSUID
+ # ifndef TAINT
+ # define TAINT
+ # endif
+ #endif
+
#ifdef MEMCPY
extern char *memcpy(), *memset();
#define bcopy(s1,s2,l) memcpy(s2,s1,l);
***************
*** 102,111 ****
#ifdef CRIPPLED_CC
char *str_get();
#else
#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
! #endif
#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
EXT STR *Str;
#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
--- 111,130 ----
#ifdef CRIPPLED_CC
char *str_get();
#else
+ #ifdef TAINT
+ #define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
+ (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+ #else
#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
! #endif /* TAINT */
! #endif /* CRIPPLED_CC */
+ #ifdef TAINT
+ #define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
+ (Str->str_nok ? Str->str_nval : str_2num(Str)))
+ #else
#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
+ #endif
EXT STR *Str;
#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
***************
*** 243,248 ****
--- 262,271 ----
EXT bool sawampersand INIT(FALSE); /* must save all match strings */
EXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */
EXT bool sawi INIT(FALSE); /* study must assume case insensitive */
+
+ #ifdef TAINT
+ EXT bool tainted INIT(FALSE); /* using variables controlled by $< */
+ #endif
#define TMPPATH "/tmp/perl-eXXXXXX"
EXT char *e_tmpname;
Index: perl.man.1
Prereq: 2.0.1.6
*** perl.man.1.old Sat Nov 19 00:33:43 1988
--- perl.man.1 Sat Nov 19 00:33:48 1988
***************
*** 1,7 ****
.rn '' }`
! ''' $Header: perl.man.1,v 2.0.1.6 88/10/31 16:33:00 lwall Locked $
'''
''' $Log: perl.man.1,v $
''' Revision 2.0.1.6 88/10/31 16:33:00 lwall
''' patch15: clarified location of array iterators.
''' patch15: documented interpolation of variables into patterns.
--- 1,10 ----
.rn '' }`
! ''' $Header: perl.man.1,v 2.0.1.7 88/11/18 23:59:52 lwall Locked $
'''
''' $Log: perl.man.1,v $
+ ''' Revision 2.0.1.7 88/11/18 23:59:52 lwall
+ ''' patch16: added getc function
+ '''
''' Revision 2.0.1.6 88/10/31 16:33:00 lwall
''' patch15: clarified location of array iterators.
''' patch15: documented interpolation of variables into patterns.
***************
*** 1501,1506 ****
--- 1504,1512 ----
Returns the child pid to the parent process and 0 to the child process.
Note: unflushed buffers remain unflushed in both processes, which means
you may need to set $| to avoid duplicate output.
+ .Ip "getc(FILEHANDLE)" 8 4
+ Returns the next character from the input file attached to FILEHANDLE, or
+ a null string at EOF.
.Ip "gmtime(EXPR)" 8 4
Converts a time as returned by the time function to a 9-element array with
the time analyzed for the Greenwich timezone.
Index: perl.man.2
Prereq: 2.0.1.7
*** perl.man.2.old Sat Nov 19 00:34:03 1988
--- perl.man.2 Sat Nov 19 00:34:09 1988
***************
*** 1,7 ****
''' Beginning of part 2
! ''' $Header: perl.man.2,v 2.0.1.7 88/10/31 16:41:21 lwall Locked $
'''
''' $Log: perl.man.2,v $
''' Revision 2.0.1.7 88/10/31 16:41:21 lwall
''' patch15: Documented that $a and $b are passed by reference in sort specs
''' patch15: Documented that only one study is active at at time
--- 1,11 ----
''' Beginning of part 2
! ''' $Header: perl.man.2,v 2.0.1.8 88/11/19 00:03:12 lwall Locked $
'''
''' $Log: perl.man.2,v $
+ ''' Revision 2.0.1.8 88/11/19 00:03:12 lwall
+ ''' patch16: added $] to return rcsid and patchlevel
+ ''' patch16: documented how to write secure setuid perl scripts
+ '''
''' Revision 2.0.1.7 88/10/31 16:41:21 lwall
''' patch15: Documented that $a and $b are passed by reference in sort specs
''' patch15: Documented that only one study is active at at time
***************
*** 1351,1356 ****
--- 1355,1376 ----
(or Fortran)
when subscripting and when evaluating the index() and substr() functions.
(Mnemonic: [ begins subscripts.)
+ .Ip $] 8 2
+ The string printed out when you say \*(L"perl -v\*(R".
+ It can be used to determine at the beginning of a script whether the perl
+ interpreter executing the script is in the right range of versions.
+ Example:
+ .nf
+
+ .ne 5
+ # see if getc is available
+ ($version,$patchlevel) =
+ $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/;
+ print stderr "(No filename completion available.)\n"
+ if $version * 1000 + $patchlevel < 2016;
+
+ .fi
+ (Mnemonic: Is this version of perl in the right bracket?)
.Ip $; 8 2
The subscript separator for multi-dimensional array emulation.
If you refer to an associative array element as
***************
*** 1449,1457 ****
$SIG{\'QUIT\'} = \'IGNORE\'; # ignore SIGQUIT
.fi
.SH ENVIRONMENT
.I Perl
! currently uses no environment variables, except to make them available
to the script being executed, and to child processes.
However, scripts running setuid would do well to execute the following lines
before doing anything else, just to keep people honest:
--- 1469,1593 ----
$SIG{\'QUIT\'} = \'IGNORE\'; # ignore SIGQUIT
.fi
+ .Sh "Setuid Scripts"
+ .I Perl
+ is designed to make it easy to write secure setuid and setgid scripts.
+ Unlike shells, which are based on multiple substitution passes on each line
+ of the script,
+ .I perl
+ uses a more conventional evaluation scheme with fewer hidden \*(L"gotchas\*(R".
+ Additionally, since the language has more built-in functionality, it
+ has to rely less upon external (and possibly untrustworth) programs to
+ accomplish its purposes.
+ .PP
+ In an unpatched 4.2 or 4.3bsd kernel, setuid scripts are intrinsically
+ insecure, but this kernel feature can be disabled.
+ If it is,
+ .I perl
+ can emulate the setuid and setgid mechanism when it notices the otherwise
+ useless setuid/gid bits on perl scripts.
+ If the kernel feature isn't disabled,
+ .I perl
+ will complain loudly that your setuid script is insecure.
+ You'll need to either disable the kernel setuid script feature, or put
+ a C wrapper around the script.
+ .PP
+ When perl is executing a setuid script, it takes special precautions to
+ prevent you from falling into any obvious traps.
+ (In some ways, a perl script is more secure than the corresponding
+ C program.)
+ Any command line argument, environment variable, or input is marked as
+ \*(L"tainted\*(R", and may not be used, directly or indirectly, in any
+ command that invokes a subshell, or in any command that modifies files,
+ directories or processes.
+ Any variable that is set within an expression that has previously referenced
+ a tainted value also becomes tainted (even if it is logically impossible
+ for the tainted value to influence the variable).
+ For example:
+ .nf
+
+ .ne 5
+ $foo = shift; # $foo is tainted
+ $bar = $foo,\'bar\'; # $bar is also tainted
+ $xxx = <>; # Tainted
+ $path = $ENV{\'PATH\'}; # Tainted, but see below
+ $abc = \'abc\'; # Not tainted
+
+ .ne 4
+ system "echo $foo"; # Insecure
+ system "echo", $foo; # Secure (doesn't use sh)
+ system "echo $bar"; # Insecure
+ system "echo $abc"; # Insecure until PATH set
+
+ .ne 5
+ $ENV{\'PATH\'} = \'/bin:/usr/bin\';
+ $ENV{\'IFS\'} = \'\' if $ENV{\'IFS\'} ne \'\';
+
+ $path = $ENV{\'PATH\'}; # Not tainted
+ system "echo $abc"; # Is secure now!
+
+ .ne 5
+ open(FOO,"$foo"); # OK
+ open(FOO,">$foo"); # Not OK
+
+ open(FOO,"echo $foo|"); # Not OK, but...
+ open(FOO,"-|") || exec \'echo\', $foo; # OK
+
+ $zzz = `echo $foo`; # Insecure, zzz tainted
+
+ unlink $abc,$foo; # Insecure
+ umask $foo; # Insecure
+
+ .ne 3
+ exec "echo $foo"; # Insecure
+ exec "echo", $foo; # Secure (doesn't use sh)
+ exec "sh", \'-c\', $foo; # Considered secure, alas
+
+ .fi
+ The taintedness is associated with each scalar value, so some elements
+ of an array can be tainted, and others not.
+ .PP
+ If you try to do something insecure, you will get a fatal error saying
+ something like \*(L"Insecure dependency\*(R" or \*(L"Insecure PATH\*(R".
+ Note that you can still write an insecure system call or exec,
+ but only by explicity doing something like the last example above.
+ You can also bypass the tainting mechanism by referencing
+ subpatterns\*(--\c
+ .I perl
+ presumes that if you reference a substring using $1, $2, etc, you knew
+ what you were doing when you wrote the pattern:
+ .nf
+
+ $ARGV[0] =~ /^\-P(\ew+)$/;
+ $printer = $1; # Not tainted
+
+ .fi
+ This is fairly secure since \ew+ doesn't match shell metacharacters.
+ Use of .+ would have been insecure, but
+ .I perl
+ doesn't check for that, so you must be careful with your patterns.
+ This is the ONLY mechanism for untainting user supplied filenames if you
+ want to do file operations on them (unless you make $> equal to $<).
+ .PP
+ It's also possible to get into trouble with other operations that don't care
+ whether they use tainted values.
+ Make judicious use of the file tests in dealing with any user-supplied
+ filenames.
+ When possible, do opens and such after setting $> = $<.
+ .I Perl
+ doesn't prevent you from opening tainted filenames for reading, so be
+ careful what you print out.
+ The tainting mechanism is intended to prevent stupid mistakes, not to remove
+ the need for thought.
.SH ENVIRONMENT
.I Perl
! uses PATH in executing subprocesses, and in finding the script if \-S
! is used.
! HOME or LOGDIR are used if chdir has no argument.
! .PP
! Apart from these,
! .I perl
! uses no environment variables, except to make them available
to the script being executed, and to child processes.
However, scripts running setuid would do well to execute the following lines
before doing anything else, just to keep people honest:
***************
*** 1459,1466 ****
.ne 3
$ENV{\'PATH\'} = \'/bin:/usr/bin\'; # or whatever you need
! $ENV{\'SHELL\'} = \'/bin/sh\' if $ENV{\'SHELL\'};
! $ENV{\'IFS\'} = \'\' if $ENV{\'IFS\'};
.fi
.SH AUTHOR
--- 1595,1602 ----
.ne 3
$ENV{\'PATH\'} = \'/bin:/usr/bin\'; # or whatever you need
! $ENV{\'SHELL\'} = \'/bin/sh\' if $ENV{\'SHELL\'} ne \'\';
! $ENV{\'IFS\'} = \'\' if $ENV{\'IFS\'} ne \'\';
.fi
.SH AUTHOR
***************
*** 1485,1490 ****
--- 1621,1630 ----
switches, each
.B \-e
is counted as one line.)
+ .PP
+ Setuid scripts have additional constraints that can produce error messages
+ such as \*(L"Insecure dependency\*(R".
+ See the section on setuid scripts.
.SH TRAPS
Accustomed
.IR awk
More information about the Comp.sources.bugs
mailing list