summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xConfigure17
-rw-r--r--lib/perldb.pl19
-rw-r--r--lib/pwd.pl6
-rw-r--r--patchlevel.h2
-rw-r--r--perl.man.121
-rw-r--r--perl.man.212
-rw-r--r--perl.man.326
-rw-r--r--perl.man.418
-rw-r--r--perl.y7
-rw-r--r--perly.c62
-rw-r--r--stab.c9
-rw-r--r--str.c24
-rw-r--r--toke.c20
-rw-r--r--util.c12
-rw-r--r--x2p/s2p.SH6
15 files changed, 192 insertions, 69 deletions
diff --git a/Configure b/Configure
index a1bdeb41f2..f40c802da2 100755
--- a/Configure
+++ b/Configure
@@ -8,7 +8,7 @@
# 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 3.0.1.13 91/01/11 17:01:32 lwall Locked $
+# $Header: Configure,v 3.0.1.14 91/01/11 21:56:38 lwall Locked $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
@@ -1321,15 +1321,16 @@ main()
exit(result);
}
EOCP
-if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then
- d_castneg="$define"
- castflags=0
+$cc -o try $ccflags try.c >/dev/null 2>&1 && ./try
+castflags=$?
+case "$castflags" in
+0) d_castneg="$define"
echo "Yup, it does."
-else
- d_castneg="$undef"
- castflags=$?
+ ;;
+*) d_castneg="$undef"
echo "Nope, it doesn't."
-fi
+ ;;
+esac
$rm -f try.*
: see how we invoke the C preprocessor
diff --git a/lib/perldb.pl b/lib/perldb.pl
index c86fb16506..4c2f54d499 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -1,6 +1,6 @@
package DB;
-$header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $';
+$header = '$Header: perldb.pl,v 3.0.1.6 91/01/11 18:08:58 lwall Locked $';
#
# This file is automatically included if you do perl -d.
# It's probably not useful to include this yourself.
@@ -10,6 +10,9 @@ $header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $';
# have a breakpoint. It also inserts a do 'perldb.pl' before the first line.
#
# $Log: perldb.pl,v $
+# Revision 3.0.1.6 91/01/11 18:08:58 lwall
+# patch42: @_ couldn't be accessed from debugger
+#
# Revision 3.0.1.5 90/11/10 01:40:26 lwall
# patch38: the debugger wouldn't stop correctly or do action routines
#
@@ -62,7 +65,7 @@ sub DB {
$signal |= 1;
}
else {
- &eval("\$DB'signal |= do {$stop;}");
+ $evalarg = "\$DB'signal |= do {$stop;}"; &eval;
$dbline{$line} =~ s/;9($|\0)/$1/;
}
}
@@ -74,9 +77,9 @@ sub DB {
print OUT "$sub($filename:$i):\t",$dbline[$i];
}
}
- &eval($action) if $action;
+ $evalarg = $action, &eval if $action;
if ($single || $signal) {
- &eval($pre) if $pre;
+ $evalarg = $pre, &eval if $pre;
print OUT $#stack . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
@@ -452,11 +455,11 @@ command Execute as a perl statement in current package.
};
};
next; };
- &eval($cmd);
+ $evalarg = $cmd; &eval;
print OUT "\n";
}
if ($post) {
- &eval($post);
+ $evalarg = $post; &eval;
}
}
($@, $!, $[, $,, $/, $\) = @saved;
@@ -467,8 +470,10 @@ sub save {
$[ = 0; $, = ""; $/ = "\n"; $\ = "";
}
+# The following takes its argument via $evalarg to preserve current @_
+
sub eval {
- eval "$usercontext $_[0]; &DB'save";
+ eval "$usercontext $evalarg; &DB'save";
print OUT $@;
}
diff --git a/lib/pwd.pl b/lib/pwd.pl
index c141e9888e..7abcc1f97d 100644
--- a/lib/pwd.pl
+++ b/lib/pwd.pl
@@ -1,8 +1,11 @@
;# pwd.pl - keeps track of current working directory in PWD environment var
;#
-;# $Header: pwd.pl,v 3.0.1.1 90/08/09 04:01:24 lwall Locked $
+;# $Header: pwd.pl,v 3.0.1.2 91/01/11 18:09:24 lwall Locked $
;#
;# $Log: pwd.pl,v $
+;# Revision 3.0.1.2 91/01/11 18:09:24 lwall
+;# patch42: some .pl files were missing their trailing 1;
+;#
;# Revision 3.0.1.1 90/08/09 04:01:24 lwall
;# patch19: Initial revision
;#
@@ -46,3 +49,4 @@ sub main'chdir {
}
}
+1;
diff --git a/patchlevel.h b/patchlevel.h
index 64b1306a8b..760709b84a 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 43
+#define PATCHLEVEL 44
diff --git a/perl.man.1 b/perl.man.1
index 9a24089704..fdc606c215 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,10 @@
.rn '' }`
-''' $Header: perl_man.1,v 3.0.1.10 90/11/10 01:45:16 lwall Locked $
+''' $Header: perl_man.1,v 3.0.1.11 91/01/11 18:15:46 lwall Locked $
'''
''' $Log: perl.man.1,v $
+''' Revision 3.0.1.11 91/01/11 18:15:46 lwall
+''' patch42: added -0 option
+'''
''' Revision 3.0.1.10 90/11/10 01:45:16 lwall
''' patch38: random cleanup
'''
@@ -180,6 +183,22 @@ only allows one argument. Example:
.fi
Options include:
.TP 5
+.BI \-0 digits
+specifies the record separator ($/) as an octal number.
+If there are no digits, the null character is the separator.
+Other switches may precede or follow the digits.
+For example, if you have a version of
+.I find
+which can print filenames terminated by the null character, you can say this:
+.nf
+
+ find . \-name '*.bak' \-print0 | perl \-n0e unlink
+
+.fi
+The special value 00 will cause Perl to slurp files in paragraph mode.
+The value 0777 will cause Perl to slurp files whole since there is no
+legal character with that value.
+.TP 5
.B \-a
turns on autosplit mode when used with a
.B \-n
diff --git a/perl.man.2 b/perl.man.2
index b9c37ef313..a6ab6a1a86 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,10 @@
''' Beginning of part 2
-''' $Header: perl_man.2,v 3.0.1.10 90/11/10 01:46:29 lwall Locked $
+''' $Header: perl_man.2,v 3.0.1.11 91/01/11 18:17:08 lwall Locked $
'''
''' $Log: perl.man.2,v $
+''' Revision 3.0.1.11 91/01/11 18:17:08 lwall
+''' patch42: fixed some man page entries
+'''
''' Revision 3.0.1.10 90/11/10 01:46:29 lwall
''' patch38: random cleanup
''' patch38: added alarm function
@@ -88,8 +91,8 @@ Only one timer may be counting at once. Each call disables the previous
timer, and an argument of 0 may be supplied to cancel the previous timer
without starting a new one.
The returned value is the amount of time remaining on the previous timer.
-.Ip "atan2(X,Y)" 8 2
-Returns the arctangent of X/Y in the range
+.Ip "atan2(Y,X)" 8 2
+Returns the arctangent of Y/X in the range
.if t \-\(*p to \(*p.
.if n \-PI to PI.
.Ip "bind(SOCKET,NAME)" 8 2
@@ -653,6 +656,7 @@ the filehandle.
.Ip "flock(FILEHANDLE,OPERATION)" 8 4
Calls flock(2) on FILEHANDLE.
See manual page for flock(2) for definition of OPERATION.
+Returns true for success, false on failure.
Will produce a fatal error if used on a machine that doesn't implement
flock(2).
Here's a mailbox appender for BSD systems.
@@ -957,7 +961,7 @@ Here is yet another way to print your environment:
@keys = keys %ENV;
@values = values %ENV;
while ($#keys >= 0) {
- print pop(keys), \'=\', pop(values), "\en";
+ print pop(@keys), \'=\', pop(@values), "\en";
}
or how about sorted by key:
diff --git a/perl.man.3 b/perl.man.3
index be1cc72e2b..d4574ebd69 100644
--- a/perl.man.3
+++ b/perl.man.3
@@ -1,7 +1,10 @@
''' Beginning of part 3
-''' $Header: perl_man.3,v 3.0.1.11 90/11/10 01:48:21 lwall Locked $
+''' $Header: perl_man.3,v 3.0.1.12 91/01/11 18:18:15 lwall Locked $
'''
''' $Log: perl.man.3,v $
+''' Revision 3.0.1.12 91/01/11 18:18:15 lwall
+''' patch42: added binary and hex pack/unpack options
+'''
''' Revision 3.0.1.11 90/11/10 01:48:21 lwall
''' patch38: random cleanup
''' patch38: documented tr///cds
@@ -291,17 +294,24 @@ of values, as follows:
X Back up a byte.
@ Null fill to absolute position.
u A uuencoded string.
+ b A bit string (ascending bit order, like vec()).
+ B A bit string (descending bit order).
+ h A hex string (low nybble first).
+ H A hex string (high nybble first).
.fi
Each letter may optionally be followed by a number which gives a repeat
count.
-With all types except "a" and "A" the pack function will gobble up that many values
+With all types except "a", "A", "b", "B", "h" and "H",
+the pack function will gobble up that many values
from the LIST.
A * for the repeat count means to use however many items are left.
The "a" and "A" types gobble just one value, but pack it as a string of length
count,
padding with nulls or spaces as necessary.
(When unpacking, "A" strips trailing spaces and nulls, but "a" does not.)
+Likewise, the "b" and "B" fields pack a string that many bits long.
+The "h" and "H" fields pack a string that many nybbles long.
Real numbers (floats and doubles) are in the native machine format
only; due to the multiplicity of floating formats around, and the lack
of a standard \*(L"network\*(R" representation, no facility for
@@ -342,6 +352,9 @@ Examples:
$foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
+ sub bintodec {
+ unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
+ }
.fi
The same template may generally also be used in the unpack function.
.Ip "pipe(READHANDLE,WRITEHANDLE)" 8 3
@@ -1358,6 +1371,15 @@ which will assume a bit vector operation is desired when both operands are
strings.
This interpretation is not enabled unless there is at least one vec() in
your program, to protect older programs.
+.Sp
+To transform a bit vector into a string or array of 0's and 1's, use these:
+.nf
+
+ $bits = unpack("b*", $vector);
+ @bits = split(//, unpack("b*", $vector));
+
+.fi
+If you know the exact length in bits, it can be used in place of the *.
.Ip "wait" 8 6
Waits for a child process to terminate and returns the pid of the deceased
process, or -1 if there are no child processes.
diff --git a/perl.man.4 b/perl.man.4
index 7100e80a22..54ddff5248 100644
--- a/perl.man.4
+++ b/perl.man.4
@@ -1,7 +1,10 @@
''' Beginning of part 4
-''' $Header: perl_man.4,v 3.0.1.13 90/11/10 01:51:00 lwall Locked $
+''' $Header: perl_man.4,v 3.0.1.14 91/01/11 18:18:53 lwall Locked $
'''
''' $Log: perl.man.4,v $
+''' Revision 3.0.1.14 91/01/11 18:18:53 lwall
+''' patch42: started an addendum and errata section in the man page
+'''
''' Revision 3.0.1.13 90/11/10 01:51:00 lwall
''' patch38: random cleanup
'''
@@ -407,6 +410,7 @@ with multiple <, >, or | characters to specify, respectively, left justification
right justification, or centering.
As an alternate form of right justification,
you may also use # characters (with an optional .) to specify a numeric field.
+(Use of ^ instead of @ causes the field to be blanked if undefined.)
If any of the values supplied for these fields contains a newline, only
the text up to the newline is printed.
The special field @* can be used for printing multi-line values.
@@ -1556,6 +1560,18 @@ compiles the whole program before executing it.
The arguments are available via @ARGV, not $1, $2, etc.
.Ip * 4 2
The environment is not automatically made available as variables.
+.SH ERRATA\0AND\0ADDENDA
+The Perl book,
+.I Programming\0Perl ,
+has the following omissions and goofs.
+.PP
+The
+.B \-0
+switch was added to Perl after the book went to press.
+.PP
+The new @###.## format was omitted accidentally.
+.PP
+It wasn't known at press time that s///ee caused multiple evaluations.
.SH BUGS
.PP
.I Perl
diff --git a/perl.y b/perl.y
index 5c5b4a4796..b3e7512948 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.10 91/01/11 18:14:28 lwall Locked $
+/* $Header: perl.y,v 3.0.1.11 91/01/11 21:57:40 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
+ * Revision 3.0.1.11 91/01/11 21:57:40 lwall
+ * patch42: addendum
+ *
* Revision 3.0.1.10 91/01/11 18:14:28 lwall
* patch42: package didn't create symbol tables that could be reset
* patch42: split with no arguments could wipe out next operator
@@ -672,7 +675,7 @@ term : '-' term %prec UMINUS
| SPLIT %prec '('
{ static char p[]="/\\s+/";
char *oldend = bufend;
- int oldarg = yylval.arg;
+ ARG *oldarg = yylval.arg;
bufend=p+5;
(void)scanpat(p);
diff --git a/perly.c b/perly.c
index 08aa11f10f..87acead688 100644
--- a/perly.c
+++ b/perly.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.10 91/01/11 18:22:48 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,11 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPat
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.10 91/01/11 18:22:48 lwall
+ * patch42: added -0 option
+ * patch42: ANSIfied the stat mode checking
+ * patch42: executables for multiple versions may now coexist
+ *
* Revision 3.0.1.9 90/11/10 01:53:26 lwall
* patch38: random cleanup
* patch38: more msdos/os2 upgrades
@@ -82,6 +87,7 @@ static char* moreswitches();
static char* cddir;
extern char **environ;
static bool minus_c;
+static char patchlevel[6];
main(argc,argv,env)
register int argc;
@@ -110,6 +116,7 @@ setuid perl scripts securely.\n");
euid = (int)geteuid();
gid = (int)getgid();
egid = (int)getegid();
+ sprintf(patchlevel,"%3.3s%2.2d", rcsid+19, PATCHLEVEL);
#ifdef MSDOS
/*
* There is no way we can refer to them from Perl so close them to save
@@ -147,6 +154,7 @@ setuid perl scripts securely.\n");
s = argv[0]+1;
reswitch:
switch (*s) {
+ case '0':
case 'a':
case 'c':
case 'd':
@@ -287,8 +295,8 @@ setuid perl scripts securely.\n");
#endif
if (stat(tokenbuf,&statbuf) < 0) /* not there? */
continue;
- if ((statbuf.st_mode & S_IFMT) == S_IFREG
- && cando(S_IREAD,TRUE,&statbuf) && cando(S_IEXEC,TRUE,&statbuf)) {
+ if (S_ISREG(statbuf.st_mode)
+ && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
xfound = tokenbuf; /* bingo! */
break;
}
@@ -303,7 +311,7 @@ setuid perl scripts securely.\n");
}
fdpid = anew(Nullstab); /* for remembering popen pids by fd */
- pidstatus = hnew(Nullstab); /* for remembering status of dead pids */
+ pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
origfilename = savestr(argv[0]);
curcmd->c_filestab = fstab(origfilename);
@@ -360,7 +368,7 @@ setuid perl scripts securely.\n");
#ifndef IAMSUID /* in case script is not readable before setuid */
if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
statbuf.st_mode & (S_ISUID|S_ISGID)) {
- (void)sprintf(buf, "%s/%s", BIN, "suidperl");
+ (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
execv(buf, origargv); /* try again */
fatal("Can't do setuid\n");
}
@@ -378,12 +386,13 @@ setuid perl scripts securely.\n");
* 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.
+ * root version must be called suidperl or sperlN.NNN. 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
@@ -394,7 +403,7 @@ setuid perl scripts securely.\n");
* on these set-id scripts, but don't want to have the overhead of
* them in normal perl, and can't use suidperl because it will lose
* the effective uid info, so we have an additional non-setuid root
- * version called taintperl that just does the TAINT checks.
+ * version called taintperl or tperlN.NNN that just does the TAINT checks.
*/
#ifdef DOSUID
@@ -445,15 +454,15 @@ setuid perl scripts securely.\n");
}
if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
fatal("Can't reswap uid and euid");
- if (!cando(S_IEXEC,FALSE,&statbuf)) /* can real uid exec? */
+ if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */
fatal("Permission denied\n");
}
#endif /* SETREUID */
#endif /* IAMSUID */
- if ((statbuf.st_mode & S_IFMT) != S_IFREG)
+ if (!S_ISREG(statbuf.st_mode))
fatal("Permission denied");
- if ((statbuf.st_mode >> 6) & S_IWRITE)
+ if (statbuf.st_mode & S_IWOTH)
fatal("Setuid/gid script is writable by world");
doswitches = FALSE; /* -s is insecure in suid */
curcmd->c_line++;
@@ -463,7 +472,7 @@ setuid perl scripts securely.\n");
s = tokenbuf+2;
if (*s == ' ') s++;
while (!isspace(*s)) s++;
- if (strnNE(s-4,"perl",4)) /* sanity check */
+ if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
fatal("Not a perl script");
while (*s == ' ' || *s == '\t') s++;
/*
@@ -487,7 +496,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
if (euid) { /* oops, we're not the setuid root perl */
(void)fclose(rsfp);
#ifndef IAMSUID
- (void)sprintf(buf, "%s/%s", BIN, "suidperl");
+ (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
execv(buf, origargv); /* try again */
#endif
fatal("Can't do setuid\n");
@@ -529,7 +538,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
euid = (int)geteuid();
gid = (int)getgid();
egid = (int)getegid();
- if (!cando(S_IEXEC,TRUE,&statbuf))
+ if (!cando(S_IXUSR,TRUE,&statbuf))
fatal("Permission denied\n"); /* they can't do this */
}
#ifdef IAMSUID
@@ -542,7 +551,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
/* script has a wrapper--can't run suidperl or we lose euid */
else if (euid != uid || egid != gid) {
(void)fclose(rsfp);
- (void)sprintf(buf, "%s/%s", BIN, "taintperl");
+ (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
execv(buf, origargv); /* try again */
fatal("Can't run setuid script with taint checks");
}
@@ -563,7 +572,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
/* not set-id, must be wrapped */
(void)fclose(rsfp);
- (void)sprintf(buf, "%s/%s", BIN, "taintperl");
+ (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
execv(buf, origargv); /* try again */
fatal("Can't run setuid script with taint checks");
}
@@ -677,9 +686,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
if (tmpstab = stabent("]",allstabs)) {
str = STAB_STR(tmpstab);
str_set(str,rcsid);
- strncpy(tokenbuf,rcsid+19,3);
- sprintf(tokenbuf+3,"%2.2d",PATCHLEVEL);
- str->str_u.str_nval = atof(tokenbuf);
+ str->str_u.str_nval = atof(patchlevel);
str->str_nok = 1;
}
str_nset(stab_val(stabent("\"", TRUE)), " ", 1);
@@ -1024,6 +1031,15 @@ char *s;
{
reswitch:
switch (*s) {
+ case '0':
+ record_separator = 0;
+ if (s[1] == '0' && !isdigit(s[2]))
+ rslen = 0;
+ while (*s >= '0' && *s <= '7') {
+ record_separator <<= 3;
+ record_separator += *s++ & 7;
+ }
+ return s;
case 'a':
minus_a = TRUE;
s++;
diff --git a/stab.c b/stab.c
index 481a5042d8..8900e7f8c9 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 3.0.1.10 90/11/10 02:02:05 lwall Locked $
+/* $Header: stab.c,v 3.0.1.11 91/01/11 18:23:44 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 3.0.1.11 91/01/11 18:23:44 lwall
+ * patch42: added -0 option
+ *
* Revision 3.0.1.10 90/11/10 02:02:05 lwall
* patch38: random cleanup
*
@@ -170,7 +173,7 @@ STR *str;
break;
#endif
case '/':
- if (record_separator != 12345) {
+ if (record_separator != 0777) {
*tokenbuf = record_separator;
tokenbuf[1] = '\0';
str_nset(stab_val(stab),tokenbuf,rslen);
@@ -401,7 +404,7 @@ STR *str;
rslen = str->str_cur;
}
else {
- record_separator = 12345; /* fake a non-existent char */
+ record_separator = 0777; /* fake a non-existent char */
rslen = 1;
}
break;
diff --git a/str.c b/str.c
index e392cee728..7ec76fe906 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0.1.11 90/11/13 15:27:14 lwall Locked $
+/* $Header: str.c,v 3.0.1.12 91/01/11 18:26:54 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,11 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.12 91/01/11 18:26:54 lwall
+ * patch42: s/^foo/bar/ occasionally brought on core dumps
+ * patch42: undid unwarranted assumptions about memcmp() return value
+ * patch42: ('a' .. 'z') could lose its value in a loop
+ *
* Revision 3.0.1.11 90/11/13 15:27:14 lwall
* patch41: fixed a couple of malloc/free problems
*
@@ -285,8 +290,14 @@ register STR *sstr;
sstr->str_pok = 0; /* wipe out any weird flags */
sstr->str_state = 0; /* so sstr frees uneventfully */
}
- else /* have to copy actual string */
+ else { /* have to copy actual string */
+ if (dstr->str_ptr) {
+ if (dstr->str_state == SS_INCR) {
+ Str_Grow(dstr,0);
+ }
+ }
str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+ }
if (dstr->str_nok = sstr->str_nok)
dstr->str_u.str_nval = sstr->str_u.str_nval;
else {
@@ -738,12 +749,12 @@ register STR *str2;
if (str1->str_cur < str2->str_cur) {
if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
- return retval;
+ return retval < 0 ? -1 : 1;
else
return -1;
}
else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
- return retval;
+ return retval < 0 ? -1 : 1;
else if (str1->str_cur == str2->str_cur)
return 0;
else
@@ -804,6 +815,7 @@ int append;
if (get_paragraph && oldbp)
obpx = oldbp - str->str_ptr;
bpx = bp - str->str_ptr; /* prepare for possible relocation */
+ str->str_cur = bpx;
STR_GROW(str, str->str_len + append + cnt + 2);
bp = str->str_ptr + bpx; /* reconstitute our pointer */
if (get_paragraph && oldbp)
@@ -1373,8 +1385,10 @@ register STR *old;
if (new->str_ptr)
Safefree(new->str_ptr);
Copy(old,new,1,STR);
- if (old->str_ptr)
+ if (old->str_ptr) {
new->str_ptr = nsavestr(old->str_ptr,old->str_len);
+ new->str_pok &= ~SP_TEMP;
+ }
return new;
}
diff --git a/toke.c b/toke.c
index 5f1ccd043a..e3f3c73db6 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 3.0.1.11 90/11/10 02:13:44 lwall Locked $
+/* $Header: toke.c,v 3.0.1.12 91/01/11 18:31:45 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,10 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.12 91/01/11 18:31:45 lwall
+ * patch42: eval'ed formats without proper termination blew up
+ * patch42: whitespace now allowed after terminating . of format
+ *
* Revision 3.0.1.11 90/11/10 02:13:44 lwall
* patch38: added alarm function
* patch38: tr was busted in metacharacters on signed char machines
@@ -2341,7 +2345,7 @@ load_format()
Zero(&froot, 1, FCMD);
s = bufptr;
- while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
+ while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
curcmd->c_line++;
if (in_eval && !rsfp) {
eol = index(s,'\n');
@@ -2356,9 +2360,12 @@ load_format()
str_nset(tmpstr, s, eol-s);
astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
}
- if (strnEQ(s,".\n",2)) {
- bufptr = s;
- return froot.f_next;
+ if (*s == '.') {
+ for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+ if (*t == '\n') {
+ bufptr = s;
+ return froot.f_next;
+ }
}
if (*s == '#') {
s = eol;
@@ -2456,7 +2463,8 @@ load_format()
}
if (flinebeg) {
again:
- if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
+ if (s >= bufend &&
+ (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
goto badform;
curcmd->c_line++;
if (in_eval && !rsfp) {
diff --git a/util.c b/util.c
index de8f122593..b14069411d 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0.1.10 90/11/10 02:19:28 lwall Locked $
+/* $Header: util.c,v 3.0.1.11 91/01/11 18:33:10 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,10 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: util.c,v $
+ * Revision 3.0.1.11 91/01/11 18:33:10 lwall
+ * patch42: die could exit with 0 value on some machines
+ * patch42: Configure checks typecasting behavior better
+ *
* Revision 3.0.1.10 90/11/10 02:19:28 lwall
* patch38: random cleanup
* patch38: sequence of s/^x//; s/x$//; could screw up malloc
@@ -855,7 +859,7 @@ long a1, a2, a3, a4;
if (e_fp)
(void)UNLINK(e_tmpname);
statusvalue >>= 8;
- exit(errno?errno:(statusvalue?statusvalue:255));
+ exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
}
/*VARARGS1*/
@@ -959,7 +963,7 @@ va_dcl
if (e_fp)
(void)UNLINK(e_tmpname);
statusvalue >>= 8;
- exit((int)(errno?errno:(statusvalue?statusvalue:255)));
+ exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
}
/*VARARGS0*/
@@ -1458,7 +1462,7 @@ double f;
{
long along;
-#ifdef mips
+#if CASTFLAGS & 2
# define BIGDOUBLE 2147483648.0
if (f >= BIGDOUBLE)
return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
diff --git a/x2p/s2p.SH b/x2p/s2p.SH
index 9898dcf6a0..36eab5e11e 100644
--- a/x2p/s2p.SH
+++ b/x2p/s2p.SH
@@ -7,6 +7,7 @@ case $CONFIG in
'')
if test ! -f config.sh; then
ln ../config.sh . || \
+ ln -s ../config.sh . || \
ln ../../config.sh . || \
ln ../../../config.sh . || \
(echo "Can't find config.sh."; exit 1)
@@ -28,9 +29,12 @@ $spitshell >s2p <<!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'
-# $Header: s2p.SH,v 3.0.1.6 90/10/20 02:21:43 lwall Locked $
+# $Header: s2p.SH,v 3.0.1.7 91/01/11 18:36:44 lwall Locked $
#
# $Log: s2p.SH,v $
+# Revision 3.0.1.7 91/01/11 18:36:44 lwall
+# patch42: x2p/s2p.SH blew up on /afs misfeature
+#
# Revision 3.0.1.6 90/10/20 02:21:43 lwall
# patch37: changed some ". config.sh" to ". ./config.sh"
#