# 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 $
+# $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
d_bcopy=''
d_charsprf=''
d_crypt=''
+d_dosuid=''
d_fchmod=''
d_fchown=''
d_getgrps=''
defvoidused=''
privlib=''
CONFIG=''
-
: set package name
package=perl
echo " "
define='define'
-undef='/*undef'
+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'
echo " "
echo "nm didn't seem to work right."
echo "Trying ar instead..."
- if ar t $libc | sed -e 's/\.o$//' > libc.list; then
+ rmlist="$rmlist libc.tmp"
+ if ar t $libc > libc.tmp; then
+ sed -e 's/\.o$//' < libc.tmp > libc.list
echo "Ok."
else
- echo "That didn't work either. Giving up."
- exit 1
+ 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
EOT
echo 'Maybe "'$cpp'" will work...'
$cpp <testcpp.c >testcpp.out 2>&1
-if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
+if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "Yup, it does."
cppstdin="$cpp"
cppminus='';
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
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "Yup, it does."
cppstdin="$cpp"
cppminus='-';
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
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "It works!"
cppstdin='cc -E'
cppminus='';
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
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "Hooray, it works! I was beginning to wonder."
cppstdin='cc -E'
cppminus='-';
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
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "Yup, that does."
cppstdin='cc -P'
cppminus='';
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
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "Yup, that does."
cppstdin='cc -P'
cppminus='-';
'') ;;
*) $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1;;
esac
- if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
+ 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...'
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
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
echo "Eureka!."
else
dflt=blurfl
. myread
cppstdin="$ans"
$cppstdin <testcpp.c >testcpp.out 2>&1
- if $contains 'abc.xyz' testcpp.out >/dev/null 2>&1 ; then
+ 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."
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
*split)
case "$split" in
'')
- if $contains '-i' $mansrc/ld.1 >/dev/null 2>&1 || \
- $contains '-i' $mansrc/cc.1 >/dev/null 2>&1; then
+ 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'
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'
privlib='$privlib'
CONFIG=true
EOT
-
+
CONFIG=true
echo " "
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
*) 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 88/06/05 00:07:54 root Exp $
+# $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.
#
SLN = $sln
libs = $libnm -lm
-!GROK!THIS!
-cat >>Makefile <<'!NO!SUBS!'
+public = perl perldb $suidperl
-public = perl perldb
+!GROK!THIS!
+cat >>Makefile <<'!NO!SUBS!'
private =
manpages = perl.man perldb.man
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
+obj2 = regexp.o stab.o str.o toke.o util.o version.o
obj = $(obj1) $(obj2)
all: $(public) $(private) $(util)
touch all
-perl: $(obj) perl.o
- $(CC) $(LDFLAGS) $(LARGE) $(obj) perl.o $(libs) -o perl
+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...
export PATH || exit 1
- mv $(bin)/perl $(bin)/perl.old 2>/dev/null
- if test `pwd` != $(bin); then cp $(public) $(bin); fi
- cd $(bin); \
+ - 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
rm -f *.o
realclean:
- rm -f perl *.orig */*.orig *.o core $(addedbyconf)
+ 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.
echo $(sh) | tr ' ' '\012' >.shlist
# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
-$(obj):
+perly.o $(obj):
@ echo "You haven't done a "'"make depend" yet!'; exit 1
makedepend: makedepend.SH
/bin/sh makedepend.SH
;;
esac
echo "Extracting config.h (with variable substitutions)"
-cat <<!GROK!THIS! >config.h
+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
*/
#$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
* to change mode of opened files. If unavailable, use chmod().
-#define PATCHLEVEL 0
+#define PATCHLEVEL 1
.rn '' }`
-''' $Header: perl.man.1,v 2.0 88/06/05 00:09:23 root Exp $
+''' $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.
'''
.TP 5
.B \-U
allows perl to do unsafe operations.
-Currently the only "unsafe" operation is the unlinking of directories while
+Currently the only \*(L"unsafe\*(R" operation is the unlinking of directories while
running as superuser.
.TP 5
.B \-v
.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.
+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
(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 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 &&.
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,
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".
+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
(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".
+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.
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.)
+workaround is to use \*(L";#\*(R" for standalone comments.)
Note that the following are NOT equivalent:
.nf
''' Beginning of part 2
-''' $Header: perl.man.2,v 2.0 88/06/05 00:09:30 root Exp $
+''' $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.
'''
.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.)
+(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
.fi
You may also, in the Bourne shell tradition, specify an EXPR beginning
-with ">&", in which case the rest of the string
+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:
print stderr "stderr 2\en";
.fi
-If you open a pipe on the command "-", i.e. either "|-" or "-|",
+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.
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)".
+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.
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
+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.
-For example, a loop which inserts index producing entries before an line
+(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
}
.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.
($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.
.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
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:
+Example of a \*(L"touch\*(R" command:
.nf
.ne 3
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.
+To create local variables see the \*(L"local\*(R" operator.
.PP
A subroutine is called using the
.I do
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.
+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.
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
+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.
.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"?)
+(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.)
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.
+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 "/usr/local/lib/perl".
+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.
-char rcsid[] = "$Header: perly.c,v 2.0 88/06/05 00:09:56 root Exp $";
+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.
*
register char *s;
char *index(), *strcpy(), *getenv();
bool dosearch = FALSE;
+#ifdef DOSUID
+ char **origargv = argv;
+ char *validarg = "";
+#endif
uid = (int)getuid();
euid = (int)geteuid();
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 (argv[0][1]) {
+ switch (*s) {
case 'a':
minus_a = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
#ifdef DEBUGGING
case 'D':
- debug = atoi(argv[0]+2);
+ debug = atoi(s+1);
#ifdef YYDEBUG
yydebug = (debug & 1);
#endif
argc--,argv++;
break;
case 'i':
- inplace = savestr(argv[0]+2);
+ inplace = savestr(s+1);
argvoutstab = stabent("ARGVOUT",TRUE);
break;
case 'I':
- str_cat(str,argv[0]);
+ str_cat(str,"-");
+ str_cat(str,s);
str_cat(str," ");
- if (argv[0][2]) {
- apush(incstab->stab_array,str_make(argv[0]+2));
+ if (s[1]) {
+ apush(incstab->stab_array,str_make(s+1));
}
else {
apush(incstab->stab_array,str_make(argv[1]));
break;
case 'n':
minus_n = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case 'p':
minus_p = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case 'P':
preprocess = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case 's':
doswitches = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case 'S':
dosearch = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case 'U':
unsafe = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case 'v':
version();
exit(0);
case 'w':
dowarn = TRUE;
- strcpy(argv[0], argv[0]+1);
+ s++;
goto reswitch;
case '-':
argc--,argv++;
case 0:
break;
default:
- fatal("Unrecognized switch: %s",argv[0]);
+ fatal("Unrecognized switch: -%s",s);
}
}
switch_end:
-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])
rsfp = stdin;
else
rsfp = fopen(argv[0],"r");
- if (rsfp == Nullfp)
+ 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);
/* init tokener */
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexp.c,v 2.0 88/06/05 00:10:45 root Exp $
+/* $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.
*
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);
-/* $Header: str.c,v 2.0 88/06/05 00:11:07 root Exp $
+/* $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.
*
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;
-/* $Header: toke.c,v 2.0 88/06/05 00:11:16 root Exp $
+/* $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.
*
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;
safefree(r);
r = t;
}
- for (i = 0; t[i]; i++) {
- if (!r[i])
- r[i] = r[i-1];
- tbl[t[i] & 0377] = r[i];
+ for (i = 0, j = 0; t[i]; i++,j++) {
+ if (!r[j])
+ --j;
+ tbl[t[i] & 0377] = r[j];
}
if (r != t)
safefree(r);
projects / p5sagit/p5-mst-13.2.git / commitdiff