lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/19/88)
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@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