home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume15 / perl2 / patch1 / text0000.txt < prev   
Encoding:
Text File  |  1989-01-05  |  47.5 KB  |  1,575 lines
  1. [The latest patch for perl version 2.0 is #1.]
  2.  
  3. System: perl version 2.0
  4. Patch #: 1
  5. Priority: MEDIUM
  6. Subject: autoincrement of '' didn't work right.
  7. Subject: tr/x/y/ can dump core if y is shorter than x
  8. Subject: added support for DOSUID
  9. Subject: in Configure, fix for machines that can't do #/*undef
  10. Subject: in Configure, return code from ar was ignored
  11. Subject: in Configure, Cray uses bld instead of ar
  12. Subject: in Configure, Gnucpp adds space after symbol interpolation
  13. Subject: in Configure, grep '-i' should be grep '\-i'
  14. Subject: Configure should remove UU subdirectory entirely
  15. Subject: realclean now knows about ~ extension
  16. Subject: fixed some quotes in manual page
  17. Subject: clarified syntax of LIST in manual page
  18. Subject: clarified semantics of study in manual page
  19. Subject: added example of y with short second string in manual page
  20. Subject: added example of unlink with <*> in manual page
  21. Subject: removed redundant debugging code in regexp.c
  22.  
  23. Description:
  24.     If you used ++ on a variable that had the value '' (as opposed to
  25.     being undefined) it would increment the numeric part but not
  26.     invalidate the string part, which could then give false results.
  27.  
  28.     Berkeley recently sent out a patch that disables setuid #! scripts
  29.     because of an inherent problem in the semantics as they are
  30.     currently defined.  If you have installed that patch, your setuid
  31.     and setgid bits are useless on scripts.  I've added a means
  32.     for perl to examine those bits and emulate setuid/setgid scripts
  33.     itself in what I believe is a secure manner.  If normal perl
  34.     detects such a script, it passes it off to another version of
  35.     perl that runs setuid root, and can run the script under the
  36.     desired uid/gid.  This feature is optional, and Configure will
  37.     ask if you want to do it.
  38.  
  39.     Some machines didn't like config.h when it said #/*undef SYMBOL.
  40.     Config.h.SH now is smart enough to tuck the # inside the comment.
  41.  
  42.     There were several small problems in Configure: the return code from
  43.     ar was hidden by a piped call to sed, so if ar failed it went
  44.     undetected.  The Cray uses a program called bld instead of ar.
  45.     Let's hear it for compatibilty.  At least one version of gnucpp
  46.     adds a space after symbol interpolation, which was giving the
  47.     C preprocessor detector fits.  There was a call to grep '-i' that
  48.     needed to have the -i protected by a backslash.  Also, Configure
  49.     should remove the UU subdirectory that it makes while running.
  50.  
  51.     "make realclean" now knows about the alternate patch extension ~.
  52.  
  53.     In the manual page, I fixed some quotes that were ugly in troff,
  54.     and did some clarification of LIST, study, tr and unlink.
  55.  
  56.     regexp.c had some redundant debugging code.
  57.  
  58.     tr/x/y/ could dump core if y is shorter than x.  I found this out
  59.     when I tried translating a bunch of characters to space by saying
  60.     something like y/a-z/ /.
  61.  
  62. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your perl source
  63.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  64.     If you don't have the patch program, apply the following by hand,
  65.     or get patch (version 2.0, latest patchlevel).
  66.  
  67.     After patching:
  68.         Configure
  69.         make depend
  70.         make
  71.         make test
  72.         make install
  73.  
  74.     If patch indicates that patchlevel is the wrong version, you may need
  75.     to apply one or more previous patches, or the patch may already
  76.     have been applied.  See the patchlevel.h file to find out what has or
  77.     has not been applied.  In any event, don't continue with the patch.
  78.  
  79.     If you are missing previous patches they can be obtained from me:
  80.  
  81.     Larry Wall
  82.     lwall@jpl-devvax.jpl.nasa.gov
  83.  
  84.     If you send a mail message of the following form it will greatly speed
  85.     processing:
  86.  
  87.     Subject: Command
  88.     @SH mailpatch PATH perl 2.0 LIST
  89.            ^ note the c
  90.  
  91.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  92.     or in bang notation from some well-known host, and LIST is the number
  93.     of one or more patches you need, separated by spaces, commas, and/or
  94.     hyphens.  Saying 35- says everything from 35 to the end.
  95.  
  96.     You can also get the patches via anonymous FTP from
  97.     jpl-devvax.jpl.nasa.gov (128.149.8.43).
  98.  
  99. Index: patchlevel.h
  100. Prereq: 0
  101. 1c1
  102. < #define PATCHLEVEL 0
  103. ---
  104. > #define PATCHLEVEL 1
  105.  
  106. Index: Configure
  107. Prereq: 2.0
  108. *** Configure.old    Tue Jun 28 16:40:03 1988
  109. --- Configure    Tue Jun 28 16:40:04 1988
  110. ***************
  111. *** 8,14 ****
  112.   # and edit it to reflect your system.  Some packages may include samples
  113.   # of config.h for certain machines, so you might look for one of those.)
  114.   #
  115. ! # $Header: Configure,v 2.0 88/06/05 00:07:37 root Exp $
  116.   #
  117.   # Yes, you may rip this off to use in other distribution packages.
  118.   # (Note: this Configure script was generated automatically.  Rather than
  119. --- 8,14 ----
  120.   # and edit it to reflect your system.  Some packages may include samples
  121.   # of config.h for certain machines, so you might look for one of those.)
  122.   #
  123. ! # $Header: Configure,v 2.0.1.1 88/06/28 16:24:02 root Exp $
  124.   #
  125.   # Yes, you may rip this off to use in other distribution packages.
  126.   # (Note: this Configure script was generated automatically.  Rather than
  127. ***************
  128. *** 76,81 ****
  129. --- 76,82 ----
  130.   d_bcopy=''
  131.   d_charsprf=''
  132.   d_crypt=''
  133. + d_dosuid=''
  134.   d_fchmod=''
  135.   d_fchown=''
  136.   d_getgrps=''
  137. ***************
  138. *** 124,130 ****
  139.   defvoidused=''
  140.   privlib=''
  141.   CONFIG=''
  142. - 
  143.   : set package name
  144.   package=perl
  145.   
  146. --- 125,130 ----
  147. ***************
  148. *** 134,140 ****
  149.   echo " "
  150.   
  151.   define='define'
  152. ! undef='/*undef'
  153.   libpth='/usr/lib /usr/local/lib /lib'
  154.   smallmach='pdp11 i8086 z8000 i80286 iAPX286'
  155.   rmlist='kit[1-9]isdone kit[1-9][0-9]isdone'
  156. --- 134,140 ----
  157.   echo " "
  158.   
  159.   define='define'
  160. ! undef='undef'
  161.   libpth='/usr/lib /usr/local/lib /lib'
  162.   smallmach='pdp11 i8086 z8000 i80286 iAPX286'
  163.   rmlist='kit[1-9]isdone kit[1-9][0-9]isdone'
  164. ***************
  165. *** 480,490 ****
  166.       echo " "
  167.       echo "nm didn't seem to work right."
  168.       echo "Trying ar instead..."
  169. !     if ar t $libc | sed -e 's/\.o$//' > libc.list; then
  170.           echo "Ok."
  171.       else
  172. !         echo "That didn't work either.  Giving up."
  173. !         exit 1
  174.       fi
  175.       fi
  176.   fi
  177. --- 480,498 ----
  178.       echo " "
  179.       echo "nm didn't seem to work right."
  180.       echo "Trying ar instead..."
  181. !     rmlist="$rmlist libc.tmp"
  182. !     if ar t $libc > libc.tmp; then
  183. !         sed -e 's/\.o$//' < libc.tmp > libc.list
  184.           echo "Ok."
  185.       else
  186. !         echo "ar didn't seem to work right."
  187. !         echo "Maybe this is a Cray...trying bld instead..."
  188. !         if bld t $libc | sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list; then
  189. !         echo "Ok."
  190. !         else
  191. !             echo "That didn't work either.  Giving up."
  192. !             exit 1
  193. !         fi
  194.       fi
  195.       fi
  196.   fi
  197. ***************
  198. *** 621,627 ****
  199.   EOT
  200.   echo 'Maybe "'$cpp'" will work...'
  201.   $cpp <testcpp.c >testcpp.out 2>&1
  202. ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  203.       echo "Yup, it does."
  204.       cppstdin="$cpp"
  205.       cppminus='';
  206. --- 629,635 ----
  207.   EOT
  208.   echo 'Maybe "'$cpp'" will work...'
  209.   $cpp <testcpp.c >testcpp.out 2>&1
  210. ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  211.       echo "Yup, it does."
  212.       cppstdin="$cpp"
  213.       cppminus='';
  214. ***************
  215. *** 628,634 ****
  216.   else
  217.       echo 'Nope, maybe "'$cpp' -" will work...'
  218.       $cpp - <testcpp.c >testcpp.out 2>&1
  219. !     if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  220.       echo "Yup, it does."
  221.       cppstdin="$cpp"
  222.       cppminus='-';
  223. --- 636,642 ----
  224.   else
  225.       echo 'Nope, maybe "'$cpp' -" will work...'
  226.       $cpp - <testcpp.c >testcpp.out 2>&1
  227. !     if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  228.       echo "Yup, it does."
  229.       cppstdin="$cpp"
  230.       cppminus='-';
  231. ***************
  232. *** 635,641 ****
  233.       else
  234.       echo 'No such luck...maybe "cc -E" will work...'
  235.       cc -E <testcpp.c >testcpp.out 2>&1
  236. !     if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  237.           echo "It works!"
  238.           cppstdin='cc -E'
  239.           cppminus='';
  240. --- 643,649 ----
  241.       else
  242.       echo 'No such luck...maybe "cc -E" will work...'
  243.       cc -E <testcpp.c >testcpp.out 2>&1
  244. !     if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  245.           echo "It works!"
  246.           cppstdin='cc -E'
  247.           cppminus='';
  248. ***************
  249. *** 642,648 ****
  250.       else
  251.           echo 'Nixed again...maybe "cc -E -" will work...'
  252.           cc -E - <testcpp.c >testcpp.out 2>&1
  253. !         if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  254.           echo "Hooray, it works!  I was beginning to wonder."
  255.           cppstdin='cc -E'
  256.           cppminus='-';
  257. --- 650,656 ----
  258.       else
  259.           echo 'Nixed again...maybe "cc -E -" will work...'
  260.           cc -E - <testcpp.c >testcpp.out 2>&1
  261. !         if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  262.           echo "Hooray, it works!  I was beginning to wonder."
  263.           cppstdin='cc -E'
  264.           cppminus='-';
  265. ***************
  266. *** 649,655 ****
  267.           else
  268.           echo 'Nope...maybe "cc -P" will work...'
  269.           cc -P <testcpp.c >testcpp.out 2>&1
  270. !         if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  271.               echo "Yup, that does."
  272.               cppstdin='cc -P'
  273.               cppminus='';
  274. --- 657,663 ----
  275.           else
  276.           echo 'Nope...maybe "cc -P" will work...'
  277.           cc -P <testcpp.c >testcpp.out 2>&1
  278. !         if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  279.               echo "Yup, that does."
  280.               cppstdin='cc -P'
  281.               cppminus='';
  282. ***************
  283. *** 656,662 ****
  284.           else
  285.               echo 'Nope...maybe "cc -P -" will work...'
  286.               cc -P - <testcpp.c >testcpp.out 2>&1
  287. !             if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  288.               echo "Yup, that does."
  289.               cppstdin='cc -P'
  290.               cppminus='-';
  291. --- 664,670 ----
  292.           else
  293.               echo 'Nope...maybe "cc -P -" will work...'
  294.               cc -P - <testcpp.c >testcpp.out 2>&1
  295. !             if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  296.               echo "Yup, that does."
  297.               cppstdin='cc -P'
  298.               cppminus='-';
  299. ***************
  300. *** 666,672 ****
  301.               '') ;;
  302.               *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;;
  303.               esac
  304. !             if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  305.                   echo "Hooray, you did!  I was beginning to wonder."
  306.               else
  307.                   echo 'Uh-uh.  Time to get fancy...'
  308. --- 674,680 ----
  309.               '') ;;
  310.               *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;;
  311.               esac
  312. !             if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  313.                   echo "Hooray, you did!  I was beginning to wonder."
  314.               else
  315.                   echo 'Uh-uh.  Time to get fancy...'
  316. ***************
  317. *** 674,680 ****
  318.                   cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)'
  319.                   cppminus='';
  320.                   $cppstdin <testcpp.c >testcpp.out 2>&1
  321. !                 if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  322.                   echo "Eureka!."
  323.                   else
  324.                   dflt=blurfl
  325. --- 682,688 ----
  326.                   cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)'
  327.                   cppminus='';
  328.                   $cppstdin <testcpp.c >testcpp.out 2>&1
  329. !                 if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  330.                   echo "Eureka!."
  331.                   else
  332.                   dflt=blurfl
  333. ***************
  334. *** 683,689 ****
  335.                   . myread
  336.                   cppstdin="$ans"
  337.                   $cppstdin <testcpp.c >testcpp.out 2>&1
  338. !                 if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
  339.                       echo "OK, that will do."
  340.                   else
  341.                       echo "Sorry, I can't get that to work.  Go find one."
  342. --- 691,697 ----
  343.                   . myread
  344.                   cppstdin="$ans"
  345.                   $cppstdin <testcpp.c >testcpp.out 2>&1
  346. !                 if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
  347.                       echo "OK, that will do."
  348.                   else
  349.                       echo "Sorry, I can't get that to work.  Go find one."
  350. ***************
  351. *** 733,738 ****
  352. --- 741,777 ----
  353.       d_crypt="$undef"
  354.   fi
  355.   
  356. + : now see if they want to do setuid emulation
  357. + case "$d_dosuid" in
  358. + '') if bsd; then
  359. +     dflt=y
  360. +     else
  361. +     dflt=n
  362. +     fi
  363. +     ;;
  364. + *undef*) dflt=n;;
  365. + *) dflt=y;;
  366. + esac
  367. + cat <<EOM
  368. +  
  369. + Some sites have disabled setuid #! scripts because of a bug in the kernel
  370. + that prevents them from being secure.  If you are on such a system, the
  371. + setuid/setgid bits on scripts are currently useless.  It is possible for
  372. + $package to detect those bits and emulate setuid/setgid in a secure fashion
  373. + until a better solution is devised for the kernel problem.
  374. + 
  375. + EOM
  376. + rp="Do you want to do setuid/setgid emulation? [$dflt]"
  377. + echo $n "$rp $c"
  378. + . myread
  379. + case "$ans" in
  380. + '') $ans="$dflt";;
  381. + esac
  382. + case "$ans" in
  383. + y*)  d_dosuid="$define";;
  384. + *) d_dosuid="$undef";;
  385. + esac
  386. + 
  387.   : see if fchmod exists
  388.   echo " "
  389.   if $contains '^fchmod$' libc.list >/dev/null 2>&1; then
  390. ***************
  391. *** 1334,1341 ****
  392.   *split)
  393.       case "$split" in
  394.       '') 
  395. !     if $contains '-i' $mansrc/ld.1 >/dev/null 2>&1 || \
  396. !        $contains '-i' $mansrc/cc.1 >/dev/null 2>&1; then
  397.           dflt='-i'
  398.       else
  399.           dflt='none'
  400. --- 1373,1380 ----
  401.   *split)
  402.       case "$split" in
  403.       '') 
  404. !     if $contains '\-i' $mansrc/ld.1 >/dev/null 2>&1 || \
  405. !        $contains '\-i' $mansrc/cc.1 >/dev/null 2>&1; then
  406.           dflt='-i'
  407.       else
  408.           dflt='none'
  409. ***************
  410. *** 1594,1599 ****
  411. --- 1633,1639 ----
  412.   d_bcopy='$d_bcopy'
  413.   d_charsprf='$d_charsprf'
  414.   d_crypt='$d_crypt'
  415. + d_dosuid='$d_dosuid'
  416.   d_fchmod='$d_fchmod'
  417.   d_fchown='$d_fchown'
  418.   d_getgrps='$d_getgrps'
  419. ***************
  420. *** 1643,1649 ****
  421.   privlib='$privlib'
  422.   CONFIG=true
  423.   EOT
  424. !  
  425.   CONFIG=true
  426.   
  427.   echo " "
  428. --- 1683,1689 ----
  429.   privlib='$privlib'
  430.   CONFIG=true
  431.   EOT
  432. ! 
  433.   CONFIG=true
  434.   
  435.   echo " "
  436. ***************
  437. *** 1716,1720 ****
  438. --- 1756,1763 ----
  439.   fi
  440.   
  441.   $rm -f kit*isdone
  442. + : the following is currently useless
  443.   cd UU && $rm -f $rmlist
  444. + : since this removes it all anyway
  445. + cd .. && $rm -rf UU
  446.   : end of Configure
  447.  
  448. Index: Makefile.SH
  449. Prereq: 2.0
  450. *** Makefile.SH.old    Tue Jun 28 16:40:14 1988
  451. --- Makefile.SH    Tue Jun 28 16:40:15 1988
  452. ***************
  453. *** 18,28 ****
  454.   *) sln='ln';;
  455.   esac
  456.   
  457.   echo "Extracting Makefile (with variable substitutions)"
  458.   cat >Makefile <<!GROK!THIS!
  459. ! # $Header: Makefile.SH,v 2.0 88/06/05 00:07:54 root Exp $
  460.   #
  461.   # $Log:    Makefile.SH,v $
  462.   # Revision 2.0  88/06/05  00:07:54  root
  463.   # Baseline version 2.0.
  464.   # 
  465. --- 18,37 ----
  466.   *) sln='ln';;
  467.   esac
  468.   
  469. + case "$d_dosuid" in
  470. + *define*) suidperl='suidperl' ;;
  471. + *) suidperl='';;
  472. + esac
  473. + 
  474.   echo "Extracting Makefile (with variable substitutions)"
  475.   cat >Makefile <<!GROK!THIS!
  476. ! # $Header: Makefile.SH,v 2.0.1.1 88/06/28 16:26:04 root Exp $
  477.   #
  478.   # $Log:    Makefile.SH,v $
  479. + # Revision 2.0.1.1  88/06/28  16:26:04  root
  480. + # patch1: support for DOSUID
  481. + # patch1: realclean now knows about ~ extension
  482. + # 
  483.   # Revision 2.0  88/06/05  00:07:54  root
  484.   # Baseline version 2.0.
  485.   # 
  486. ***************
  487. *** 42,53 ****
  488.   SLN = $sln
  489.   
  490.   libs = $libnm -lm
  491. - !GROK!THIS!
  492.   
  493. ! cat >>Makefile <<'!NO!SUBS!'
  494.   
  495. ! public = perl perldb
  496.   
  497.   private = 
  498.   
  499.   manpages = perl.man perldb.man
  500. --- 51,62 ----
  501.   SLN = $sln
  502.   
  503.   libs = $libnm -lm
  504.   
  505. ! public = perl perldb $suidperl
  506.   
  507. ! !GROK!THIS!
  508.   
  509. + cat >>Makefile <<'!NO!SUBS!'
  510.   private = 
  511.   
  512.   manpages = perl.man perldb.man
  513. ***************
  514. *** 67,73 ****
  515.   c = $(c1) $(c2)
  516.   
  517.   obj1 = arg.o array.o cmd.o dump.o eval.o form.o hash.o $(mallocobj)
  518. ! obj2 = perly.o regexp.o stab.o str.o toke.o util.o version.o
  519.   
  520.   obj = $(obj1) $(obj2)
  521.   
  522. --- 76,82 ----
  523.   c = $(c1) $(c2)
  524.   
  525.   obj1 = arg.o array.o cmd.o dump.o eval.o form.o hash.o $(mallocobj)
  526. ! obj2 = regexp.o stab.o str.o toke.o util.o version.o
  527.   
  528.   obj = $(obj1) $(obj2)
  529.   
  530. ***************
  531. *** 84,92 ****
  532.   all: $(public) $(private) $(util)
  533.       touch all
  534.   
  535. ! perl: $(obj) perl.o
  536. !     $(CC) $(LDFLAGS) $(LARGE) $(obj) perl.o $(libs) -o perl
  537.   
  538.   perl.c perly.h: perl.y
  539.       @ echo Expect 37 shift/reduce errors...
  540.       yacc -d perl.y
  541. --- 93,121 ----
  542.   all: $(public) $(private) $(util)
  543.       touch all
  544.   
  545. ! perl: perly.o $(obj) perl.o
  546. !     $(CC) $(LDFLAGS) $(LARGE) perly.o $(obj) perl.o $(libs) -o perl
  547.   
  548. + !NO!SUBS!
  549. + 
  550. + case "$d_dosuid" in
  551. + *define*)
  552. +     cat >>Makefile <<'!NO!SUBS!'
  553. + 
  554. + suidperl: sperly.o $(obj) perl.o
  555. +     $(CC) $(LDFLAGS) $(LARGE) sperly.o $(obj) perl.o $(libs) -o suidperl
  556. + 
  557. + sperly.o: perly.c
  558. +     /bin/rm -f sperly.c
  559. +     ln perly.c sperly.c
  560. +     $(CC) -c -DIAMSUID $(CFLAGS) $(LARGE) sperly.c
  561. +     /bin/rm -f sperly.c
  562. + !NO!SUBS!
  563. +     ;;
  564. + esac
  565. + 
  566. + cat >>Makefile <<'!NO!SUBS!'
  567. + 
  568.   perl.c perly.h: perl.y
  569.       @ echo Expect 37 shift/reduce errors...
  570.       yacc -d perl.y
  571. ***************
  572. *** 108,117 ****
  573.       export PATH || exit 1
  574.       - mv $(bin)/perl $(bin)/perl.old 2>/dev/null
  575.       - if test `pwd` != $(bin); then cp $(public) $(bin); fi
  576. !     cd $(bin); \
  577.   for pub in $(public); do \
  578.   chmod +x `basename $$pub`; \
  579.   done
  580.       - test $(bin) = /usr/bin || rm -f /usr/bin/perl
  581.       - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin
  582.       chmod +x makedir
  583. --- 137,157 ----
  584.       export PATH || exit 1
  585.       - mv $(bin)/perl $(bin)/perl.old 2>/dev/null
  586.       - if test `pwd` != $(bin); then cp $(public) $(bin); fi
  587. !     - cd $(bin); \
  588.   for pub in $(public); do \
  589.   chmod +x `basename $$pub`; \
  590.   done
  591. + !NO!SUBS!
  592. + 
  593. + case "$d_dosuid" in
  594. + *define*)
  595. +     cat >>Makefile <<'!NO!SUBS!'
  596. +     - chmod 4711 $(bin)/suidperl 2>/dev/null
  597. + !NO!SUBS!
  598. +     ;;
  599. + esac
  600. + 
  601. + cat >>Makefile <<'!NO!SUBS!'
  602.       - test $(bin) = /usr/bin || rm -f /usr/bin/perl
  603.       - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin
  604.       chmod +x makedir
  605. ***************
  606. *** 134,140 ****
  607.       rm -f *.o
  608.   
  609.   realclean:
  610. !     rm -f perl *.orig */*.orig *.o core $(addedbyconf)
  611.   
  612.   # The following lint has practically everything turned on.  Unfortunately,
  613.   # you have to wade through a lot of mumbo jumbo that can't be suppressed.
  614. --- 174,180 ----
  615.       rm -f *.o
  616.   
  617.   realclean:
  618. !     rm -f perl *.orig */*.orig *~ */*~ *.o core $(addedbyconf)
  619.   
  620.   # The following lint has practically everything turned on.  Unfortunately,
  621.   # you have to wade through a lot of mumbo jumbo that can't be suppressed.
  622. ***************
  623. *** 163,169 ****
  624.       echo $(sh) | tr ' ' '\012' >.shlist
  625.   
  626.   # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
  627. ! $(obj):
  628.       @ echo "You haven't done a "'"make depend" yet!'; exit 1
  629.   makedepend: makedepend.SH
  630.       /bin/sh makedepend.SH
  631. --- 203,209 ----
  632.       echo $(sh) | tr ' ' '\012' >.shlist
  633.   
  634.   # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
  635. ! perly.o $(obj):
  636.       @ echo "You haven't done a "'"make depend" yet!'; exit 1
  637.   makedepend: makedepend.SH
  638.       /bin/sh makedepend.SH
  639.  
  640. Index: config.h.SH
  641. *** config.h.SH.old    Tue Jun 28 16:40:19 1988
  642. --- config.h.SH    Tue Jun 28 16:40:20 1988
  643. ***************
  644. *** 11,17 ****
  645.       ;;
  646.   esac
  647.   echo "Extracting config.h (with variable substitutions)"
  648. ! cat <<!GROK!THIS! >config.h
  649.   /* config.h
  650.    * This file was produced by running the config.h.SH script, which
  651.    * gets its values from config.sh, which is generally produced by
  652. --- 11,17 ----
  653.       ;;
  654.   esac
  655.   echo "Extracting config.h (with variable substitutions)"
  656. ! sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
  657.   /* config.h
  658.    * This file was produced by running the config.h.SH script, which
  659.    * gets its values from config.sh, which is generally produced by
  660. ***************
  661. *** 70,75 ****
  662. --- 70,90 ----
  663.    *    to encrypt passwords and the like.
  664.    */
  665.   #$d_crypt    CRYPT        /**/
  666. + 
  667. + /* DOSUID:
  668. +  *    This symbol, if defined, indicates that the C program should
  669. +  *    check the script that it is executing for setuid/setgid bits, and
  670. +  *    attempt to emulate setuid/setgid on systems that have disabled
  671. +  *    setuid #! scripts because the kernel can't do it securely.
  672. +  *    It is up to the package designer to make sure that this emulation
  673. +  *    is done securely.  Among other things, it should do an fstat on
  674. +  *    the script it just opened to make sure it really is a setuid/setgid
  675. +  *    script, it should make sure the arguments passed correspond exactly
  676. +  *    to the argument on the #! line, and it should not trust any
  677. +  *    subprocesses to which it must pass the filename rather than the
  678. +  *    file descriptor of the script to be executed.
  679. +  */
  680. + #$d_dosuid DOSUID        /**/
  681.   
  682.   /* FCHMOD:
  683.    *    This symbol, if defined, indicates that the fchmod routine is available
  684.  
  685. Index: perl.man.1
  686. Prereq: 2.0
  687. *** perl.man.1.old    Tue Jun 28 16:40:27 1988
  688. --- perl.man.1    Tue Jun 28 16:40:29 1988
  689. ***************
  690. *** 1,7 ****
  691.   .rn '' }`
  692. ! ''' $Header: perl.man.1,v 2.0 88/06/05 00:09:23 root Exp $
  693.   ''' 
  694.   ''' $Log:    perl.man.1,v $
  695.   ''' Revision 2.0  88/06/05  00:09:23  root
  696.   ''' Baseline version 2.0.
  697.   ''' 
  698. --- 1,11 ----
  699.   .rn '' }`
  700. ! ''' $Header: perl.man.1,v 2.0.1.1 88/06/28 16:28:09 root Exp $
  701.   ''' 
  702.   ''' $Log:    perl.man.1,v $
  703. + ''' Revision 2.0.1.1  88/06/28  16:28:09  root
  704. + ''' patch1: fixed some quotes
  705. + ''' patch1: clarified syntax of LIST
  706. + ''' 
  707.   ''' Revision 2.0  88/06/05  00:09:23  root
  708.   ''' Baseline version 2.0.
  709.   ''' 
  710. ***************
  711. *** 292,298 ****
  712.   .TP 5
  713.   .B \-U
  714.   allows perl to do unsafe operations.
  715. ! Currently the only "unsafe" operation is the unlinking of directories while
  716.   running as superuser.
  717.   .TP 5
  718.   .B \-v
  719. --- 296,302 ----
  720.   .TP 5
  721.   .B \-U
  722.   allows perl to do unsafe operations.
  723. ! Currently the only \*(L"unsafe\*(R" operation is the unlinking of directories while
  724.   running as superuser.
  725.   .TP 5
  726.   .B \-v
  727. ***************
  728. *** 731,738 ****
  729.   .PP
  730.   The foreach loop iterates over a normal array value and sets the variable
  731.   VAR to be each element of the array in turn.
  732. ! The "foreach" keyword is actually identical to the "for" keyword,
  733. ! so you can use "foreach" for readability or "for" for brevity.
  734.   If VAR is omitted, $_ is set to each value.
  735.   If ARRAY is an actual array (as opposed to an expression returning an array
  736.   value), you can modify each element of the array
  737. --- 735,742 ----
  738.   .PP
  739.   The foreach loop iterates over a normal array value and sets the variable
  740.   VAR to be each element of the array in turn.
  741. ! The \*(L"foreach\*(R" keyword is actually identical to the \*(L"for\*(R" keyword,
  742. ! so you can use \*(L"foreach\*(R" for readability or \*(L"for\*(R" for brevity.
  743.   If VAR is omitted, $_ is set to each value.
  744.   If ARRAY is an actual array (as opposed to an expression returning an array
  745.   value), you can modify each element of the array
  746. ***************
  747. *** 909,916 ****
  748.   (It doesn't become false till the next time the range operator evaluated.
  749.   It can become false on the same evaluation it became true, but it still returns
  750.   true once.)
  751. ! The right operand is not evaluated while the operator is in the "false" state,
  752. ! and the left operand is not evaluated while the operator is in the "true" state.
  753.   The .. operator is primarily intended for doing line number ranges after
  754.   the fashion of \fIsed\fR or \fIawk\fR.
  755.   The precedence is a little lower than || and &&.
  756. --- 913,920 ----
  757.   (It doesn't become false till the next time the range operator evaluated.
  758.   It can become false on the same evaluation it became true, but it still returns
  759.   true once.)
  760. ! The right operand is not evaluated while the operator is in the \*(L"false\*(R" state,
  761. ! and the left operand is not evaluated while the operator is in the \*(L"true\*(R" state.
  762.   The .. operator is primarily intended for doing line number ranges after
  763.   the fashion of \fIsed\fR or \fIawk\fR.
  764.   The precedence is a little lower than || and &&.
  765. ***************
  766. *** 1057,1062 ****
  767. --- 1061,1067 ----
  768.   Such a list can consist of any combination of scalar arguments or arrays;
  769.   the arrays will be included in the list as if each individual element were
  770.   interpolated at that point in the list.
  771. + Elements of the LIST should be separated by commas.
  772.   .Ip "/PATTERN/i" 8 4
  773.   Searches a string for a pattern, and returns true (1) or false ('').
  774.   If no string is specified via the =~ or !~ operator,
  775. ***************
  776. *** 1234,1242 ****
  777.   If the value of EXPR does not end in a newline, the current script line
  778.   number and input line number (if any) are also printed, and a newline is
  779.   supplied.
  780. ! Hint: sometimes appending ", stopped" to your message will cause it to make
  781. ! better sense when the string "at foo line 123" is appended.
  782. ! Suppose you are running script "canasta".
  783.   .nf
  784.   
  785.   .ne 7
  786. --- 1239,1247 ----
  787.   If the value of EXPR does not end in a newline, the current script line
  788.   number and input line number (if any) are also printed, and a newline is
  789.   supplied.
  790. ! Hint: sometimes appending \*(L", stopped\*(R" to your message will cause it to make
  791. ! better sense when the string \*(L"at foo line 123\*(R" is appended.
  792. ! Suppose you are running script \*(L"canasta\*(R".
  793.   .nf
  794.   
  795.   .ne 7
  796. ***************
  797. *** 1267,1273 ****
  798.   (See the section on subroutines later on.)
  799.   SUBROUTINE may be a scalar variable, in which case the variable contains
  800.   the name of the subroutine to execute.
  801. ! The parentheses are required to avoid confusion with the next form of "do".
  802.   .Ip "do EXPR" 8 3
  803.   Uses the value of EXPR as a filename and executes the contents of the file
  804.   as a perl script.
  805. --- 1272,1278 ----
  806.   (See the section on subroutines later on.)
  807.   SUBROUTINE may be a scalar variable, in which case the variable contains
  808.   the name of the subroutine to execute.
  809. ! The parentheses are required to avoid confusion with the next form of \*(L"do\*(R".
  810.   .Ip "do EXPR" 8 3
  811.   Uses the value of EXPR as a filename and executes the contents of the file
  812.   as a perl script.
  813. ***************
  814. *** 1287,1293 ****
  815.   call it, so if you are going to use the file inside a loop you might prefer
  816.   to use #include, at the expense of a little more startup time.
  817.   (The main problem with #include is that cpp doesn't grok # comments--a
  818. ! workaround is to use ";#" for standalone comments.)
  819.   Note that the following are NOT equivalent:
  820.   .nf
  821.   
  822. --- 1292,1298 ----
  823.   call it, so if you are going to use the file inside a loop you might prefer
  824.   to use #include, at the expense of a little more startup time.
  825.   (The main problem with #include is that cpp doesn't grok # comments--a
  826. ! workaround is to use \*(L";#\*(R" for standalone comments.)
  827.   Note that the following are NOT equivalent:
  828.   .nf
  829.   
  830.  
  831. Index: perl.man.2
  832. Prereq: 2.0
  833. *** perl.man.2.old    Tue Jun 28 16:40:37 1988
  834. --- perl.man.2    Tue Jun 28 16:40:39 1988
  835. ***************
  836. *** 1,7 ****
  837.   ''' Beginning of part 2
  838. ! ''' $Header: perl.man.2,v 2.0 88/06/05 00:09:30 root Exp $
  839.   '''
  840.   ''' $Log:    perl.man.2,v $
  841.   ''' Revision 2.0  88/06/05  00:09:30  root
  842.   ''' Baseline version 2.0.
  843.   ''' 
  844. --- 1,13 ----
  845.   ''' Beginning of part 2
  846. ! ''' $Header: perl.man.2,v 2.0.1.1 88/06/28 16:31:49 root Exp $
  847.   '''
  848.   ''' $Log:    perl.man.2,v $
  849. + ''' Revision 2.0.1.1  88/06/28  16:31:49  root
  850. + ''' patch1: fixed some quotes
  851. + ''' patch1: clarified semantics of study
  852. + ''' patch1: added example of y with short second string
  853. + ''' patch1: added example of unlink with <*>
  854. + ''' 
  855.   ''' Revision 2.0  88/06/05  00:09:30  root
  856.   ''' Baseline version 2.0.
  857.   ''' 
  858. ***************
  859. *** 99,105 ****
  860.   .Ip "local(LIST)" 8 4
  861.   Declares the listed (scalar) variables to be local to the enclosing block,
  862.   subroutine or eval.
  863. ! (The "do 'filename';" operator also counts as an eval.)
  864.   This operator works by saving the current values of those variables in LIST
  865.   on a hidden stack and restoring them upon exiting the block, subroutine or eval.
  866.   The LIST may be assigned to if desired, which allows you to initialize
  867. --- 105,111 ----
  868.   .Ip "local(LIST)" 8 4
  869.   Declares the listed (scalar) variables to be local to the enclosing block,
  870.   subroutine or eval.
  871. ! (The \*(L"do 'filename';\*(R" operator also counts as an eval.)
  872.   This operator works by saving the current values of those variables in LIST
  873.   on a hidden stack and restoring them upon exiting the block, subroutine or eval.
  874.   The LIST may be assigned to if desired, which allows you to initialize
  875. ***************
  876. *** 226,232 ****
  877.   
  878.   .fi
  879.   You may also, in the Bourne shell tradition, specify an EXPR beginning
  880. ! with ">&", in which case the rest of the string
  881.   is interpreted as the name of a filehandle
  882.   (or file descriptor, if numeric) which is to be duped and opened.
  883.   Here is a script that saves, redirects, and restores stdout and stdin:
  884. --- 232,238 ----
  885.   
  886.   .fi
  887.   You may also, in the Bourne shell tradition, specify an EXPR beginning
  888. ! with \*(L">&\*(R", in which case the rest of the string
  889.   is interpreted as the name of a filehandle
  890.   (or file descriptor, if numeric) which is to be duped and opened.
  891.   Here is a script that saves, redirects, and restores stdout and stdin:
  892. ***************
  893. *** 256,262 ****
  894.       print stderr "stderr 2\en";
  895.   
  896.   .fi
  897. ! If you open a pipe on the command "-", i.e. either "|-" or "-|",
  898.   then there is an implicit fork done, and the return value of open
  899.   is the pid of the child within the parent process, and 0 within the child
  900.   process.
  901. --- 262,268 ----
  902.       print stderr "stderr 2\en";
  903.   
  904.   .fi
  905. ! If you open a pipe on the command \*(L"-\*(R", i.e. either \*(L"|-\*(R" or \*(L"-|\*(R",
  906.   then there is an implicit fork done, and the return value of open
  907.   is the pid of the child within the parent process, and 0 within the child
  908.   process.
  909. ***************
  910. *** 304,310 ****
  911.   To set the default output channel to something other than stdout use the select operation.
  912.   .Ip "printf FILEHANDLE LIST" 8 9
  913.   .Ip "printf LIST" 8
  914. ! Equivalent to a "print FILEHANDLE sprintf(LIST)".
  915.   .Ip "push(ARRAY,LIST)" 8 7
  916.   Treats ARRAY (@ is optional) as a stack, and pushes the values of LIST
  917.   onto the end of ARRAY.
  918. --- 310,316 ----
  919.   To set the default output channel to something other than stdout use the select operation.
  920.   .Ip "printf FILEHANDLE LIST" 8 9
  921.   .Ip "printf LIST" 8
  922. ! Equivalent to a \*(L"print FILEHANDLE sprintf(LIST)\*(R".
  923.   .Ip "push(ARRAY,LIST)" 8 7
  924.   Treats ARRAY (@ is optional) as a stack, and pushes the values of LIST
  925.   onto the end of ARRAY.
  926. ***************
  927. *** 559,569 ****
  928.   Takes extra time to study SCALAR ($_ if unspecified) in anticipation of
  929.   doing many pattern matches on the string before it is next modified.
  930.   This may or may not save time, depending on the nature and number of patterns
  931. ! you are searching on\*(--you probably want to compare runtimes with and
  932.   without it to see which runs faster.
  933.   Those loops which scan for many short constant strings (including the constant
  934.   parts of more complex patterns) will benefit most.
  935. ! For example, a loop which inserts index producing entries before an line
  936.   containing a certain pattern:
  937.   .nf
  938.   
  939. --- 565,583 ----
  940.   Takes extra time to study SCALAR ($_ if unspecified) in anticipation of
  941.   doing many pattern matches on the string before it is next modified.
  942.   This may or may not save time, depending on the nature and number of patterns
  943. ! you are searching on, and on the distribution of character frequencies in
  944. ! the string to be searched\*(--you probably want to compare runtimes with and
  945.   without it to see which runs faster.
  946.   Those loops which scan for many short constant strings (including the constant
  947.   parts of more complex patterns) will benefit most.
  948. ! (The way study works is this: a linked list of every character in the string
  949. ! to be searched is made, so we know, for example, where all the `k' characters
  950. ! are.
  951. ! From each search string, the rarest character is selected, based on some
  952. ! static frequency tables constructed from some C programs and English text.
  953. ! Only those places that contain this \*(L"rarest\*(R" character are examined.)
  954. ! .Sp
  955. ! For example, here is a loop which inserts index producing entries before an line
  956.   containing a certain pattern:
  957.   .nf
  958.   
  959. ***************
  960. *** 578,583 ****
  961. --- 592,628 ----
  962.       }
  963.   
  964.   .fi
  965. + In searching for /\ebfoo\eb/, only those locations in $_ that contain `f'
  966. + will be looked at, because `f' is rarer than `o'.
  967. + In general, this is a big win except in pathological cases.
  968. + The only question is whether it saves you more time than it took to build
  969. + the linked list in the first place.
  970. + .Sp
  971. + Note that if you have to look for strings that you don't know till runtime,
  972. + you can build an entire loop as a string and eval that to avoid recompiling
  973. + all your patterns all the time.
  974. + Together with setting $/ to input entire files as one record, this can
  975. + be very fast, often faster than specialized programs like fgrep.
  976. + The following scans a list of files (@files)
  977. + for a list of words (@words), and prints out the names of those files that
  978. + contain a match:
  979. + .nf
  980. + 
  981. + .ne 12
  982. +     $search = 'while (<>) { study;';
  983. +     foreach $word (@words) {
  984. +         $search .= "\e++$seen{\e$ARGV} if /\eb$word\eb/;\en";
  985. +     }
  986. +     $search .= "}";
  987. +     @ARGV = @files;
  988. +     $/ = "\e177";        # something that doesn't occur
  989. +     eval $search;        # this screams
  990. +     $/ = "\en";        # put back to normal input delim
  991. +     foreach $file (sort keys(seen)) {
  992. +         print $file,"\en";
  993. +     }
  994. + 
  995. + .fi
  996.   .Ip "substr(EXPR,OFFSET,LEN)" 8 2
  997.   Extracts a substring out of EXPR and returns it.
  998.   First character is at offset 0, or whatever you've set $[ to.
  999. ***************
  1000. *** 639,644 ****
  1001. --- 684,691 ----
  1002.   
  1003.       ($HOST = $host) =~ tr/a-z/A-Z/;
  1004.   
  1005. +     y/\e001-@[-_{-\e177/ /;    \h'|3i'# change non-alphas to space
  1006. + 
  1007.   .fi
  1008.   .Ip "umask(EXPR)" 8 3
  1009.   Sets the umask for the process and returns the old one.
  1010. ***************
  1011. *** 650,655 ****
  1012. --- 697,703 ----
  1013.   .ne 2
  1014.       $cnt = unlink 'a','b','c';
  1015.       unlink @goners;
  1016. +     unlink <*.bak>;
  1017.   
  1018.   .fi
  1019.   Note: unlink will not delete directories unless you are superuser and the \-U
  1020. ***************
  1021. *** 671,677 ****
  1022.   modification times, in that order.
  1023.   Returns the number of files successfully changed.
  1024.   The inode modification time of each file is set to the current time.
  1025. ! Example of a "touch" command:
  1026.   .nf
  1027.   
  1028.   .ne 3
  1029. --- 719,725 ----
  1030.   modification times, in that order.
  1031.   Returns the number of files successfully changed.
  1032.   The inode modification time of each file is set to the current time.
  1033. ! Example of a \*(L"touch\*(R" command:
  1034.   .nf
  1035.   
  1036.   .ne 3
  1037. ***************
  1038. *** 769,775 ****
  1039.   that is ($_[0], $_[1], .\|.\|.).
  1040.   The return value of the subroutine is the value of the last expression
  1041.   evaluated.
  1042. ! To create local variables see the "local" operator.
  1043.   .PP
  1044.   A subroutine is called using the
  1045.   .I do
  1046. --- 817,823 ----
  1047.   that is ($_[0], $_[1], .\|.\|.).
  1048.   The return value of the subroutine is the value of the last expression
  1049.   evaluated.
  1050. ! To create local variables see the \*(L"local\*(R" operator.
  1051.   .PP
  1052.   A subroutine is called using the
  1053.   .I do
  1054. ***************
  1055. *** 830,836 ****
  1056.   those supplied in the Version 8 regexp routines.
  1057.   (In fact, the routines are derived from Henry Spencer's freely redistributable
  1058.   reimplementation of the V8 routines.)
  1059. ! In addition, \ew matches an alphanumeric character (including "_") and \eW a nonalphanumeric.
  1060.   Word boundaries may be matched by \eb, and non-boundaries by \eB.
  1061.   A whitespace character is matched by \es, non-whitespace by \eS.
  1062.   A numeric character is matched by \ed, non-numeric by \eD.
  1063. --- 878,884 ----
  1064.   those supplied in the Version 8 regexp routines.
  1065.   (In fact, the routines are derived from Henry Spencer's freely redistributable
  1066.   reimplementation of the V8 routines.)
  1067. ! In addition, \ew matches an alphanumeric character (including \*(L"_\*(R") and \eW a nonalphanumeric.
  1068.   Word boundaries may be matched by \eb, and non-boundaries by \eB.
  1069.   A whitespace character is matched by \es, non-whitespace by \eS.
  1070.   A numeric character is matched by \ed, non-numeric by \eD.
  1071. ***************
  1072. *** 1011,1017 ****
  1073.   The following names have special meaning to
  1074.   .IR perl .
  1075.   I could have used alphabetic symbols for some of these, but I didn't want
  1076. ! to take the chance that someone would say reset "a-zA-Z" and wipe them all
  1077.   out.
  1078.   You'll just have to suffer along with these silly symbols.
  1079.   Most of them have reasonable mnemonics, or analogues in one of the shells.
  1080. --- 1059,1065 ----
  1081.   The following names have special meaning to
  1082.   .IR perl .
  1083.   I could have used alphabetic symbols for some of these, but I didn't want
  1084. ! to take the chance that someone would say reset \*(L"a-zA-Z\*(R" and wipe them all
  1085.   out.
  1086.   You'll just have to suffer along with these silly symbols.
  1087.   Most of them have reasonable mnemonics, or analogues in one of the shells.
  1088. ***************
  1089. *** 1167,1173 ****
  1090.   .Ip $@ 8 2
  1091.   The error message from the last eval command.
  1092.   If null, the last eval parsed and executed correctly.
  1093. ! (Mnemonic: Where was the syntax error "at"?)
  1094.   .Ip $< 8 2
  1095.   The real uid of this process.
  1096.   (Mnemonic: it's the uid you came FROM, if you're running setuid.)
  1097. --- 1215,1221 ----
  1098.   .Ip $@ 8 2
  1099.   The error message from the last eval command.
  1100.   If null, the last eval parsed and executed correctly.
  1101. ! (Mnemonic: Where was the syntax error \*(L"at\*(R"?)
  1102.   .Ip $< 8 2
  1103.   The real uid of this process.
  1104.   (Mnemonic: it's the uid you came FROM, if you're running setuid.)
  1105. ***************
  1106. *** 1206,1214 ****
  1107.   See $0 for the command name.
  1108.   .Ip @INC 8 3
  1109.   The array INC contains the list of places to look for perl scripts to be
  1110. ! evaluated by the "do EXPR" command.
  1111.   It initially consists of the arguments to any -I command line switches, followed
  1112. ! by the default perl library, probably "/usr/local/lib/perl".
  1113.   .Ip $ENV{expr} 8 2
  1114.   The associative array ENV contains your current environment.
  1115.   Setting a value in ENV changes the environment for child processes.
  1116. --- 1254,1262 ----
  1117.   See $0 for the command name.
  1118.   .Ip @INC 8 3
  1119.   The array INC contains the list of places to look for perl scripts to be
  1120. ! evaluated by the \*(L"do EXPR\*(R" command.
  1121.   It initially consists of the arguments to any -I command line switches, followed
  1122. ! by the default perl library, probably \*(L"/usr/local/lib/perl\*(R".
  1123.   .Ip $ENV{expr} 8 2
  1124.   The associative array ENV contains your current environment.
  1125.   Setting a value in ENV changes the environment for child processes.
  1126.  
  1127. Index: perly.c
  1128. Prereq: 2.0
  1129. *** perly.c.old    Tue Jun 28 16:40:49 1988
  1130. --- perly.c    Tue Jun 28 16:40:51 1988
  1131. ***************
  1132. *** 1,6 ****
  1133. ! char rcsid[] = "$Header: perly.c,v 2.0 88/06/05 00:09:56 root Exp $";
  1134.   /*
  1135.    * $Log:    perly.c,v $
  1136.    * Revision 2.0  88/06/05  00:09:56  root
  1137.    * Baseline version 2.0.
  1138.    * 
  1139. --- 1,9 ----
  1140. ! char rcsid[] = "$Header: perly.c,v 2.0.1.1 88/06/28 16:36:49 root Exp $";
  1141.   /*
  1142.    * $Log:    perly.c,v $
  1143. +  * Revision 2.0.1.1  88/06/28  16:36:49  root
  1144. +  * patch1: added DOSUID code
  1145. +  * 
  1146.    * Revision 2.0  88/06/05  00:09:56  root
  1147.    * Baseline version 2.0.
  1148.    * 
  1149. ***************
  1150. *** 26,31 ****
  1151. --- 29,38 ----
  1152.       register char *s;
  1153.       char *index(), *strcpy(), *getenv();
  1154.       bool dosearch = FALSE;
  1155. + #ifdef DOSUID
  1156. +     char **origargv = argv;
  1157. +     char *validarg = "";
  1158. + #endif
  1159.   
  1160.       uid = (int)getuid();
  1161.       euid = (int)geteuid();
  1162. ***************
  1163. *** 36,50 ****
  1164.       for (argc--,argv++; argc; argc--,argv++) {
  1165.       if (argv[0][0] != '-' || !argv[0][1])
  1166.           break;
  1167.         reswitch:
  1168. !     switch (argv[0][1]) {
  1169.       case 'a':
  1170.           minus_a = TRUE;
  1171. !         strcpy(argv[0], argv[0]+1);
  1172.           goto reswitch;
  1173.   #ifdef DEBUGGING
  1174.       case 'D':
  1175. !         debug = atoi(argv[0]+2);
  1176.   #ifdef YYDEBUG
  1177.           yydebug = (debug & 1);
  1178.   #endif
  1179. --- 43,64 ----
  1180.       for (argc--,argv++; argc; argc--,argv++) {
  1181.       if (argv[0][0] != '-' || !argv[0][1])
  1182.           break;
  1183. + #ifdef DOSUID
  1184. +     if (*validarg)
  1185. +     validarg = " PHOOEY ";
  1186. +     else
  1187. +     validarg = argv[0];
  1188. + #endif
  1189. +     s = argv[0]+1;
  1190.         reswitch:
  1191. !     switch (*s) {
  1192.       case 'a':
  1193.           minus_a = TRUE;
  1194. !         s++;
  1195.           goto reswitch;
  1196.   #ifdef DEBUGGING
  1197.       case 'D':
  1198. !         debug = atoi(s+1);
  1199.   #ifdef YYDEBUG
  1200.           yydebug = (debug & 1);
  1201.   #endif
  1202. ***************
  1203. *** 62,75 ****
  1204.           argc--,argv++;
  1205.           break;
  1206.       case 'i':
  1207. !         inplace = savestr(argv[0]+2);
  1208.           argvoutstab = stabent("ARGVOUT",TRUE);
  1209.           break;
  1210.       case 'I':
  1211. !         str_cat(str,argv[0]);
  1212.           str_cat(str," ");
  1213. !         if (argv[0][2]) {
  1214. !         apush(incstab->stab_array,str_make(argv[0]+2));
  1215.           }
  1216.           else {
  1217.           apush(incstab->stab_array,str_make(argv[1]));
  1218. --- 76,90 ----
  1219.           argc--,argv++;
  1220.           break;
  1221.       case 'i':
  1222. !         inplace = savestr(s+1);
  1223.           argvoutstab = stabent("ARGVOUT",TRUE);
  1224.           break;
  1225.       case 'I':
  1226. !         str_cat(str,"-");
  1227. !         str_cat(str,s);
  1228.           str_cat(str," ");
  1229. !         if (s[1]) {
  1230. !         apush(incstab->stab_array,str_make(s+1));
  1231.           }
  1232.           else {
  1233.           apush(incstab->stab_array,str_make(argv[1]));
  1234. ***************
  1235. *** 80,106 ****
  1236.           break;
  1237.       case 'n':
  1238.           minus_n = TRUE;
  1239. !         strcpy(argv[0], argv[0]+1);
  1240.           goto reswitch;
  1241.       case 'p':
  1242.           minus_p = TRUE;
  1243. !         strcpy(argv[0], argv[0]+1);
  1244.           goto reswitch;
  1245.       case 'P':
  1246.           preprocess = TRUE;
  1247. !         strcpy(argv[0], argv[0]+1);
  1248.           goto reswitch;
  1249.       case 's':
  1250.           doswitches = TRUE;
  1251. !         strcpy(argv[0], argv[0]+1);
  1252.           goto reswitch;
  1253.       case 'S':
  1254.           dosearch = TRUE;
  1255. !         strcpy(argv[0], argv[0]+1);
  1256.           goto reswitch;
  1257.       case 'U':
  1258.           unsafe = TRUE;
  1259. !         strcpy(argv[0], argv[0]+1);
  1260.           goto reswitch;
  1261.       case 'v':
  1262.           version();
  1263. --- 95,121 ----
  1264.           break;
  1265.       case 'n':
  1266.           minus_n = TRUE;
  1267. !         s++;
  1268.           goto reswitch;
  1269.       case 'p':
  1270.           minus_p = TRUE;
  1271. !         s++;
  1272.           goto reswitch;
  1273.       case 'P':
  1274.           preprocess = TRUE;
  1275. !         s++;
  1276.           goto reswitch;
  1277.       case 's':
  1278.           doswitches = TRUE;
  1279. !         s++;
  1280.           goto reswitch;
  1281.       case 'S':
  1282.           dosearch = TRUE;
  1283. !         s++;
  1284.           goto reswitch;
  1285.       case 'U':
  1286.           unsafe = TRUE;
  1287. !         s++;
  1288.           goto reswitch;
  1289.       case 'v':
  1290.           version();
  1291. ***************
  1292. *** 107,113 ****
  1293.           exit(0);
  1294.       case 'w':
  1295.           dowarn = TRUE;
  1296. !         strcpy(argv[0], argv[0]+1);
  1297.           goto reswitch;
  1298.       case '-':
  1299.           argc--,argv++;
  1300. --- 122,128 ----
  1301.           exit(0);
  1302.       case 'w':
  1303.           dowarn = TRUE;
  1304. !         s++;
  1305.           goto reswitch;
  1306.       case '-':
  1307.           argc--,argv++;
  1308. ***************
  1309. *** 115,121 ****
  1310.       case 0:
  1311.           break;
  1312.       default:
  1313. !         fatal("Unrecognized switch: %s",argv[0]);
  1314.       }
  1315.       }
  1316.     switch_end:
  1317. --- 130,136 ----
  1318.       case 0:
  1319.           break;
  1320.       default:
  1321. !         fatal("Unrecognized switch: -%s",s);
  1322.       }
  1323.       }
  1324.     switch_end:
  1325. ***************
  1326. *** 186,191 ****
  1327. --- 201,210 ----
  1328.    -e 's/^#.*//' \
  1329.    %s | %s -C %s %s",
  1330.         argv[0], CPPSTDIN, str_get(str), CPPMINUS);
  1331. + #ifdef IAMSUID
  1332. +     if (euid != uid && !euid)    /* if running suidperl */
  1333. +         seteuid(uid);        /* musn't stay setuid root */
  1334. + #endif
  1335.       rsfp = popen(buf,"r");
  1336.       }
  1337.       else if (!*argv[0])
  1338. ***************
  1339. *** 192,200 ****
  1340.       rsfp = stdin;
  1341.       else
  1342.       rsfp = fopen(argv[0],"r");
  1343. !     if (rsfp == Nullfp)
  1344.       fatal("Perl script \"%s\" doesn't seem to exist",filename);
  1345.       str_free(str);        /* free -I directories */
  1346.   
  1347.       defstab = stabent("_",TRUE);
  1348.   
  1349. --- 211,302 ----
  1350.       rsfp = stdin;
  1351.       else
  1352.       rsfp = fopen(argv[0],"r");
  1353. !     if (rsfp == Nullfp) {
  1354. ! #ifdef DOSUID
  1355. ! #ifndef IAMSUID
  1356. !     if (euid && stat(filename,&statbuf) >= 0 &&
  1357. !       statbuf.st_mode & (S_ISUID|S_ISGID)) {
  1358. !         execvp("suidperl", origargv);    /* try again */
  1359. !         fatal("Can't do setuid\n");
  1360. !     }
  1361. ! #endif
  1362. ! #endif
  1363.       fatal("Perl script \"%s\" doesn't seem to exist",filename);
  1364. +     }
  1365.       str_free(str);        /* free -I directories */
  1366. + 
  1367. +     /* do we need to emulate setuid on scripts? */
  1368. + 
  1369. +     /* This code is for those BSD systems that have setuid #! scripts disabled
  1370. +      * in the kernel because of a security problem.  Merely defining DOSUID
  1371. +      * in perl will not fix that problem, but if you have disabled setuid
  1372. +      * scripts in the kernel, this will attempt to emulate setuid and setgid
  1373. +      * on scripts that have those now-otherwise-useless bits set.  The setuid
  1374. +      * root version must be called suidperl.  If regular perl discovers that
  1375. +      * it has opened a setuid script, it calls suidperl with the same argv
  1376. +      * that it had.  If suidperl finds that the script it has just opened
  1377. +      * is NOT setuid root, it sets the effective uid back to the uid.  We
  1378. +      * don't just make perl setuid root because that loses the effective
  1379. +      * uid we had before invoking perl, if it was different from the uid.
  1380. +      *
  1381. +      * DOSUID must be defined in both perl and suidperl, and IAMSUID must
  1382. +      * be defined in suidperl only.  suidperl must be setuid root.  The
  1383. +      * Configure script will set this up for you if you want it.
  1384. +      */
  1385. + #ifdef DOSUID
  1386. +     if (fstat(fileno(rsfp),&statbuf) < 0)    /* normal stat is insecure */
  1387. +     fatal("Can't stat script \"%s\"",filename);
  1388. +     if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
  1389. +     int len;
  1390. + 
  1391. +     if (access(filename,1))        /* as a double check */
  1392. +         fatal("Permission denied");
  1393. +     if ((statbuf.st_mode & S_IFMT) != S_IFREG)
  1394. +         fatal("Permission denied");
  1395. +     doswitches = FALSE;        /* -s is insecure in suid */
  1396. +     line++;
  1397. +     if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
  1398. +       strnNE(tokenbuf,"#!",2) )    /* required even on Sys V */
  1399. +         fatal("No #! line");
  1400. +     for (s = tokenbuf+2; !isspace(*s); s++) ;
  1401. +     if (strnNE(s-4,"perl",4))    /* sanity check */
  1402. +         fatal("Not a perl script");
  1403. +     while (*s && isspace(*s)) s++;
  1404. +     /*
  1405. +      * #! arg must be what we saw above.  They can invoke it by
  1406. +      * mentioning suidperl explicitly, but they may not add any strange
  1407. +      * arguments beyond what #! says if they do invoke suidperl that way.
  1408. +      */
  1409. +     len = strlen(validarg);
  1410. +     if (strEQ(validarg," PHOOEY ") ||
  1411. +         strnNE(s,validarg,len) || !isspace(s[len]))
  1412. +         fatal("Arg must be \"%s\"\n",s);
  1413. + 
  1414. +     if (euid) {    /* oops, we're not the setuid root perl */
  1415. +         fclose(rsfp);
  1416. + #ifndef IAMSUID
  1417. +         execvp("suidperl", origargv);    /* try again */
  1418. + #endif
  1419. +         fatal("Can't do setuid\n");
  1420. +     }
  1421. + 
  1422. +     if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid)
  1423. +         seteuid(statbuf.st_uid);    /* all that for this */
  1424. +     else if (uid)            /* oops, mustn't run as root */
  1425. +         seteuid(uid);
  1426. +     if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid())
  1427. +         setegid(statbuf.st_gid);
  1428. +     euid = (int)geteuid();
  1429. +     if (!cando(S_IEXEC,TRUE))
  1430. +         fatal("Permission denied\n");    /* they can't do this */
  1431. +     }
  1432. + #ifdef IAMSUID
  1433. +     else if (preprocess)
  1434. +     fatal("-P not allowed for setuid/setgid script\n");
  1435. +     else
  1436. +     fatal("Script is not setuid/setgid in suidperl\n");
  1437. + #endif /* IAMSUID */
  1438. + #endif /* DOSUID */
  1439.   
  1440.       defstab = stabent("_",TRUE);
  1441.   
  1442.  
  1443. Index: regexp.c
  1444. Prereq: 2.0
  1445. *** regexp.c.old    Tue Jun 28 16:41:00 1988
  1446. --- regexp.c    Tue Jun 28 16:41:02 1988
  1447. ***************
  1448. *** 7,15 ****
  1449.    * blame Henry for some of the lack of readability.
  1450.    */
  1451.   
  1452. ! /* $Header: regexp.c,v 2.0 88/06/05 00:10:45 root Exp $
  1453.    *
  1454.    * $Log:    regexp.c,v $
  1455.    * Revision 2.0  88/06/05  00:10:45  root
  1456.    * Baseline version 2.0.
  1457.    * 
  1458. --- 7,18 ----
  1459.    * blame Henry for some of the lack of readability.
  1460.    */
  1461.   
  1462. ! /* $Header: regexp.c,v 2.0.1.1 88/06/28 16:37:19 root Exp $
  1463.    *
  1464.    * $Log:    regexp.c,v $
  1465. +  * Revision 2.0.1.1  88/06/28  16:37:19  root
  1466. +  * patch1: removed redundant debugging code
  1467. +  * 
  1468.    * Revision 2.0  88/06/05  00:10:45  root
  1469.    * Baseline version 2.0.
  1470.    * 
  1471. ***************
  1472. *** 398,408 ****
  1473.               if (len > !(sawstudy))
  1474.                   fbmcompile(r->regmust);
  1475.               *(long*)&r->regmust->str_nval = 100;
  1476. - #ifdef DEBUGGING
  1477. -             if (debug & 512)
  1478. -                 fprintf(stderr,"must = '%s' back=%d\n",
  1479. -                 longest,back);
  1480. - #endif
  1481.           }
  1482.           else
  1483.               str_free(longest);
  1484. --- 401,406 ----
  1485.  
  1486. Index: str.c
  1487. Prereq: 2.0
  1488. *** str.c.old    Tue Jun 28 16:41:09 1988
  1489. --- str.c    Tue Jun 28 16:41:10 1988
  1490. ***************
  1491. *** 1,6 ****
  1492. ! /* $Header: str.c,v 2.0 88/06/05 00:11:07 root Exp $
  1493.    *
  1494.    * $Log:    str.c,v $
  1495.    * Revision 2.0  88/06/05  00:11:07  root
  1496.    * Baseline version 2.0.
  1497.    * 
  1498. --- 1,9 ----
  1499. ! /* $Header: str.c,v 2.0.1.1 88/06/28 16:38:11 root Exp $
  1500.    *
  1501.    * $Log:    str.c,v $
  1502. +  * Revision 2.0.1.1  88/06/28  16:38:11  root
  1503. +  * patch1: autoincrement of '' didn't work right.
  1504. +  * 
  1505.    * Revision 2.0  88/06/05  00:11:07  root
  1506.    * Baseline version 2.0.
  1507.    * 
  1508. ***************
  1509. *** 468,473 ****
  1510. --- 471,477 ----
  1511.       if (!str->str_pok || !*str->str_ptr) {
  1512.       str->str_nval = 1.0;
  1513.       str->str_nok = 1;
  1514. +     str->str_pok = 0;
  1515.       return;
  1516.       }
  1517.       d = str->str_ptr;
  1518.  
  1519. Index: toke.c
  1520. Prereq: 2.0
  1521. *** toke.c.old    Tue Jun 28 16:41:16 1988
  1522. --- toke.c    Tue Jun 28 16:41:18 1988
  1523. ***************
  1524. *** 1,6 ****
  1525. ! /* $Header: toke.c,v 2.0 88/06/05 00:11:16 root Exp $
  1526.    *
  1527.    * $Log:    toke.c,v $
  1528.    * Revision 2.0  88/06/05  00:11:16  root
  1529.    * Baseline version 2.0.
  1530.    * 
  1531. --- 1,9 ----
  1532. ! /* $Header: toke.c,v 2.0.1.1 88/06/28 16:39:50 root Exp $
  1533.    *
  1534.    * $Log:    toke.c,v $
  1535. +  * Revision 2.0.1.1  88/06/28  16:39:50  root
  1536. +  * patch1: tr/x/y/ can dump core if y is shorter than x
  1537. +  * 
  1538.    * Revision 2.0  88/06/05  00:11:16  root
  1539.    * Baseline version 2.0.
  1540.    * 
  1541. ***************
  1542. *** 922,927 ****
  1543. --- 925,931 ----
  1544.       register char *r;
  1545.       register char *tbl = safemalloc(256);
  1546.       register int i;
  1547. +     register int j;
  1548.   
  1549.       arg[2].arg_type = A_NULL;
  1550.       arg[2].arg_ptr.arg_cval = tbl;
  1551. ***************
  1552. *** 942,951 ****
  1553.       safefree(r);
  1554.       r = t;
  1555.       }
  1556. !     for (i = 0; t[i]; i++) {
  1557. !     if (!r[i])
  1558. !         r[i] = r[i-1];
  1559. !     tbl[t[i] & 0377] = r[i];
  1560.       }
  1561.       if (r != t)
  1562.       safefree(r);
  1563. --- 946,955 ----
  1564.       safefree(r);
  1565.       r = t;
  1566.       }
  1567. !     for (i = 0, j = 0; t[i]; i++,j++) {
  1568. !     if (!r[j])
  1569. !         --j;
  1570. !     tbl[t[i] & 0377] = r[j];
  1571.       }
  1572.       if (r != t)
  1573.       safefree(r);
  1574.  
  1575.