perl 2.0 patch #1 (REPOST)
The Superuser
lroot at devvax.JPL.NASA.GOV
Fri Jul 15 19:01:50 AEST 1988
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 at jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 2.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.8.43).
Index: patchlevel.h
Prereq: 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);
More information about the Comp.sources.bugs
mailing list