lwall@devvax.JPL.NASA.GOV (Larry Wall) (06/29/88)
System: perl version 2.0 Patch #: 1 Priority: MEDIUM Subject: autoincrement of '' didn't work right. Subject: tr/x/y/ can dump core if y is shorter than x Subject: added support for DOSUID Subject: in Configure, fix for machines that can't do #/*undef Subject: in Configure, return code from ar was ignored Subject: in Configure, Cray uses bld instead of ar Subject: in Configure, Gnucpp adds space after symbol interpolation Subject: in Configure, grep '-i' should be grep '\-i' Subject: Configure should remove UU subdirectory entirely Subject: realclean now knows about ~ extension Subject: fixed some quotes in manual page Subject: clarified syntax of LIST in manual page Subject: clarified semantics of study in manual page Subject: added example of y with short second string in manual page Subject: added example of unlink with <*> in manual page Subject: removed redundant debugging code in regexp.c Description: If you used ++ on a variable that had the value '' (as opposed to being undefined) it would increment the numeric part but not invalidate the string part, which could then give false results. Berkeley recently sent out a patch that disables setuid #! scripts because of an inherent problem in the semantics as they are currently defined. If you have installed that patch, your setuid and setgid bits are useless on scripts. I've added a means for perl to examine those bits and emulate setuid/setgid scripts itself in what I believe is a secure manner. If normal perl detects such a script, it passes it off to another version of perl that runs setuid root, and can run the script under the desired uid/gid. This feature is optional, and Configure will ask if you want to do it. Some machines didn't like config.h when it said #/*undef SYMBOL. Config.h.SH now is smart enough to tuck the # inside the comment. There were several small problems in Configure: the return code from ar was hidden by a piped call to sed, so if ar failed it went undetected. The Cray uses a program called bld instead of ar. Let's hear it for compatibility. At least one version of gnucpp adds a space after symbol interpolation, which was giving the C preprocessor detector fits. There was a call to grep '-i' that needed to have the -i protected by a backslash. Also, Configure should remove the UU subdirectory that it makes while running. "make realclean" now knows about the alternate patch extension ~. In the manual page, I fixed some quotes that were ugly in troff, and did some clarification of LIST, study, tr and unlink. regexp.c had some redundant debugging code. tr/x/y/ could dump core if y is shorter than x. I found this out when I tried translating a bunch of characters to space by saying something like y/a-z/ /. 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: Configure make depend make make test make install 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: 0 1c1 < #define PATCHLEVEL 0 --- > #define PATCHLEVEL 1 Index: Configure Prereq: 2.0 *** Configure.old Tue Jun 28 16:40:03 1988 --- Configure Tue Jun 28 16:40:04 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 88/06/05 00:07:37 root Exp $ # # 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.1 88/06/28 16:24:02 root Exp $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than *************** *** 76,81 **** --- 76,82 ---- d_bcopy='' d_charsprf='' d_crypt='' + d_dosuid='' d_fchmod='' d_fchown='' d_getgrps='' *************** *** 124,130 **** defvoidused='' privlib='' CONFIG='' - : set package name package=perl --- 125,130 ---- *************** *** 134,140 **** echo " " define='define' ! undef='/*undef' libpth='/usr/lib /usr/local/lib /lib' smallmach='pdp11 i8086 z8000 i80286 iAPX286' rmlist='kit[1-9]isdone kit[1-9][0-9]isdone' --- 134,140 ---- echo " " define='define' ! undef='undef' libpth='/usr/lib /usr/local/lib /lib' smallmach='pdp11 i8086 z8000 i80286 iAPX286' rmlist='kit[1-9]isdone kit[1-9][0-9]isdone' *************** *** 480,490 **** echo " " echo "nm didn't seem to work right." echo "Trying ar instead..." ! if ar t $libc | sed -e 's/\.o$//' > libc.list; then echo "Ok." else ! echo "That didn't work either. Giving up." ! exit 1 fi fi fi --- 480,498 ---- echo " " echo "nm didn't seem to work right." echo "Trying ar instead..." ! rmlist="$rmlist libc.tmp" ! if ar t $libc > libc.tmp; then ! sed -e 's/\.o$//' < libc.tmp > libc.list echo "Ok." else ! echo "ar didn't seem to work right." ! echo "Maybe this is a Cray...trying bld instead..." ! if bld t $libc | sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list; then ! echo "Ok." ! else ! echo "That didn't work either. Giving up." ! exit 1 ! fi fi fi fi *************** *** 621,627 **** EOT echo 'Maybe "'$cpp'" will work...' $cpp <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus=''; --- 629,635 ---- EOT echo 'Maybe "'$cpp'" will work...' $cpp <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus=''; *************** *** 628,634 **** else echo 'Nope, maybe "'$cpp' -" will work...' $cpp - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus='-'; --- 636,642 ---- else echo 'Nope, maybe "'$cpp' -" will work...' $cpp - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus='-'; *************** *** 635,641 **** else echo 'No such luck...maybe "cc -E" will work...' cc -E <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "It works!" cppstdin='cc -E' cppminus=''; --- 643,649 ---- else echo 'No such luck...maybe "cc -E" will work...' cc -E <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "It works!" cppstdin='cc -E' cppminus=''; *************** *** 642,648 **** else echo 'Nixed again...maybe "cc -E -" will work...' cc -E - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, it works! I was beginning to wonder." cppstdin='cc -E' cppminus='-'; --- 650,656 ---- else echo 'Nixed again...maybe "cc -E -" will work...' cc -E - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, it works! I was beginning to wonder." cppstdin='cc -E' cppminus='-'; *************** *** 649,655 **** else echo 'Nope...maybe "cc -P" will work...' cc -P <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus=''; --- 657,663 ---- else echo 'Nope...maybe "cc -P" will work...' cc -P <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus=''; *************** *** 656,662 **** else echo 'Nope...maybe "cc -P -" will work...' cc -P - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus='-'; --- 664,670 ---- else echo 'Nope...maybe "cc -P -" will work...' cc -P - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus='-'; *************** *** 666,672 **** '') ;; *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;; esac ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, you did! I was beginning to wonder." else echo 'Uh-uh. Time to get fancy...' --- 674,680 ---- '') ;; *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;; esac ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, you did! I was beginning to wonder." else echo 'Uh-uh. Time to get fancy...' *************** *** 674,680 **** cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)' cppminus=''; $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Eureka!." else dflt=blurfl --- 682,688 ---- cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)' cppminus=''; $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Eureka!." else dflt=blurfl *************** *** 683,689 **** . myread cppstdin="$ans" $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "OK, that will do." else echo "Sorry, I can't get that to work. Go find one." --- 691,697 ---- . myread cppstdin="$ans" $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "OK, that will do." else echo "Sorry, I can't get that to work. Go find one." *************** *** 733,738 **** --- 741,777 ---- d_crypt="$undef" fi + : now see if they want to do setuid emulation + case "$d_dosuid" in + '') if bsd; then + dflt=y + else + dflt=n + fi + ;; + *undef*) dflt=n;; + *) dflt=y;; + esac + cat <<EOM + + Some sites have disabled setuid #! scripts because of a bug in the kernel + that prevents them from being secure. If you are on such a system, the + setuid/setgid bits on scripts are currently useless. It is possible for + $package to detect those bits and emulate setuid/setgid in a secure fashion + until a better solution is devised for the kernel problem. + + EOM + rp="Do you want to do setuid/setgid emulation? [$dflt]" + echo $n "$rp $c" + . myread + case "$ans" in + '') $ans="$dflt";; + esac + case "$ans" in + y*) d_dosuid="$define";; + *) d_dosuid="$undef";; + esac + : see if fchmod exists echo " " if $contains '^fchmod$' libc.list >/dev/null 2>&1; then *************** *** 1334,1341 **** *split) case "$split" in '') ! if $contains '-i' $mansrc/ld.1 >/dev/null 2>&1 || \ ! $contains '-i' $mansrc/cc.1 >/dev/null 2>&1; then dflt='-i' else dflt='none' --- 1373,1380 ---- *split) case "$split" in '') ! if $contains '\-i' $mansrc/ld.1 >/dev/null 2>&1 || \ ! $contains '\-i' $mansrc/cc.1 >/dev/null 2>&1; then dflt='-i' else dflt='none' *************** *** 1594,1599 **** --- 1633,1639 ---- d_bcopy='$d_bcopy' d_charsprf='$d_charsprf' d_crypt='$d_crypt' + d_dosuid='$d_dosuid' d_fchmod='$d_fchmod' d_fchown='$d_fchown' d_getgrps='$d_getgrps' *************** *** 1643,1649 **** privlib='$privlib' CONFIG=true EOT ! CONFIG=true echo " " --- 1683,1689 ---- privlib='$privlib' CONFIG=true EOT ! CONFIG=true echo " " *************** *** 1716,1720 **** --- 1756,1763 ---- fi $rm -f kit*isdone + : the following is currently useless cd UU && $rm -f $rmlist + : since this removes it all anyway + cd .. && $rm -rf UU : end of Configure Index: Makefile.SH Prereq: 2.0 *** Makefile.SH.old Tue Jun 28 16:40:14 1988 --- Makefile.SH Tue Jun 28 16:40:15 1988 *************** *** 18,28 **** *) sln='ln';; esac echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0 88/06/05 00:07:54 root Exp $ # # $Log: Makefile.SH,v $ # Revision 2.0 88/06/05 00:07:54 root # Baseline version 2.0. # --- 18,37 ---- *) sln='ln';; esac + case "$d_dosuid" in + *define*) suidperl='suidperl' ;; + *) suidperl='';; + esac + echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0.1.1 88/06/28 16:26:04 root Exp $ # # $Log: Makefile.SH,v $ + # Revision 2.0.1.1 88/06/28 16:26:04 root + # patch1: support for DOSUID + # patch1: realclean now knows about ~ extension + # # Revision 2.0 88/06/05 00:07:54 root # Baseline version 2.0. # *************** *** 42,53 **** SLN = $sln libs = $libnm -lm - !GROK!THIS! ! cat >>Makefile <<'!NO!SUBS!' ! public = perl perldb private = manpages = perl.man perldb.man --- 51,62 ---- SLN = $sln libs = $libnm -lm ! public = perl perldb $suidperl ! !GROK!THIS! + cat >>Makefile <<'!NO!SUBS!' private = manpages = perl.man perldb.man *************** *** 67,73 **** 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 version.o obj = $(obj1) $(obj2) --- 76,82 ---- 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) *************** *** 84,92 **** all: $(public) $(private) $(util) touch all ! perl: $(obj) perl.o ! $(CC) $(LDFLAGS) $(LARGE) $(obj) perl.o $(libs) -o perl perl.c perly.h: perl.y @ echo Expect 37 shift/reduce errors... yacc -d perl.y --- 93,121 ---- all: $(public) $(private) $(util) 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 37 shift/reduce errors... yacc -d perl.y *************** *** 108,117 **** export PATH || exit 1 - mv $(bin)/perl $(bin)/perl.old 2>/dev/null - if test `pwd` != $(bin); then cp $(public) $(bin); fi ! cd $(bin); \ for pub in $(public); do \ chmod +x `basename $$pub`; \ done - test $(bin) = /usr/bin || rm -f /usr/bin/perl - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin chmod +x makedir --- 137,157 ---- export PATH || exit 1 - mv $(bin)/perl $(bin)/perl.old 2>/dev/null - if test `pwd` != $(bin); then cp $(public) $(bin); fi ! - cd $(bin); \ for pub in $(public); do \ chmod +x `basename $$pub`; \ done + !NO!SUBS! + + case "$d_dosuid" in + *define*) + cat >>Makefile <<'!NO!SUBS!' + - chmod 4711 $(bin)/suidperl 2>/dev/null + !NO!SUBS! + ;; + esac + + cat >>Makefile <<'!NO!SUBS!' - test $(bin) = /usr/bin || rm -f /usr/bin/perl - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin chmod +x makedir *************** *** 134,140 **** rm -f *.o realclean: ! rm -f perl *.orig */*.orig *.o core $(addedbyconf) # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. --- 174,180 ---- rm -f *.o realclean: ! rm -f perl *.orig */*.orig *~ */*~ *.o core $(addedbyconf) # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. *************** *** 163,169 **** echo $(sh) | tr ' ' '\012' >.shlist # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE ! $(obj): @ echo "You haven't done a "'"make depend" yet!'; exit 1 makedepend: makedepend.SH /bin/sh makedepend.SH --- 203,209 ---- echo $(sh) | tr ' ' '\012' >.shlist # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE ! perly.o $(obj): @ echo "You haven't done a "'"make depend" yet!'; exit 1 makedepend: makedepend.SH /bin/sh makedepend.SH Index: config.h.SH *** config.h.SH.old Tue Jun 28 16:40:19 1988 --- config.h.SH Tue Jun 28 16:40:20 1988 *************** *** 11,17 **** ;; esac echo "Extracting config.h (with variable substitutions)" ! cat <<!GROK!THIS! >config.h /* config.h * This file was produced by running the config.h.SH script, which * gets its values from config.sh, which is generally produced by --- 11,17 ---- ;; esac echo "Extracting config.h (with variable substitutions)" ! sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!' /* config.h * This file was produced by running the config.h.SH script, which * gets its values from config.sh, which is generally produced by *************** *** 70,75 **** --- 70,90 ---- * to encrypt passwords and the like. */ #$d_crypt CRYPT /**/ + + /* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ + #$d_dosuid DOSUID /**/ /* FCHMOD: * This symbol, if defined, indicates that the fchmod routine is available Index: perl.man.1 Prereq: 2.0 *** perl.man.1.old Tue Jun 28 16:40:27 1988 --- perl.man.1 Tue Jun 28 16:40:29 1988 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl.man.1,v 2.0 88/06/05 00:09:23 root Exp $ ''' ''' $Log: perl.man.1,v $ ''' Revision 2.0 88/06/05 00:09:23 root ''' Baseline version 2.0. ''' --- 1,11 ---- .rn '' }` ! ''' $Header: perl.man.1,v 2.0.1.1 88/06/28 16:28:09 root Exp $ ''' ''' $Log: perl.man.1,v $ + ''' Revision 2.0.1.1 88/06/28 16:28:09 root + ''' patch1: fixed some quotes + ''' patch1: clarified syntax of LIST + ''' ''' Revision 2.0 88/06/05 00:09:23 root ''' Baseline version 2.0. ''' *************** *** 292,298 **** .TP 5 .B \-U allows perl to do unsafe operations. ! Currently the only "unsafe" operation is the unlinking of directories while running as superuser. .TP 5 .B \-v --- 296,302 ---- .TP 5 .B \-U allows perl to do unsafe operations. ! Currently the only \*(L"unsafe\*(R" operation is the unlinking of directories while running as superuser. .TP 5 .B \-v *************** *** 731,738 **** .PP The foreach loop iterates over a normal array value and sets the variable VAR to be each element of the array in turn. ! The "foreach" keyword is actually identical to the "for" keyword, ! so you can use "foreach" for readability or "for" for brevity. If VAR is omitted, $_ is set to each value. If ARRAY is an actual array (as opposed to an expression returning an array value), you can modify each element of the array --- 735,742 ---- .PP The foreach loop iterates over a normal array value and sets the variable VAR to be each element of the array in turn. ! The \*(L"foreach\*(R" keyword is actually identical to the \*(L"for\*(R" keyword, ! so you can use \*(L"foreach\*(R" for readability or \*(L"for\*(R" for brevity. If VAR is omitted, $_ is set to each value. If ARRAY is an actual array (as opposed to an expression returning an array value), you can modify each element of the array *************** *** 909,916 **** (It doesn't become false till the next time the range operator evaluated. It can become false on the same evaluation it became true, but it still returns true once.) ! The right operand is not evaluated while the operator is in the "false" state, ! and the left operand is not evaluated while the operator is in the "true" state. The .. operator is primarily intended for doing line number ranges after the fashion of \fIsed\fR or \fIawk\fR. The precedence is a little lower than || and &&. --- 913,920 ---- (It doesn't become false till the next time the range operator evaluated. It can become false on the same evaluation it became true, but it still returns true once.) ! The right operand is not evaluated while the operator is in the \*(L"false\*(R" state, ! and the left operand is not evaluated while the operator is in the \*(L"true\*(R" state. The .. operator is primarily intended for doing line number ranges after the fashion of \fIsed\fR or \fIawk\fR. The precedence is a little lower than || and &&. *************** *** 1057,1062 **** --- 1061,1067 ---- Such a list can consist of any combination of scalar arguments or arrays; the arrays will be included in the list as if each individual element were interpolated at that point in the list. + Elements of the LIST should be separated by commas. .Ip "/PATTERN/i" 8 4 Searches a string for a pattern, and returns true (1) or false (''). If no string is specified via the =~ or !~ operator, *************** *** 1234,1242 **** If the value of EXPR does not end in a newline, the current script line number and input line number (if any) are also printed, and a newline is supplied. ! Hint: sometimes appending ", stopped" to your message will cause it to make ! better sense when the string "at foo line 123" is appended. ! Suppose you are running script "canasta". .nf .ne 7 --- 1239,1247 ---- If the value of EXPR does not end in a newline, the current script line number and input line number (if any) are also printed, and a newline is supplied. ! Hint: sometimes appending \*(L", stopped\*(R" to your message will cause it to make ! better sense when the string \*(L"at foo line 123\*(R" is appended. ! Suppose you are running script \*(L"canasta\*(R". .nf .ne 7 *************** *** 1267,1273 **** (See the section on subroutines later on.) SUBROUTINE may be a scalar variable, in which case the variable contains the name of the subroutine to execute. ! The parentheses are required to avoid confusion with the next form of "do". .Ip "do EXPR" 8 3 Uses the value of EXPR as a filename and executes the contents of the file as a perl script. --- 1272,1278 ---- (See the section on subroutines later on.) SUBROUTINE may be a scalar variable, in which case the variable contains the name of the subroutine to execute. ! The parentheses are required to avoid confusion with the next form of \*(L"do\*(R". .Ip "do EXPR" 8 3 Uses the value of EXPR as a filename and executes the contents of the file as a perl script. *************** *** 1287,1293 **** call it, so if you are going to use the file inside a loop you might prefer to use #include, at the expense of a little more startup time. (The main problem with #include is that cpp doesn't grok # comments--a ! workaround is to use ";#" for standalone comments.) Note that the following are NOT equivalent: .nf --- 1292,1298 ---- call it, so if you are going to use the file inside a loop you might prefer to use #include, at the expense of a little more startup time. (The main problem with #include is that cpp doesn't grok # comments--a ! workaround is to use \*(L";#\*(R" for standalone comments.) Note that the following are NOT equivalent: .nf Index: perl.man.2 Prereq: 2.0 *** perl.man.2.old Tue Jun 28 16:40:37 1988 --- perl.man.2 Tue Jun 28 16:40:39 1988 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 2.0 88/06/05 00:09:30 root Exp $ ''' ''' $Log: perl.man.2,v $ ''' Revision 2.0 88/06/05 00:09:30 root ''' Baseline version 2.0. ''' --- 1,13 ---- ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 2.0.1.1 88/06/28 16:31:49 root Exp $ ''' ''' $Log: perl.man.2,v $ + ''' Revision 2.0.1.1 88/06/28 16:31:49 root + ''' patch1: fixed some quotes + ''' patch1: clarified semantics of study + ''' patch1: added example of y with short second string + ''' patch1: added example of unlink with <*> + ''' ''' Revision 2.0 88/06/05 00:09:30 root ''' Baseline version 2.0. ''' *************** *** 99,105 **** .Ip "local(LIST)" 8 4 Declares the listed (scalar) variables to be local to the enclosing block, subroutine or eval. ! (The "do 'filename';" operator also counts as an eval.) This operator works by saving the current values of those variables in LIST on a hidden stack and restoring them upon exiting the block, subroutine or eval. The LIST may be assigned to if desired, which allows you to initialize --- 105,111 ---- .Ip "local(LIST)" 8 4 Declares the listed (scalar) variables to be local to the enclosing block, subroutine or eval. ! (The \*(L"do 'filename';\*(R" operator also counts as an eval.) This operator works by saving the current values of those variables in LIST on a hidden stack and restoring them upon exiting the block, subroutine or eval. The LIST may be assigned to if desired, which allows you to initialize *************** *** 226,232 **** .fi You may also, in the Bourne shell tradition, specify an EXPR beginning ! with ">&", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. Here is a script that saves, redirects, and restores stdout and stdin: --- 232,238 ---- .fi You may also, in the Bourne shell tradition, specify an EXPR beginning ! with \*(L">&\*(R", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. Here is a script that saves, redirects, and restores stdout and stdin: *************** *** 256,262 **** print stderr "stderr 2\en"; .fi ! If you open a pipe on the command "-", i.e. either "|-" or "-|", then there is an implicit fork done, and the return value of open is the pid of the child within the parent process, and 0 within the child process. --- 262,268 ---- print stderr "stderr 2\en"; .fi ! If you open a pipe on the command \*(L"-\*(R", i.e. either \*(L"|-\*(R" or \*(L"-|\*(R", then there is an implicit fork done, and the return value of open is the pid of the child within the parent process, and 0 within the child process. *************** *** 304,310 **** To set the default output channel to something other than stdout use the select operation. .Ip "printf FILEHANDLE LIST" 8 9 .Ip "printf LIST" 8 ! Equivalent to a "print FILEHANDLE sprintf(LIST)". .Ip "push(ARRAY,LIST)" 8 7 Treats ARRAY (@ is optional) as a stack, and pushes the values of LIST onto the end of ARRAY. --- 310,316 ---- To set the default output channel to something other than stdout use the select operation. .Ip "printf FILEHANDLE LIST" 8 9 .Ip "printf LIST" 8 ! Equivalent to a \*(L"print FILEHANDLE sprintf(LIST)\*(R". .Ip "push(ARRAY,LIST)" 8 7 Treats ARRAY (@ is optional) as a stack, and pushes the values of LIST onto the end of ARRAY. *************** *** 559,569 **** Takes extra time to study SCALAR ($_ if unspecified) in anticipation of doing many pattern matches on the string before it is next modified. This may or may not save time, depending on the nature and number of patterns ! you are searching on\*(--you probably want to compare runtimes with and without it to see which runs faster. Those loops which scan for many short constant strings (including the constant parts of more complex patterns) will benefit most. ! For example, a loop which inserts index producing entries before an line containing a certain pattern: .nf --- 565,583 ---- Takes extra time to study SCALAR ($_ if unspecified) in anticipation of doing many pattern matches on the string before it is next modified. This may or may not save time, depending on the nature and number of patterns ! you are searching on, and on the distribution of character frequencies in ! the string to be searched\*(--you probably want to compare runtimes with and without it to see which runs faster. Those loops which scan for many short constant strings (including the constant parts of more complex patterns) will benefit most. ! (The way study works is this: a linked list of every character in the string ! to be searched is made, so we know, for example, where all the `k' characters ! are. ! From each search string, the rarest character is selected, based on some ! static frequency tables constructed from some C programs and English text. ! Only those places that contain this \*(L"rarest\*(R" character are examined.) ! .Sp ! For example, here is a loop which inserts index producing entries before an line containing a certain pattern: .nf *************** *** 578,583 **** --- 592,628 ---- } .fi + In searching for /\ebfoo\eb/, only those locations in $_ that contain `f' + will be looked at, because `f' is rarer than `o'. + In general, this is a big win except in pathological cases. + The only question is whether it saves you more time than it took to build + the linked list in the first place. + .Sp + Note that if you have to look for strings that you don't know till runtime, + you can build an entire loop as a string and eval that to avoid recompiling + all your patterns all the time. + Together with setting $/ to input entire files as one record, this can + be very fast, often faster than specialized programs like fgrep. + The following scans a list of files (@files) + for a list of words (@words), and prints out the names of those files that + contain a match: + .nf + + .ne 12 + $search = 'while (<>) { study;'; + foreach $word (@words) { + $search .= "\e++$seen{\e$ARGV} if /\eb$word\eb/;\en"; + } + $search .= "}"; + @ARGV = @files; + $/ = "\e177"; # something that doesn't occur + eval $search; # this screams + $/ = "\en"; # put back to normal input delim + foreach $file (sort keys(seen)) { + print $file,"\en"; + } + + .fi .Ip "substr(EXPR,OFFSET,LEN)" 8 2 Extracts a substring out of EXPR and returns it. First character is at offset 0, or whatever you've set $[ to. *************** *** 639,644 **** --- 684,691 ---- ($HOST = $host) =~ tr/a-z/A-Z/; + y/\e001-@[-_{-\e177/ /; \h'|3i'# change non-alphas to space + .fi .Ip "umask(EXPR)" 8 3 Sets the umask for the process and returns the old one. *************** *** 650,655 **** --- 697,703 ---- .ne 2 $cnt = unlink 'a','b','c'; unlink @goners; + unlink <*.bak>; .fi Note: unlink will not delete directories unless you are superuser and the \-U *************** *** 671,677 **** modification times, in that order. Returns the number of files successfully changed. The inode modification time of each file is set to the current time. ! Example of a "touch" command: .nf .ne 3 --- 719,725 ---- modification times, in that order. Returns the number of files successfully changed. The inode modification time of each file is set to the current time. ! Example of a \*(L"touch\*(R" command: .nf .ne 3 *************** *** 769,775 **** that is ($_[0], $_[1], .\|.\|.). The return value of the subroutine is the value of the last expression evaluated. ! To create local variables see the "local" operator. .PP A subroutine is called using the .I do --- 817,823 ---- that is ($_[0], $_[1], .\|.\|.). The return value of the subroutine is the value of the last expression evaluated. ! To create local variables see the \*(L"local\*(R" operator. .PP A subroutine is called using the .I do *************** *** 830,836 **** those supplied in the Version 8 regexp routines. (In fact, the routines are derived from Henry Spencer's freely redistributable reimplementation of the V8 routines.) ! In addition, \ew matches an alphanumeric character (including "_") and \eW a nonalphanumeric. Word boundaries may be matched by \eb, and non-boundaries by \eB. A whitespace character is matched by \es, non-whitespace by \eS. A numeric character is matched by \ed, non-numeric by \eD. --- 878,884 ---- those supplied in the Version 8 regexp routines. (In fact, the routines are derived from Henry Spencer's freely redistributable reimplementation of the V8 routines.) ! In addition, \ew matches an alphanumeric character (including \*(L"_\*(R") and \eW a nonalphanumeric. Word boundaries may be matched by \eb, and non-boundaries by \eB. A whitespace character is matched by \es, non-whitespace by \eS. A numeric character is matched by \ed, non-numeric by \eD. *************** *** 1011,1017 **** The following names have special meaning to .IR perl . I could have used alphabetic symbols for some of these, but I didn't want ! to take the chance that someone would say reset "a-zA-Z" and wipe them all out. You'll just have to suffer along with these silly symbols. Most of them have reasonable mnemonics, or analogues in one of the shells. --- 1059,1065 ---- The following names have special meaning to .IR perl . I could have used alphabetic symbols for some of these, but I didn't want ! to take the chance that someone would say reset \*(L"a-zA-Z\*(R" and wipe them all out. You'll just have to suffer along with these silly symbols. Most of them have reasonable mnemonics, or analogues in one of the shells. *************** *** 1167,1173 **** .Ip $@ 8 2 The error message from the last eval command. If null, the last eval parsed and executed correctly. ! (Mnemonic: Where was the syntax error "at"?) .Ip $< 8 2 The real uid of this process. (Mnemonic: it's the uid you came FROM, if you're running setuid.) --- 1215,1221 ---- .Ip $@ 8 2 The error message from the last eval command. If null, the last eval parsed and executed correctly. ! (Mnemonic: Where was the syntax error \*(L"at\*(R"?) .Ip $< 8 2 The real uid of this process. (Mnemonic: it's the uid you came FROM, if you're running setuid.) *************** *** 1206,1214 **** See $0 for the command name. .Ip @INC 8 3 The array INC contains the list of places to look for perl scripts to be ! evaluated by the "do EXPR" command. It initially consists of the arguments to any -I command line switches, followed ! by the default perl library, probably "/usr/local/lib/perl". .Ip $ENV{expr} 8 2 The associative array ENV contains your current environment. Setting a value in ENV changes the environment for child processes. --- 1254,1262 ---- See $0 for the command name. .Ip @INC 8 3 The array INC contains the list of places to look for perl scripts to be ! evaluated by the \*(L"do EXPR\*(R" command. It initially consists of the arguments to any -I command line switches, followed ! by the default perl library, probably \*(L"/usr/local/lib/perl\*(R". .Ip $ENV{expr} 8 2 The associative array ENV contains your current environment. Setting a value in ENV changes the environment for child processes. Index: perly.c Prereq: 2.0 *** perly.c.old Tue Jun 28 16:40:49 1988 --- perly.c Tue Jun 28 16:40:51 1988 *************** *** 1,6 **** ! char rcsid[] = "$Header: perly.c,v 2.0 88/06/05 00:09:56 root Exp $"; /* * $Log: perly.c,v $ * Revision 2.0 88/06/05 00:09:56 root * Baseline version 2.0. * --- 1,9 ---- ! char rcsid[] = "$Header: perly.c,v 2.0.1.1 88/06/28 16:36:49 root Exp $"; /* * $Log: perly.c,v $ + * Revision 2.0.1.1 88/06/28 16:36:49 root + * patch1: added DOSUID code + * * Revision 2.0 88/06/05 00:09:56 root * Baseline version 2.0. * *************** *** 26,31 **** --- 29,38 ---- register char *s; char *index(), *strcpy(), *getenv(); bool dosearch = FALSE; + #ifdef DOSUID + char **origargv = argv; + char *validarg = ""; + #endif uid = (int)getuid(); euid = (int)geteuid(); *************** *** 36,50 **** for (argc--,argv++; argc; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; reswitch: ! switch (argv[0][1]) { case 'a': minus_a = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; #ifdef DEBUGGING case 'D': ! debug = atoi(argv[0]+2); #ifdef YYDEBUG yydebug = (debug & 1); #endif --- 43,64 ---- for (argc--,argv++; argc; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; + #ifdef DOSUID + if (*validarg) + validarg = " PHOOEY "; + else + validarg = argv[0]; + #endif + s = argv[0]+1; reswitch: ! switch (*s) { case 'a': minus_a = TRUE; ! s++; goto reswitch; #ifdef DEBUGGING case 'D': ! debug = atoi(s+1); #ifdef YYDEBUG yydebug = (debug & 1); #endif *************** *** 62,75 **** argc--,argv++; break; case 'i': ! inplace = savestr(argv[0]+2); argvoutstab = stabent("ARGVOUT",TRUE); break; case 'I': ! str_cat(str,argv[0]); str_cat(str," "); ! if (argv[0][2]) { ! apush(incstab->stab_array,str_make(argv[0]+2)); } else { apush(incstab->stab_array,str_make(argv[1])); --- 76,90 ---- argc--,argv++; break; case 'i': ! inplace = savestr(s+1); argvoutstab = stabent("ARGVOUT",TRUE); break; case 'I': ! str_cat(str,"-"); ! str_cat(str,s); str_cat(str," "); ! if (s[1]) { ! apush(incstab->stab_array,str_make(s+1)); } else { apush(incstab->stab_array,str_make(argv[1])); *************** *** 80,106 **** break; case 'n': minus_n = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'p': minus_p = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'P': preprocess = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 's': doswitches = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'S': dosearch = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'U': unsafe = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'v': version(); --- 95,121 ---- break; case 'n': minus_n = TRUE; ! s++; goto reswitch; case 'p': minus_p = TRUE; ! s++; goto reswitch; case 'P': preprocess = TRUE; ! s++; goto reswitch; case 's': doswitches = TRUE; ! s++; goto reswitch; case 'S': dosearch = TRUE; ! s++; goto reswitch; case 'U': unsafe = TRUE; ! s++; goto reswitch; case 'v': version(); *************** *** 107,113 **** exit(0); case 'w': dowarn = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case '-': argc--,argv++; --- 122,128 ---- exit(0); case 'w': dowarn = TRUE; ! s++; goto reswitch; case '-': argc--,argv++; *************** *** 115,121 **** case 0: break; default: ! fatal("Unrecognized switch: %s",argv[0]); } } switch_end: --- 130,136 ---- case 0: break; default: ! fatal("Unrecognized switch: -%s",s); } } switch_end: *************** *** 186,191 **** --- 201,210 ---- -e 's/^#.*//' \ %s | %s -C %s %s", argv[0], CPPSTDIN, str_get(str), CPPMINUS); + #ifdef IAMSUID + if (euid != uid && !euid) /* if running suidperl */ + seteuid(uid); /* musn't stay setuid root */ + #endif rsfp = popen(buf,"r"); } else if (!*argv[0]) *************** *** 192,200 **** rsfp = stdin; else rsfp = fopen(argv[0],"r"); ! if (rsfp == Nullfp) fatal("Perl script \"%s\" doesn't seem to exist",filename); str_free(str); /* free -I directories */ defstab = stabent("_",TRUE); --- 211,302 ---- rsfp = stdin; else rsfp = fopen(argv[0],"r"); ! if (rsfp == Nullfp) { ! #ifdef DOSUID ! #ifndef IAMSUID ! if (euid && stat(filename,&statbuf) >= 0 && ! statbuf.st_mode & (S_ISUID|S_ISGID)) { ! execvp("suidperl", origargv); /* try again */ ! fatal("Can't do setuid\n"); ! } ! #endif ! #endif fatal("Perl script \"%s\" doesn't seem to exist",filename); + } str_free(str); /* free -I directories */ + + /* do we need to emulate setuid on scripts? */ + + /* This code is for those BSD systems that have setuid #! scripts disabled + * in the kernel because of a security problem. Merely defining DOSUID + * in perl will not fix that problem, but if you have disabled setuid + * scripts in the kernel, this will attempt to emulate setuid and setgid + * on scripts that have those now-otherwise-useless bits set. The setuid + * root version must be called suidperl. If regular perl discovers that + * it has opened a setuid script, it calls suidperl with the same argv + * that it had. If suidperl finds that the script it has just opened + * is NOT setuid root, it sets the effective uid back to the uid. We + * don't just make perl setuid root because that loses the effective + * uid we had before invoking perl, if it was different from the uid. + * + * DOSUID must be defined in both perl and suidperl, and IAMSUID must + * be defined in suidperl only. suidperl must be setuid root. The + * Configure script will set this up for you if you want it. + */ + #ifdef DOSUID + if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ + fatal("Can't stat script \"%s\"",filename); + if (statbuf.st_mode & (S_ISUID|S_ISGID)) { + int len; + + if (access(filename,1)) /* as a double check */ + fatal("Permission denied"); + if ((statbuf.st_mode & S_IFMT) != S_IFREG) + fatal("Permission denied"); + doswitches = FALSE; /* -s is insecure in suid */ + line++; + if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch || + strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */ + fatal("No #! line"); + for (s = tokenbuf+2; !isspace(*s); s++) ; + if (strnNE(s-4,"perl",4)) /* sanity check */ + fatal("Not a perl script"); + while (*s && isspace(*s)) s++; + /* + * #! arg must be what we saw above. They can invoke it by + * mentioning suidperl explicitly, but they may not add any strange + * arguments beyond what #! says if they do invoke suidperl that way. + */ + len = strlen(validarg); + if (strEQ(validarg," PHOOEY ") || + strnNE(s,validarg,len) || !isspace(s[len])) + fatal("Arg must be \"%s\"\n",s); + + if (euid) { /* oops, we're not the setuid root perl */ + fclose(rsfp); + #ifndef IAMSUID + execvp("suidperl", origargv); /* try again */ + #endif + fatal("Can't do setuid\n"); + } + + if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid) + seteuid(statbuf.st_uid); /* all that for this */ + else if (uid) /* oops, mustn't run as root */ + seteuid(uid); + if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid()) + setegid(statbuf.st_gid); + euid = (int)geteuid(); + if (!cando(S_IEXEC,TRUE)) + fatal("Permission denied\n"); /* they can't do this */ + } + #ifdef IAMSUID + else if (preprocess) + fatal("-P not allowed for setuid/setgid script\n"); + else + fatal("Script is not setuid/setgid in suidperl\n"); + #endif /* IAMSUID */ + #endif /* DOSUID */ defstab = stabent("_",TRUE); Index: regexp.c Prereq: 2.0 *** regexp.c.old Tue Jun 28 16:41:00 1988 --- regexp.c Tue Jun 28 16:41:02 1988 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regexp.c,v 2.0 88/06/05 00:10:45 root Exp $ * * $Log: regexp.c,v $ * Revision 2.0 88/06/05 00:10:45 root * Baseline version 2.0. * --- 7,18 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regexp.c,v 2.0.1.1 88/06/28 16:37:19 root Exp $ * * $Log: regexp.c,v $ + * Revision 2.0.1.1 88/06/28 16:37:19 root + * patch1: removed redundant debugging code + * * Revision 2.0 88/06/05 00:10:45 root * Baseline version 2.0. * *************** *** 398,408 **** if (len > !(sawstudy)) fbmcompile(r->regmust); *(long*)&r->regmust->str_nval = 100; - #ifdef DEBUGGING - if (debug & 512) - fprintf(stderr,"must = '%s' back=%d\n", - longest,back); - #endif } else str_free(longest); --- 401,406 ---- Index: str.c Prereq: 2.0 *** str.c.old Tue Jun 28 16:41:09 1988 --- str.c Tue Jun 28 16:41:10 1988 *************** *** 1,6 **** ! /* $Header: str.c,v 2.0 88/06/05 00:11:07 root Exp $ * * $Log: str.c,v $ * Revision 2.0 88/06/05 00:11:07 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: str.c,v 2.0.1.1 88/06/28 16:38:11 root Exp $ * * $Log: str.c,v $ + * Revision 2.0.1.1 88/06/28 16:38:11 root + * patch1: autoincrement of '' didn't work right. + * * Revision 2.0 88/06/05 00:11:07 root * Baseline version 2.0. * *************** *** 468,473 **** --- 471,477 ---- if (!str->str_pok || !*str->str_ptr) { str->str_nval = 1.0; str->str_nok = 1; + str->str_pok = 0; return; } d = str->str_ptr; Index: toke.c Prereq: 2.0 *** toke.c.old Tue Jun 28 16:41:16 1988 --- toke.c Tue Jun 28 16:41:18 1988 *************** *** 1,6 **** ! /* $Header: toke.c,v 2.0 88/06/05 00:11:16 root Exp $ * * $Log: toke.c,v $ * Revision 2.0 88/06/05 00:11:16 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: toke.c,v 2.0.1.1 88/06/28 16:39:50 root Exp $ * * $Log: toke.c,v $ + * Revision 2.0.1.1 88/06/28 16:39:50 root + * patch1: tr/x/y/ can dump core if y is shorter than x + * * Revision 2.0 88/06/05 00:11:16 root * Baseline version 2.0. * *************** *** 922,927 **** --- 925,931 ---- register char *r; register char *tbl = safemalloc(256); register int i; + register int j; arg[2].arg_type = A_NULL; arg[2].arg_ptr.arg_cval = tbl; *************** *** 942,951 **** safefree(r); r = t; } ! for (i = 0; t[i]; i++) { ! if (!r[i]) ! r[i] = r[i-1]; ! tbl[t[i] & 0377] = r[i]; } if (r != t) safefree(r); --- 946,955 ---- safefree(r); r = t; } ! for (i = 0, j = 0; t[i]; i++,j++) { ! if (!r[j]) ! --j; ! tbl[t[i] & 0377] = r[j]; } if (r != t) safefree(r);
dave@clsib21.UUCP (David P. Hansen) (07/14/88)
I never received perl 2.0 patch #1. Could someone please email me a copy?
--
ONLY BIG BABIES David P. Hansen, CLSI, Inc.
ARE PRO-CHOICE! 320 Nevada Street
Newtonville, MA 02160
Internet: dave%clsib21.uucp@bbn.com UUCP: {...}bbn!clsib21!davelroot@devvax.JPL.NASA.GOV (The Superuser) (07/15/88)
System: perl version 2.0 Patch #: 1 Priority: MEDIUM Subject: autoincrement of '' didn't work right. Subject: tr/x/y/ can dump core if y is shorter than x Subject: added support for DOSUID Subject: in Configure, fix for machines that can't do #/*undef Subject: in Configure, return code from ar was ignored Subject: in Configure, Cray uses bld instead of ar Subject: in Configure, Gnucpp adds space after symbol interpolation Subject: in Configure, grep '-i' should be grep '\-i' Subject: Configure should remove UU subdirectory entirely Subject: realclean now knows about ~ extension Subject: fixed some quotes in manual page Subject: clarified syntax of LIST in manual page Subject: clarified semantics of study in manual page Subject: added example of y with short second string in manual page Subject: added example of unlink with <*> in manual page Subject: removed redundant debugging code in regexp.c Description: If you used ++ on a variable that had the value '' (as opposed to being undefined) it would increment the numeric part but not invalidate the string part, which could then give false results. Berkeley recently sent out a patch that disables setuid #! scripts because of an inherent problem in the semantics as they are currently defined. If you have installed that patch, your setuid and setgid bits are useless on scripts. I've added a means for perl to examine those bits and emulate setuid/setgid scripts itself in what I believe is a secure manner. If normal perl detects such a script, it passes it off to another version of perl that runs setuid root, and can run the script under the desired uid/gid. This feature is optional, and Configure will ask if you want to do it. Some machines didn't like config.h when it said #/*undef SYMBOL. Config.h.SH now is smart enough to tuck the # inside the comment. There were several small problems in Configure: the return code from ar was hidden by a piped call to sed, so if ar failed it went undetected. The Cray uses a program called bld instead of ar. Let's hear it for compatibility. At least one version of gnucpp adds a space after symbol interpolation, which was giving the C preprocessor detector fits. There was a call to grep '-i' that needed to have the -i protected by a backslash. Also, Configure should remove the UU subdirectory that it makes while running. "make realclean" now knows about the alternate patch extension ~. In the manual page, I fixed some quotes that were ugly in troff, and did some clarification of LIST, study, tr and unlink. regexp.c had some redundant debugging code. tr/x/y/ could dump core if y is shorter than x. I found this out when I tried translating a bunch of characters to space by saying something like y/a-z/ /. 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: Configure make depend make make test make install 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 (hah!) 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: 0 1c1 < #define PATCHLEVEL 0 --- > #define PATCHLEVEL 1 Index: Configure Prereq: 2.0 *** Configure.old Tue Jun 28 16:40:03 1988 --- Configure Tue Jun 28 16:40:04 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 88/06/05 00:07:37 root Exp $ # # 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.1 88/06/28 16:24:02 root Exp $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than *************** *** 76,81 **** --- 76,82 ---- d_bcopy='' d_charsprf='' d_crypt='' + d_dosuid='' d_fchmod='' d_fchown='' d_getgrps='' *************** *** 124,130 **** defvoidused='' privlib='' CONFIG='' - : set package name package=perl --- 125,130 ---- *************** *** 134,140 **** echo " " define='define' ! undef='/*undef' libpth='/usr/lib /usr/local/lib /lib' smallmach='pdp11 i8086 z8000 i80286 iAPX286' rmlist='kit[1-9]isdone kit[1-9][0-9]isdone' --- 134,140 ---- echo " " define='define' ! undef='undef' libpth='/usr/lib /usr/local/lib /lib' smallmach='pdp11 i8086 z8000 i80286 iAPX286' rmlist='kit[1-9]isdone kit[1-9][0-9]isdone' *************** *** 480,490 **** echo " " echo "nm didn't seem to work right." echo "Trying ar instead..." ! if ar t $libc | sed -e 's/\.o$//' > libc.list; then echo "Ok." else ! echo "That didn't work either. Giving up." ! exit 1 fi fi fi --- 480,498 ---- echo " " echo "nm didn't seem to work right." echo "Trying ar instead..." ! rmlist="$rmlist libc.tmp" ! if ar t $libc > libc.tmp; then ! sed -e 's/\.o$//' < libc.tmp > libc.list echo "Ok." else ! echo "ar didn't seem to work right." ! echo "Maybe this is a Cray...trying bld instead..." ! if bld t $libc | sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list; then ! echo "Ok." ! else ! echo "That didn't work either. Giving up." ! exit 1 ! fi fi fi fi *************** *** 621,627 **** EOT echo 'Maybe "'$cpp'" will work...' $cpp <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus=''; --- 629,635 ---- EOT echo 'Maybe "'$cpp'" will work...' $cpp <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus=''; *************** *** 628,634 **** else echo 'Nope, maybe "'$cpp' -" will work...' $cpp - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus='-'; --- 636,642 ---- else echo 'Nope, maybe "'$cpp' -" will work...' $cpp - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, it does." cppstdin="$cpp" cppminus='-'; *************** *** 635,641 **** else echo 'No such luck...maybe "cc -E" will work...' cc -E <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "It works!" cppstdin='cc -E' cppminus=''; --- 643,649 ---- else echo 'No such luck...maybe "cc -E" will work...' cc -E <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "It works!" cppstdin='cc -E' cppminus=''; *************** *** 642,648 **** else echo 'Nixed again...maybe "cc -E -" will work...' cc -E - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, it works! I was beginning to wonder." cppstdin='cc -E' cppminus='-'; --- 650,656 ---- else echo 'Nixed again...maybe "cc -E -" will work...' cc -E - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, it works! I was beginning to wonder." cppstdin='cc -E' cppminus='-'; *************** *** 649,655 **** else echo 'Nope...maybe "cc -P" will work...' cc -P <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus=''; --- 657,663 ---- else echo 'Nope...maybe "cc -P" will work...' cc -P <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus=''; *************** *** 656,662 **** else echo 'Nope...maybe "cc -P -" will work...' cc -P - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus='-'; --- 664,670 ---- else echo 'Nope...maybe "cc -P -" will work...' cc -P - <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Yup, that does." cppstdin='cc -P' cppminus='-'; *************** *** 666,672 **** '') ;; *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;; esac ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, you did! I was beginning to wonder." else echo 'Uh-uh. Time to get fancy...' --- 674,680 ---- '') ;; *) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;; esac ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Hooray, you did! I was beginning to wonder." else echo 'Uh-uh. Time to get fancy...' *************** *** 674,680 **** cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)' cppminus=''; $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "Eureka!." else dflt=blurfl --- 682,688 ---- cppstdin='(cat >/tmp/$$.c; cc -E /tmp/$$.c; rm /tmp/$$.c)' cppminus=''; $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "Eureka!." else dflt=blurfl *************** *** 683,689 **** . myread cppstdin="$ans" $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then echo "OK, that will do." else echo "Sorry, I can't get that to work. Go find one." --- 691,697 ---- . myread cppstdin="$ans" $cppstdin <testcpp.c >testcpp.out 2>&1 ! if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then echo "OK, that will do." else echo "Sorry, I can't get that to work. Go find one." *************** *** 733,738 **** --- 741,777 ---- d_crypt="$undef" fi + : now see if they want to do setuid emulation + case "$d_dosuid" in + '') if bsd; then + dflt=y + else + dflt=n + fi + ;; + *undef*) dflt=n;; + *) dflt=y;; + esac + cat <<EOM + + Some sites have disabled setuid #! scripts because of a bug in the kernel + that prevents them from being secure. If you are on such a system, the + setuid/setgid bits on scripts are currently useless. It is possible for + $package to detect those bits and emulate setuid/setgid in a secure fashion + until a better solution is devised for the kernel problem. + + EOM + rp="Do you want to do setuid/setgid emulation? [$dflt]" + echo $n "$rp $c" + . myread + case "$ans" in + '') $ans="$dflt";; + esac + case "$ans" in + y*) d_dosuid="$define";; + *) d_dosuid="$undef";; + esac + : see if fchmod exists echo " " if $contains '^fchmod$' libc.list >/dev/null 2>&1; then *************** *** 1334,1341 **** *split) case "$split" in '') ! if $contains '-i' $mansrc/ld.1 >/dev/null 2>&1 || \ ! $contains '-i' $mansrc/cc.1 >/dev/null 2>&1; then dflt='-i' else dflt='none' --- 1373,1380 ---- *split) case "$split" in '') ! if $contains '\-i' $mansrc/ld.1 >/dev/null 2>&1 || \ ! $contains '\-i' $mansrc/cc.1 >/dev/null 2>&1; then dflt='-i' else dflt='none' *************** *** 1594,1599 **** --- 1633,1639 ---- d_bcopy='$d_bcopy' d_charsprf='$d_charsprf' d_crypt='$d_crypt' + d_dosuid='$d_dosuid' d_fchmod='$d_fchmod' d_fchown='$d_fchown' d_getgrps='$d_getgrps' *************** *** 1643,1649 **** privlib='$privlib' CONFIG=true EOT ! CONFIG=true echo " " --- 1683,1689 ---- privlib='$privlib' CONFIG=true EOT ! CONFIG=true echo " " *************** *** 1716,1720 **** --- 1756,1763 ---- fi $rm -f kit*isdone + : the following is currently useless cd UU && $rm -f $rmlist + : since this removes it all anyway + cd .. && $rm -rf UU : end of Configure Index: Makefile.SH Prereq: 2.0 *** Makefile.SH.old Tue Jun 28 16:40:14 1988 --- Makefile.SH Tue Jun 28 16:40:15 1988 *************** *** 18,28 **** *) sln='ln';; esac echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0 88/06/05 00:07:54 root Exp $ # # $Log: Makefile.SH,v $ # Revision 2.0 88/06/05 00:07:54 root # Baseline version 2.0. # --- 18,37 ---- *) sln='ln';; esac + case "$d_dosuid" in + *define*) suidperl='suidperl' ;; + *) suidperl='';; + esac + echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0.1.1 88/06/28 16:26:04 root Exp $ # # $Log: Makefile.SH,v $ + # Revision 2.0.1.1 88/06/28 16:26:04 root + # patch1: support for DOSUID + # patch1: realclean now knows about ~ extension + # # Revision 2.0 88/06/05 00:07:54 root # Baseline version 2.0. # *************** *** 42,53 **** SLN = $sln libs = $libnm -lm - !GROK!THIS! ! cat >>Makefile <<'!NO!SUBS!' ! public = perl perldb private = manpages = perl.man perldb.man --- 51,62 ---- SLN = $sln libs = $libnm -lm ! public = perl perldb $suidperl ! !GROK!THIS! + cat >>Makefile <<'!NO!SUBS!' private = manpages = perl.man perldb.man *************** *** 67,73 **** 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 version.o obj = $(obj1) $(obj2) --- 76,82 ---- 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) *************** *** 84,92 **** all: $(public) $(private) $(util) touch all ! perl: $(obj) perl.o ! $(CC) $(LDFLAGS) $(LARGE) $(obj) perl.o $(libs) -o perl perl.c perly.h: perl.y @ echo Expect 37 shift/reduce errors... yacc -d perl.y --- 93,121 ---- all: $(public) $(private) $(util) 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 37 shift/reduce errors... yacc -d perl.y *************** *** 108,117 **** export PATH || exit 1 - mv $(bin)/perl $(bin)/perl.old 2>/dev/null - if test `pwd` != $(bin); then cp $(public) $(bin); fi ! cd $(bin); \ for pub in $(public); do \ chmod +x `basename $$pub`; \ done - test $(bin) = /usr/bin || rm -f /usr/bin/perl - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin chmod +x makedir --- 137,157 ---- export PATH || exit 1 - mv $(bin)/perl $(bin)/perl.old 2>/dev/null - if test `pwd` != $(bin); then cp $(public) $(bin); fi ! - cd $(bin); \ for pub in $(public); do \ chmod +x `basename $$pub`; \ done + !NO!SUBS! + + case "$d_dosuid" in + *define*) + cat >>Makefile <<'!NO!SUBS!' + - chmod 4711 $(bin)/suidperl 2>/dev/null + !NO!SUBS! + ;; + esac + + cat >>Makefile <<'!NO!SUBS!' - test $(bin) = /usr/bin || rm -f /usr/bin/perl - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin chmod +x makedir *************** *** 134,140 **** rm -f *.o realclean: ! rm -f perl *.orig */*.orig *.o core $(addedbyconf) # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. --- 174,180 ---- rm -f *.o realclean: ! rm -f perl *.orig */*.orig *~ */*~ *.o core $(addedbyconf) # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. *************** *** 163,169 **** echo $(sh) | tr ' ' '\012' >.shlist # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE ! $(obj): @ echo "You haven't done a "'"make depend" yet!'; exit 1 makedepend: makedepend.SH /bin/sh makedepend.SH --- 203,209 ---- echo $(sh) | tr ' ' '\012' >.shlist # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE ! perly.o $(obj): @ echo "You haven't done a "'"make depend" yet!'; exit 1 makedepend: makedepend.SH /bin/sh makedepend.SH Index: config.h.SH *** config.h.SH.old Tue Jun 28 16:40:19 1988 --- config.h.SH Tue Jun 28 16:40:20 1988 *************** *** 11,17 **** ;; esac echo "Extracting config.h (with variable substitutions)" ! cat <<!GROK!THIS! >config.h /* config.h * This file was produced by running the config.h.SH script, which * gets its values from config.sh, which is generally produced by --- 11,17 ---- ;; esac echo "Extracting config.h (with variable substitutions)" ! sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!' /* config.h * This file was produced by running the config.h.SH script, which * gets its values from config.sh, which is generally produced by *************** *** 70,75 **** --- 70,90 ---- * to encrypt passwords and the like. */ #$d_crypt CRYPT /**/ + + /* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ + #$d_dosuid DOSUID /**/ /* FCHMOD: * This symbol, if defined, indicates that the fchmod routine is available Index: perl.man.1 Prereq: 2.0 *** perl.man.1.old Tue Jun 28 16:40:27 1988 --- perl.man.1 Tue Jun 28 16:40:29 1988 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl.man.1,v 2.0 88/06/05 00:09:23 root Exp $ ''' ''' $Log: perl.man.1,v $ ''' Revision 2.0 88/06/05 00:09:23 root ''' Baseline version 2.0. ''' --- 1,11 ---- .rn '' }` ! ''' $Header: perl.man.1,v 2.0.1.1 88/06/28 16:28:09 root Exp $ ''' ''' $Log: perl.man.1,v $ + ''' Revision 2.0.1.1 88/06/28 16:28:09 root + ''' patch1: fixed some quotes + ''' patch1: clarified syntax of LIST + ''' ''' Revision 2.0 88/06/05 00:09:23 root ''' Baseline version 2.0. ''' *************** *** 292,298 **** .TP 5 .B \-U allows perl to do unsafe operations. ! Currently the only "unsafe" operation is the unlinking of directories while running as superuser. .TP 5 .B \-v --- 296,302 ---- .TP 5 .B \-U allows perl to do unsafe operations. ! Currently the only \*(L"unsafe\*(R" operation is the unlinking of directories while running as superuser. .TP 5 .B \-v *************** *** 731,738 **** .PP The foreach loop iterates over a normal array value and sets the variable VAR to be each element of the array in turn. ! The "foreach" keyword is actually identical to the "for" keyword, ! so you can use "foreach" for readability or "for" for brevity. If VAR is omitted, $_ is set to each value. If ARRAY is an actual array (as opposed to an expression returning an array value), you can modify each element of the array --- 735,742 ---- .PP The foreach loop iterates over a normal array value and sets the variable VAR to be each element of the array in turn. ! The \*(L"foreach\*(R" keyword is actually identical to the \*(L"for\*(R" keyword, ! so you can use \*(L"foreach\*(R" for readability or \*(L"for\*(R" for brevity. If VAR is omitted, $_ is set to each value. If ARRAY is an actual array (as opposed to an expression returning an array value), you can modify each element of the array *************** *** 909,916 **** (It doesn't become false till the next time the range operator evaluated. It can become false on the same evaluation it became true, but it still returns true once.) ! The right operand is not evaluated while the operator is in the "false" state, ! and the left operand is not evaluated while the operator is in the "true" state. The .. operator is primarily intended for doing line number ranges after the fashion of \fIsed\fR or \fIawk\fR. The precedence is a little lower than || and &&. --- 913,920 ---- (It doesn't become false till the next time the range operator evaluated. It can become false on the same evaluation it became true, but it still returns true once.) ! The right operand is not evaluated while the operator is in the \*(L"false\*(R" state, ! and the left operand is not evaluated while the operator is in the \*(L"true\*(R" state. The .. operator is primarily intended for doing line number ranges after the fashion of \fIsed\fR or \fIawk\fR. The precedence is a little lower than || and &&. *************** *** 1057,1062 **** --- 1061,1067 ---- Such a list can consist of any combination of scalar arguments or arrays; the arrays will be included in the list as if each individual element were interpolated at that point in the list. + Elements of the LIST should be separated by commas. .Ip "/PATTERN/i" 8 4 Searches a string for a pattern, and returns true (1) or false (''). If no string is specified via the =~ or !~ operator, *************** *** 1234,1242 **** If the value of EXPR does not end in a newline, the current script line number and input line number (if any) are also printed, and a newline is supplied. ! Hint: sometimes appending ", stopped" to your message will cause it to make ! better sense when the string "at foo line 123" is appended. ! Suppose you are running script "canasta". .nf .ne 7 --- 1239,1247 ---- If the value of EXPR does not end in a newline, the current script line number and input line number (if any) are also printed, and a newline is supplied. ! Hint: sometimes appending \*(L", stopped\*(R" to your message will cause it to make ! better sense when the string \*(L"at foo line 123\*(R" is appended. ! Suppose you are running script \*(L"canasta\*(R". .nf .ne 7 *************** *** 1267,1273 **** (See the section on subroutines later on.) SUBROUTINE may be a scalar variable, in which case the variable contains the name of the subroutine to execute. ! The parentheses are required to avoid confusion with the next form of "do". .Ip "do EXPR" 8 3 Uses the value of EXPR as a filename and executes the contents of the file as a perl script. --- 1272,1278 ---- (See the section on subroutines later on.) SUBROUTINE may be a scalar variable, in which case the variable contains the name of the subroutine to execute. ! The parentheses are required to avoid confusion with the next form of \*(L"do\*(R". .Ip "do EXPR" 8 3 Uses the value of EXPR as a filename and executes the contents of the file as a perl script. *************** *** 1287,1293 **** call it, so if you are going to use the file inside a loop you might prefer to use #include, at the expense of a little more startup time. (The main problem with #include is that cpp doesn't grok # comments--a ! workaround is to use ";#" for standalone comments.) Note that the following are NOT equivalent: .nf --- 1292,1298 ---- call it, so if you are going to use the file inside a loop you might prefer to use #include, at the expense of a little more startup time. (The main problem with #include is that cpp doesn't grok # comments--a ! workaround is to use \*(L";#\*(R" for standalone comments.) Note that the following are NOT equivalent: .nf Index: perl.man.2 Prereq: 2.0 *** perl.man.2.old Tue Jun 28 16:40:37 1988 --- perl.man.2 Tue Jun 28 16:40:39 1988 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 2.0 88/06/05 00:09:30 root Exp $ ''' ''' $Log: perl.man.2,v $ ''' Revision 2.0 88/06/05 00:09:30 root ''' Baseline version 2.0. ''' --- 1,13 ---- ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 2.0.1.1 88/06/28 16:31:49 root Exp $ ''' ''' $Log: perl.man.2,v $ + ''' Revision 2.0.1.1 88/06/28 16:31:49 root + ''' patch1: fixed some quotes + ''' patch1: clarified semantics of study + ''' patch1: added example of y with short second string + ''' patch1: added example of unlink with <*> + ''' ''' Revision 2.0 88/06/05 00:09:30 root ''' Baseline version 2.0. ''' *************** *** 99,105 **** .Ip "local(LIST)" 8 4 Declares the listed (scalar) variables to be local to the enclosing block, subroutine or eval. ! (The "do 'filename';" operator also counts as an eval.) This operator works by saving the current values of those variables in LIST on a hidden stack and restoring them upon exiting the block, subroutine or eval. The LIST may be assigned to if desired, which allows you to initialize --- 105,111 ---- .Ip "local(LIST)" 8 4 Declares the listed (scalar) variables to be local to the enclosing block, subroutine or eval. ! (The \*(L"do 'filename';\*(R" operator also counts as an eval.) This operator works by saving the current values of those variables in LIST on a hidden stack and restoring them upon exiting the block, subroutine or eval. The LIST may be assigned to if desired, which allows you to initialize *************** *** 226,232 **** .fi You may also, in the Bourne shell tradition, specify an EXPR beginning ! with ">&", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. Here is a script that saves, redirects, and restores stdout and stdin: --- 232,238 ---- .fi You may also, in the Bourne shell tradition, specify an EXPR beginning ! with \*(L">&\*(R", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. Here is a script that saves, redirects, and restores stdout and stdin: *************** *** 256,262 **** print stderr "stderr 2\en"; .fi ! If you open a pipe on the command "-", i.e. either "|-" or "-|", then there is an implicit fork done, and the return value of open is the pid of the child within the parent process, and 0 within the child process. --- 262,268 ---- print stderr "stderr 2\en"; .fi ! If you open a pipe on the command \*(L"-\*(R", i.e. either \*(L"|-\*(R" or \*(L"-|\*(R", then there is an implicit fork done, and the return value of open is the pid of the child within the parent process, and 0 within the child process. *************** *** 304,310 **** To set the default output channel to something other than stdout use the select operation. .Ip "printf FILEHANDLE LIST" 8 9 .Ip "printf LIST" 8 ! Equivalent to a "print FILEHANDLE sprintf(LIST)". .Ip "push(ARRAY,LIST)" 8 7 Treats ARRAY (@ is optional) as a stack, and pushes the values of LIST onto the end of ARRAY. --- 310,316 ---- To set the default output channel to something other than stdout use the select operation. .Ip "printf FILEHANDLE LIST" 8 9 .Ip "printf LIST" 8 ! Equivalent to a \*(L"print FILEHANDLE sprintf(LIST)\*(R". .Ip "push(ARRAY,LIST)" 8 7 Treats ARRAY (@ is optional) as a stack, and pushes the values of LIST onto the end of ARRAY. *************** *** 559,569 **** Takes extra time to study SCALAR ($_ if unspecified) in anticipation of doing many pattern matches on the string before it is next modified. This may or may not save time, depending on the nature and number of patterns ! you are searching on\*(--you probably want to compare runtimes with and without it to see which runs faster. Those loops which scan for many short constant strings (including the constant parts of more complex patterns) will benefit most. ! For example, a loop which inserts index producing entries before an line containing a certain pattern: .nf --- 565,583 ---- Takes extra time to study SCALAR ($_ if unspecified) in anticipation of doing many pattern matches on the string before it is next modified. This may or may not save time, depending on the nature and number of patterns ! you are searching on, and on the distribution of character frequencies in ! the string to be searched\*(--you probably want to compare runtimes with and without it to see which runs faster. Those loops which scan for many short constant strings (including the constant parts of more complex patterns) will benefit most. ! (The way study works is this: a linked list of every character in the string ! to be searched is made, so we know, for example, where all the `k' characters ! are. ! From each search string, the rarest character is selected, based on some ! static frequency tables constructed from some C programs and English text. ! Only those places that contain this \*(L"rarest\*(R" character are examined.) ! .Sp ! For example, here is a loop which inserts index producing entries before an line containing a certain pattern: .nf *************** *** 578,583 **** --- 592,628 ---- } .fi + In searching for /\ebfoo\eb/, only those locations in $_ that contain `f' + will be looked at, because `f' is rarer than `o'. + In general, this is a big win except in pathological cases. + The only question is whether it saves you more time than it took to build + the linked list in the first place. + .Sp + Note that if you have to look for strings that you don't know till runtime, + you can build an entire loop as a string and eval that to avoid recompiling + all your patterns all the time. + Together with setting $/ to input entire files as one record, this can + be very fast, often faster than specialized programs like fgrep. + The following scans a list of files (@files) + for a list of words (@words), and prints out the names of those files that + contain a match: + .nf + + .ne 12 + $search = 'while (<>) { study;'; + foreach $word (@words) { + $search .= "\e++$seen{\e$ARGV} if /\eb$word\eb/;\en"; + } + $search .= "}"; + @ARGV = @files; + $/ = "\e177"; # something that doesn't occur + eval $search; # this screams + $/ = "\en"; # put back to normal input delim + foreach $file (sort keys(seen)) { + print $file,"\en"; + } + + .fi .Ip "substr(EXPR,OFFSET,LEN)" 8 2 Extracts a substring out of EXPR and returns it. First character is at offset 0, or whatever you've set $[ to. *************** *** 639,644 **** --- 684,691 ---- ($HOST = $host) =~ tr/a-z/A-Z/; + y/\e001-@[-_{-\e177/ /; \h'|3i'# change non-alphas to space + .fi .Ip "umask(EXPR)" 8 3 Sets the umask for the process and returns the old one. *************** *** 650,655 **** --- 697,703 ---- .ne 2 $cnt = unlink 'a','b','c'; unlink @goners; + unlink <*.bak>; .fi Note: unlink will not delete directories unless you are superuser and the \-U *************** *** 671,677 **** modification times, in that order. Returns the number of files successfully changed. The inode modification time of each file is set to the current time. ! Example of a "touch" command: .nf .ne 3 --- 719,725 ---- modification times, in that order. Returns the number of files successfully changed. The inode modification time of each file is set to the current time. ! Example of a \*(L"touch\*(R" command: .nf .ne 3 *************** *** 769,775 **** that is ($_[0], $_[1], .\|.\|.). The return value of the subroutine is the value of the last expression evaluated. ! To create local variables see the "local" operator. .PP A subroutine is called using the .I do --- 817,823 ---- that is ($_[0], $_[1], .\|.\|.). The return value of the subroutine is the value of the last expression evaluated. ! To create local variables see the \*(L"local\*(R" operator. .PP A subroutine is called using the .I do *************** *** 830,836 **** those supplied in the Version 8 regexp routines. (In fact, the routines are derived from Henry Spencer's freely redistributable reimplementation of the V8 routines.) ! In addition, \ew matches an alphanumeric character (including "_") and \eW a nonalphanumeric. Word boundaries may be matched by \eb, and non-boundaries by \eB. A whitespace character is matched by \es, non-whitespace by \eS. A numeric character is matched by \ed, non-numeric by \eD. --- 878,884 ---- those supplied in the Version 8 regexp routines. (In fact, the routines are derived from Henry Spencer's freely redistributable reimplementation of the V8 routines.) ! In addition, \ew matches an alphanumeric character (including \*(L"_\*(R") and \eW a nonalphanumeric. Word boundaries may be matched by \eb, and non-boundaries by \eB. A whitespace character is matched by \es, non-whitespace by \eS. A numeric character is matched by \ed, non-numeric by \eD. *************** *** 1011,1017 **** The following names have special meaning to .IR perl . I could have used alphabetic symbols for some of these, but I didn't want ! to take the chance that someone would say reset "a-zA-Z" and wipe them all out. You'll just have to suffer along with these silly symbols. Most of them have reasonable mnemonics, or analogues in one of the shells. --- 1059,1065 ---- The following names have special meaning to .IR perl . I could have used alphabetic symbols for some of these, but I didn't want ! to take the chance that someone would say reset \*(L"a-zA-Z\*(R" and wipe them all out. You'll just have to suffer along with these silly symbols. Most of them have reasonable mnemonics, or analogues in one of the shells. *************** *** 1167,1173 **** .Ip $@ 8 2 The error message from the last eval command. If null, the last eval parsed and executed correctly. ! (Mnemonic: Where was the syntax error "at"?) .Ip $< 8 2 The real uid of this process. (Mnemonic: it's the uid you came FROM, if you're running setuid.) --- 1215,1221 ---- .Ip $@ 8 2 The error message from the last eval command. If null, the last eval parsed and executed correctly. ! (Mnemonic: Where was the syntax error \*(L"at\*(R"?) .Ip $< 8 2 The real uid of this process. (Mnemonic: it's the uid you came FROM, if you're running setuid.) *************** *** 1206,1214 **** See $0 for the command name. .Ip @INC 8 3 The array INC contains the list of places to look for perl scripts to be ! evaluated by the "do EXPR" command. It initially consists of the arguments to any -I command line switches, followed ! by the default perl library, probably "/usr/local/lib/perl". .Ip $ENV{expr} 8 2 The associative array ENV contains your current environment. Setting a value in ENV changes the environment for child processes. --- 1254,1262 ---- See $0 for the command name. .Ip @INC 8 3 The array INC contains the list of places to look for perl scripts to be ! evaluated by the \*(L"do EXPR\*(R" command. It initially consists of the arguments to any -I command line switches, followed ! by the default perl library, probably \*(L"/usr/local/lib/perl\*(R". .Ip $ENV{expr} 8 2 The associative array ENV contains your current environment. Setting a value in ENV changes the environment for child processes. Index: perly.c Prereq: 2.0 *** perly.c.old Tue Jun 28 16:40:49 1988 --- perly.c Tue Jun 28 16:40:51 1988 *************** *** 1,6 **** ! char rcsid[] = "$Header: perly.c,v 2.0 88/06/05 00:09:56 root Exp $"; /* * $Log: perly.c,v $ * Revision 2.0 88/06/05 00:09:56 root * Baseline version 2.0. * --- 1,9 ---- ! char rcsid[] = "$Header: perly.c,v 2.0.1.1 88/06/28 16:36:49 root Exp $"; /* * $Log: perly.c,v $ + * Revision 2.0.1.1 88/06/28 16:36:49 root + * patch1: added DOSUID code + * * Revision 2.0 88/06/05 00:09:56 root * Baseline version 2.0. * *************** *** 26,31 **** --- 29,38 ---- register char *s; char *index(), *strcpy(), *getenv(); bool dosearch = FALSE; + #ifdef DOSUID + char **origargv = argv; + char *validarg = ""; + #endif uid = (int)getuid(); euid = (int)geteuid(); *************** *** 36,50 **** for (argc--,argv++; argc; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; reswitch: ! switch (argv[0][1]) { case 'a': minus_a = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; #ifdef DEBUGGING case 'D': ! debug = atoi(argv[0]+2); #ifdef YYDEBUG yydebug = (debug & 1); #endif --- 43,64 ---- for (argc--,argv++; argc; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; + #ifdef DOSUID + if (*validarg) + validarg = " PHOOEY "; + else + validarg = argv[0]; + #endif + s = argv[0]+1; reswitch: ! switch (*s) { case 'a': minus_a = TRUE; ! s++; goto reswitch; #ifdef DEBUGGING case 'D': ! debug = atoi(s+1); #ifdef YYDEBUG yydebug = (debug & 1); #endif *************** *** 62,75 **** argc--,argv++; break; case 'i': ! inplace = savestr(argv[0]+2); argvoutstab = stabent("ARGVOUT",TRUE); break; case 'I': ! str_cat(str,argv[0]); str_cat(str," "); ! if (argv[0][2]) { ! apush(incstab->stab_array,str_make(argv[0]+2)); } else { apush(incstab->stab_array,str_make(argv[1])); --- 76,90 ---- argc--,argv++; break; case 'i': ! inplace = savestr(s+1); argvoutstab = stabent("ARGVOUT",TRUE); break; case 'I': ! str_cat(str,"-"); ! str_cat(str,s); str_cat(str," "); ! if (s[1]) { ! apush(incstab->stab_array,str_make(s+1)); } else { apush(incstab->stab_array,str_make(argv[1])); *************** *** 80,106 **** break; case 'n': minus_n = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'p': minus_p = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'P': preprocess = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 's': doswitches = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'S': dosearch = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'U': unsafe = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case 'v': version(); --- 95,121 ---- break; case 'n': minus_n = TRUE; ! s++; goto reswitch; case 'p': minus_p = TRUE; ! s++; goto reswitch; case 'P': preprocess = TRUE; ! s++; goto reswitch; case 's': doswitches = TRUE; ! s++; goto reswitch; case 'S': dosearch = TRUE; ! s++; goto reswitch; case 'U': unsafe = TRUE; ! s++; goto reswitch; case 'v': version(); *************** *** 107,113 **** exit(0); case 'w': dowarn = TRUE; ! strcpy(argv[0], argv[0]+1); goto reswitch; case '-': argc--,argv++; --- 122,128 ---- exit(0); case 'w': dowarn = TRUE; ! s++; goto reswitch; case '-': argc--,argv++; *************** *** 115,121 **** case 0: break; default: ! fatal("Unrecognized switch: %s",argv[0]); } } switch_end: --- 130,136 ---- case 0: break; default: ! fatal("Unrecognized switch: -%s",s); } } switch_end: *************** *** 186,191 **** --- 201,210 ---- -e 's/^#.*//' \ %s | %s -C %s %s", argv[0], CPPSTDIN, str_get(str), CPPMINUS); + #ifdef IAMSUID + if (euid != uid && !euid) /* if running suidperl */ + seteuid(uid); /* musn't stay setuid root */ + #endif rsfp = popen(buf,"r"); } else if (!*argv[0]) *************** *** 192,200 **** rsfp = stdin; else rsfp = fopen(argv[0],"r"); ! if (rsfp == Nullfp) fatal("Perl script \"%s\" doesn't seem to exist",filename); str_free(str); /* free -I directories */ defstab = stabent("_",TRUE); --- 211,302 ---- rsfp = stdin; else rsfp = fopen(argv[0],"r"); ! if (rsfp == Nullfp) { ! #ifdef DOSUID ! #ifndef IAMSUID ! if (euid && stat(filename,&statbuf) >= 0 && ! statbuf.st_mode & (S_ISUID|S_ISGID)) { ! execvp("suidperl", origargv); /* try again */ ! fatal("Can't do setuid\n"); ! } ! #endif ! #endif fatal("Perl script \"%s\" doesn't seem to exist",filename); + } str_free(str); /* free -I directories */ + + /* do we need to emulate setuid on scripts? */ + + /* This code is for those BSD systems that have setuid #! scripts disabled + * in the kernel because of a security problem. Merely defining DOSUID + * in perl will not fix that problem, but if you have disabled setuid + * scripts in the kernel, this will attempt to emulate setuid and setgid + * on scripts that have those now-otherwise-useless bits set. The setuid + * root version must be called suidperl. If regular perl discovers that + * it has opened a setuid script, it calls suidperl with the same argv + * that it had. If suidperl finds that the script it has just opened + * is NOT setuid root, it sets the effective uid back to the uid. We + * don't just make perl setuid root because that loses the effective + * uid we had before invoking perl, if it was different from the uid. + * + * DOSUID must be defined in both perl and suidperl, and IAMSUID must + * be defined in suidperl only. suidperl must be setuid root. The + * Configure script will set this up for you if you want it. + */ + #ifdef DOSUID + if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ + fatal("Can't stat script \"%s\"",filename); + if (statbuf.st_mode & (S_ISUID|S_ISGID)) { + int len; + + if (access(filename,1)) /* as a double check */ + fatal("Permission denied"); + if ((statbuf.st_mode & S_IFMT) != S_IFREG) + fatal("Permission denied"); + doswitches = FALSE; /* -s is insecure in suid */ + line++; + if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch || + strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */ + fatal("No #! line"); + for (s = tokenbuf+2; !isspace(*s); s++) ; + if (strnNE(s-4,"perl",4)) /* sanity check */ + fatal("Not a perl script"); + while (*s && isspace(*s)) s++; + /* + * #! arg must be what we saw above. They can invoke it by + * mentioning suidperl explicitly, but they may not add any strange + * arguments beyond what #! says if they do invoke suidperl that way. + */ + len = strlen(validarg); + if (strEQ(validarg," PHOOEY ") || + strnNE(s,validarg,len) || !isspace(s[len])) + fatal("Arg must be \"%s\"\n",s); + + if (euid) { /* oops, we're not the setuid root perl */ + fclose(rsfp); + #ifndef IAMSUID + execvp("suidperl", origargv); /* try again */ + #endif + fatal("Can't do setuid\n"); + } + + if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid) + seteuid(statbuf.st_uid); /* all that for this */ + else if (uid) /* oops, mustn't run as root */ + seteuid(uid); + if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid()) + setegid(statbuf.st_gid); + euid = (int)geteuid(); + if (!cando(S_IEXEC,TRUE)) + fatal("Permission denied\n"); /* they can't do this */ + } + #ifdef IAMSUID + else if (preprocess) + fatal("-P not allowed for setuid/setgid script\n"); + else + fatal("Script is not setuid/setgid in suidperl\n"); + #endif /* IAMSUID */ + #endif /* DOSUID */ defstab = stabent("_",TRUE); Index: regexp.c Prereq: 2.0 *** regexp.c.old Tue Jun 28 16:41:00 1988 --- regexp.c Tue Jun 28 16:41:02 1988 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regexp.c,v 2.0 88/06/05 00:10:45 root Exp $ * * $Log: regexp.c,v $ * Revision 2.0 88/06/05 00:10:45 root * Baseline version 2.0. * --- 7,18 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regexp.c,v 2.0.1.1 88/06/28 16:37:19 root Exp $ * * $Log: regexp.c,v $ + * Revision 2.0.1.1 88/06/28 16:37:19 root + * patch1: removed redundant debugging code + * * Revision 2.0 88/06/05 00:10:45 root * Baseline version 2.0. * *************** *** 398,408 **** if (len > !(sawstudy)) fbmcompile(r->regmust); *(long*)&r->regmust->str_nval = 100; - #ifdef DEBUGGING - if (debug & 512) - fprintf(stderr,"must = '%s' back=%d\n", - longest,back); - #endif } else str_free(longest); --- 401,406 ---- Index: str.c Prereq: 2.0 *** str.c.old Tue Jun 28 16:41:09 1988 --- str.c Tue Jun 28 16:41:10 1988 *************** *** 1,6 **** ! /* $Header: str.c,v 2.0 88/06/05 00:11:07 root Exp $ * * $Log: str.c,v $ * Revision 2.0 88/06/05 00:11:07 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: str.c,v 2.0.1.1 88/06/28 16:38:11 root Exp $ * * $Log: str.c,v $ + * Revision 2.0.1.1 88/06/28 16:38:11 root + * patch1: autoincrement of '' didn't work right. + * * Revision 2.0 88/06/05 00:11:07 root * Baseline version 2.0. * *************** *** 468,473 **** --- 471,477 ---- if (!str->str_pok || !*str->str_ptr) { str->str_nval = 1.0; str->str_nok = 1; + str->str_pok = 0; return; } d = str->str_ptr; Index: toke.c Prereq: 2.0 *** toke.c.old Tue Jun 28 16:41:16 1988 --- toke.c Tue Jun 28 16:41:18 1988 *************** *** 1,6 **** ! /* $Header: toke.c,v 2.0 88/06/05 00:11:16 root Exp $ * * $Log: toke.c,v $ * Revision 2.0 88/06/05 00:11:16 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: toke.c,v 2.0.1.1 88/06/28 16:39:50 root Exp $ * * $Log: toke.c,v $ + * Revision 2.0.1.1 88/06/28 16:39:50 root + * patch1: tr/x/y/ can dump core if y is shorter than x + * * Revision 2.0 88/06/05 00:11:16 root * Baseline version 2.0. * *************** *** 922,927 **** --- 925,931 ---- register char *r; register char *tbl = safemalloc(256); register int i; + register int j; arg[2].arg_type = A_NULL; arg[2].arg_ptr.arg_cval = tbl; *************** *** 942,951 **** safefree(r); r = t; } ! for (i = 0; t[i]; i++) { ! if (!r[i]) ! r[i] = r[i-1]; ! tbl[t[i] & 0377] = r[i]; } if (r != t) safefree(r); --- 946,955 ---- safefree(r); r = t; } ! for (i = 0, j = 0; t[i]; i++,j++) { ! if (!r[j]) ! --j; ! tbl[t[i] & 0377] = r[j]; } if (r != t) safefree(r);
jv@mhres.mh.nl (Johan Vromans) (07/17/88)
Several people are asking "where is perl 2.0 patch #1". Due to posting delays, Patch #1 to Perl 2.0 appeared in comp.sources.bugs BEFORE the Perl sources arrived in comp.sources.unix. So look in your archives, it should be there. -- Johan
igp@camcon.uucp (Ian Phillipps) (07/19/88)
From article <690@clsib21.UUCP>, by dave@clsib21.UUCP (David P. Hansen):
> I never received perl 2.0 patch #1. Could someone please email me a copy?
Nor here. Repost? Post?
--
UUCP: ...!ukc!camcon!igp | Cambridge Consultants Ltd | Ian Phillipps
or: igp@camcon.uucp | Science Park, Milton Road |-----------------
Phone: +44 223 358855 | Cambridge CB4 4DW, England |