summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1992-06-08 04:51:08 +0000
committerLarry Wall <lwall@netlabs.com>1992-06-08 04:51:08 +0000
commit83025b217962b0369a18edad3fa14dc1087f3c2a (patch)
tree36468918bed135500627ad32184c14ca2c6cb7fa
parentee0007abcec11102eeaa49662e5ebb838e04aac6 (diff)
downloadperl-83025b217962b0369a18edad3fa14dc1087f3c2a.tar.gz
perl 4.0 patch 29: patch #20, continued
See patch #20.
-rw-r--r--atarist/perldb.diff179
-rw-r--r--atarist/perlglob.c45
-rw-r--r--atarist/test/printenv16
-rw-r--r--hints/solaris_2_0.sh1
-rw-r--r--lib/perldb.pl34
-rw-r--r--os2/perlglob.cs6
-rw-r--r--os2/perlglob.def3
-rw-r--r--os2/popen.c12
-rw-r--r--patchlevel.h2
-rw-r--r--perl.c174
-rw-r--r--perl.man165
11 files changed, 528 insertions, 109 deletions
diff --git a/atarist/perldb.diff b/atarist/perldb.diff
new file mode 100644
index 0000000000..9bd5c87f9c
--- /dev/null
+++ b/atarist/perldb.diff
@@ -0,0 +1,179 @@
+*** ../../../lib/perldb.pl Mon Nov 11 10:40:22 1991
+--- perldb.pl Mon May 18 17:00:56 1992
+***************
+*** 1,10 ****
+ package DB;
+
+! # modified Perl debugger, to be run from Emacs in perldb-mode
+! # Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+! # Johan Vromans -- upgrade to 4.0 pl 10
+!
+! $header = '$RCSfile: perldb.diff,v $$Revision: 4.0.1.1 $$Date: 92/06/08 11:50:28 $';
+ #
+ # This file is automatically included if you do perl -d.
+ # It's probably not useful to include this yourself.
+--- 1,6 ----
+ package DB;
+
+! $header = '$RCSfile: perldb.diff,v $$Revision: 4.0.1.1 $$Date: 92/06/08 11:50:28 $';
+ #
+ # This file is automatically included if you do perl -d.
+ # It's probably not useful to include this yourself.
+***************
+*** 14,22 ****
+ # have a breakpoint. It also inserts a do 'perldb.pl' before the first line.
+ #
+ # $Log: perldb.diff,v $
+ # Revision 4.0.1.1 92/06/08 11:50:28 lwall
+ # Initial revision
+ #
+- # Revision 4.0.1.2 91/11/05 17:55:58 lwall
+- # patch11: perldb.pl modified to run within emacs in perldb-mode
+- #
+ # Revision 4.0.1.1 91/06/07 11:17:44 lwall
+ # patch4: added $^P variable to control calling of perldb routines
+ # patch4: debugger sometimes listed wrong number of lines for a statement
+--- 10,15 ----
+***************
+*** 56,63 ****
+ #
+ #
+
+! open(IN, "</dev/tty") || open(IN, "<&STDIN"); # so we don't dingle stdin
+! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout
+ select(OUT);
+ $| = 1; # for DB'OUT
+ select(STDOUT);
+--- 49,56 ----
+ #
+ #
+
+! open(IN, "</dev/console") || open(IN, "<&STDIN"); # so we don't dingle stdin
+! open(OUT,">/dev/console") || open(OUT, ">&STDOUT"); # so we don't dongle stdout
+ select(OUT);
+ $| = 1; # for DB'OUT
+ select(STDOUT);
+***************
+*** 64,79 ****
+ $| = 1; # for real STDOUT
+ $sub = '';
+
+- # Is Perl being run from Emacs?
+- $emacs = $main'ARGV[$[] eq '-emacs';
+- shift(@main'ARGV) if $emacs;
+-
+ $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+! print OUT "\nLoading DB routines from $header\n";
+! print OUT ("Emacs support ",
+! $emacs ? "enabled" : "available",
+! ".\n");
+! print OUT "\nEnter h for help.\n\n";
+
+ sub DB {
+ &save;
+--- 57,64 ----
+ $| = 1; # for real STDOUT
+ $sub = '';
+
+ $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+! print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n";
+
+ sub DB {
+ &save;
+***************
+*** 93,107 ****
+ }
+ }
+ if ($single || $trace || $signal) {
+! if ($emacs) {
+! print OUT "\032\032$filename:$line:0\n";
+! } else {
+! print OUT "$package'" unless $sub =~ /'/;
+! print OUT "$sub($filename:$line):\t",$dbline[$line];
+! for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
+! last if $dbline[$i] =~ /^\s*(}|#|\n)/;
+! print OUT "$sub($filename:$i):\t",$dbline[$i];
+! }
+ }
+ }
+ $evalarg = $action, &eval if $action;
+--- 78,88 ----
+ }
+ }
+ if ($single || $trace || $signal) {
+! print OUT "$package'" unless $sub =~ /'/;
+! print OUT "$sub($filename:$line):\t",$dbline[$line];
+! for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
+! last if $dbline[$i] =~ /^\s*(;|}|#|\n)/;
+! print OUT "$sub($filename:$i):\t",$dbline[$i];
+ }
+ }
+ $evalarg = $action, &eval if $action;
+***************
+*** 263,276 ****
+ $i = $2;
+ $i = $line if $i eq '.';
+ $i = 1 if $i < 1;
+! if ($emacs) {
+! print OUT "\032\032$filename:$i:0\n";
+! $i = $end;
+! } else {
+! for (; $i <= $end; $i++) {
+! print OUT "$i:\t", $dbline[$i];
+! last if $signal;
+! }
+ }
+ $start = $i; # remember in case they want more
+ $start = $max if $start > $max;
+--- 244,252 ----
+ $i = $2;
+ $i = $line if $i eq '.';
+ $i = 1 if $i < 1;
+! for (; $i <= $end; $i++) {
+! print OUT "$i:\t", $dbline[$i];
+! last if $signal;
+ }
+ $start = $i; # remember in case they want more
+ $start = $max if $start > $max;
+***************
+*** 417,427 ****
+ $start = 1 if ($start > $max);
+ last if ($start == $end);
+ if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+! if ($emacs) {
+! print OUT "\032\032$filename:$start:0\n";
+! } else {
+! print OUT "$start:\t", $dbline[$start], "\n";
+! }
+ last;
+ }
+ } ';
+--- 393,399 ----
+ $start = 1 if ($start > $max);
+ last if ($start == $end);
+ if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+! print OUT "$start:\t", $dbline[$start], "\n";
+ last;
+ }
+ } ';
+***************
+*** 445,455 ****
+ $start = $max if ($start <= 0);
+ last if ($start == $end);
+ if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+! if ($emacs) {
+! print OUT "\032\032$filename:$start:0\n";
+! } else {
+! print OUT "$start:\t", $dbline[$start], "\n";
+! }
+ last;
+ }
+ } ';
+--- 417,423 ----
+ $start = $max if ($start <= 0);
+ last if ($start == $end);
+ if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+! print OUT "$start:\t", $dbline[$start], "\n";
+ last;
+ }
+ } ';
diff --git a/atarist/perlglob.c b/atarist/perlglob.c
new file mode 100644
index 0000000000..002639ede2
--- /dev/null
+++ b/atarist/perlglob.c
@@ -0,0 +1,45 @@
+/*
+ * glob and echo any globbed args
+ *
+ * ++jrb bammi@cadence.com
+ */
+
+#include <stdio.h>
+
+#if __STDC__
+# include <compiler.h>
+#else
+# define __PROTO(X) ()
+#endif
+
+char **glob __PROTO((char *patt, int decend_dir));
+int contains_wild __PROTO((char *patt));
+void free_all __PROTO((void));
+
+
+int main(argc, argv)
+int argc;
+char **argv;
+{
+ --argc; ++argv;
+ while(argc--)
+ {
+ char *word = *argv;
+ char **list;
+ int did_some = 0;
+
+ if(contains_wild(word) && (list = glob(word, 0)))
+ {
+ while(*list)
+ {
+ fputs(*list, stdout);
+ if(*++list) putchar(' ');
+ }
+ free_all();
+ did_some = 1;
+ }
+ if(*++argv && did_some) putchar(' ');
+ }
+ putchar('\0');
+ return 0;
+}
diff --git a/atarist/test/printenv b/atarist/test/printenv
new file mode 100644
index 0000000000..6c2619ae49
--- /dev/null
+++ b/atarist/test/printenv
@@ -0,0 +1,16 @@
+$exit = 0;
+$\ = "\n";
+if($#ARGV >= 0) {
+ foreach (@ARGV) {
+ if(defined $ENV{$_}) {
+ print $ENV{$_};
+ } else {
+ $exit = 1;
+ }
+ }
+} else {
+ foreach (sort keys %ENV) {
+ print $_, '=', $ENV{$_};
+ }
+}
+exit $exit;
diff --git a/hints/solaris_2_0.sh b/hints/solaris_2_0.sh
new file mode 100644
index 0000000000..8eae5de276
--- /dev/null
+++ b/hints/solaris_2_0.sh
@@ -0,0 +1 @@
+d_vfork='undef'
diff --git a/lib/perldb.pl b/lib/perldb.pl
index 917469b492..8cfc36c32d 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -4,7 +4,7 @@ package DB;
# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
# Johan Vromans -- upgrade to 4.0 pl 10
-$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:55:58 $';
+$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:43:57 $';
#
# This file is automatically included if you do perl -d.
# It's probably not useful to include this yourself.
@@ -14,6 +14,10 @@ $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:55:58 $
# have a breakpoint. It also inserts a do 'perldb.pl' before the first line.
#
# $Log: perldb.pl,v $
+# Revision 4.0.1.3 92/06/08 13:43:57 lwall
+# patch20: support for MSDOS folded into perldb.pl
+# patch20: perldb couldn't debug file containing '-', such as STDIN designator
+#
# Revision 4.0.1.2 91/11/05 17:55:58 lwall
# patch11: perldb.pl modified to run within emacs in perldb-mode
#
@@ -56,8 +60,17 @@ $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:55:58 $
#
#
-open(IN, "</dev/tty") || open(IN, "<&STDIN"); # so we don't dingle stdin
-open(OUT,">/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout
+if (-e "/dev/tty") {
+ $console = "/dev/tty";
+ $rcfile=".perldb";
+}
+else {
+ $console = "con";
+ $rcfile="perldb.ini";
+}
+
+open(IN, "<$console") || open(IN, "<&STDIN"); # so we don't dingle stdin
+open(OUT,">$console") || open(OUT, ">&STDOUT"); # so we don't dongle stdout
select(OUT);
$| = 1; # for DB'OUT
select(STDOUT);
@@ -304,7 +317,8 @@ command Execute as a perl statement in current package.
$cond = $2 || '1';
$subname = "$package'" . $subname unless $subname =~ /'/;
$subname = "main" . $subname if substr($subname,0,1) eq "'";
- ($filename,$i) = split(/[:-]/, $sub{$subname});
+ ($filename,$i) = split(/:/, $sub{$subname});
+ $i += 0;
if ($i) {
*dbline = "_<$filename";
++$i while $dbline[$i] == 0 && $i < $#dbline;
@@ -568,14 +582,14 @@ for (@args) {
s/(.*)/'$1'/ unless /^-?[\d.]+$/;
}
-if (-f '.perldb') {
- do './.perldb';
+if (-f $rcfile) {
+ do "./$rcfile";
}
-elsif (-f "$ENV{'LOGDIR'}/.perldb") {
- do "$ENV{'LOGDIR'}/.perldb";
+elsif (-f "$ENV{'LOGDIR'}/$rcfile") {
+ do "$ENV{'LOGDIR'}/$rcfile";
}
-elsif (-f "$ENV{'HOME'}/.perldb") {
- do "$ENV{'HOME'}/.perldb";
+elsif (-f "$ENV{'HOME'}/$rcfile") {
+ do "$ENV{'HOME'}/$rcfile";
}
1;
diff --git a/os2/perlglob.cs b/os2/perlglob.cs
index 7f58c6058f..b5fc1c99b2 100644
--- a/os2/perlglob.cs
+++ b/os2/perlglob.cs
@@ -1,9 +1,9 @@
os2\glob.c
-(-DPERLGLOB os2\director.c)
setargv.obj
-os2\perlglob.def
-os2\perlglob.bad
+
+os2\perl.def
+os2\perl.bad
perlglob.exe
-AS -LB -S0x1000
diff --git a/os2/perlglob.def b/os2/perlglob.def
index 52bddd1b00..a14bc63f16 100644
--- a/os2/perlglob.def
+++ b/os2/perlglob.def
@@ -1,2 +1 @@
-NAME PERLGLOB WINDOWCOMPAT NEWFILES
-DESCRIPTION 'Filename globbing for PERL - for MS-DOS and OS/2'
+(deprecated)
diff --git a/os2/popen.c b/os2/popen.c
index 15c11122d0..b9522b5671 100644
--- a/os2/popen.c
+++ b/os2/popen.c
@@ -65,7 +65,7 @@ FILE *mypopen(char *cmd, char *mode)
if ( _osmode == DOS_MODE )
return dos_popen(cmd, mode);
- if (DosMakePipe((PHFILE) &p[0], (PHFILE) &p[1], 4096) < 0)
+ if ( _pipe(p, 4096, 0) )
return NULL;
myside = tst(p[WRITEH], p[READH]);
@@ -124,7 +124,7 @@ int pipe(int *filedes)
{
int res;
- if ( res = DosMakePipe((PHFILE) &filedes[0], (PHFILE) &filedes[1], 4096) )
+ if ( res = _pipe(filedes, 4096, 0) )
return res;
DosSetFHandState(filedes[0], OPEN_FLAGS_NOINHERIT);
@@ -149,6 +149,7 @@ static FILE *dos_popen(const char *command, const char *mode)
{
FILE *current;
char name[128];
+ char *tmp = getenv("TMP");
int cur;
pipemode curmode;
@@ -165,8 +166,11 @@ static FILE *dos_popen(const char *command, const char *mode)
/*
** get a name to use.
*/
- strcpy(name, "piXXXXXX");
- Mktemp(name);
+ strcpy(name, tmp ? tmp : "\\");
+ if ( name[strlen(name) - 1] != '\\' )
+ strcat(name, "\\");
+ strcat(name, "piXXXXXX");
+ mktemp(name);
/*
** If we're reading, just call system to get a file filled with
diff --git a/patchlevel.h b/patchlevel.h
index afbe4bd0c7..46afcbbb08 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 28
+#define PATCHLEVEL 29
diff --git a/perl.c b/perl.c
index f93095de24..7a41d2bf7d 100644
--- a/perl.c
+++ b/perl.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45 $\nPatch level: ###\n";
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.7 $$Date: 92/06/08 14:50:39 $\nPatch level: ###\n";
/*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,17 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45
* License or the Artistic License, as specified in the README file.
*
* $Log: perl.c,v $
+ * Revision 4.0.1.7 92/06/08 14:50:39 lwall
+ * patch20: PERLLIB now supports multiple directories
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ * patch20: -e 'cmd' no longer fails silently if /tmp runs out of space
+ * patch20: perl -P now uses location of sed determined by Configure
+ * patch20: form feed for formats is now specifiable via $^L
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: eval "1 #comment" didn't work
+ * patch20: couldn't require . files
+ * patch20: semantic compilation errors didn't abort execution
+ *
* Revision 4.0.1.6 91/11/11 16:38:45 lwall
* patch19: default arg for shift was wrong after first subroutine definition
* patch19: op/regexp.t failed from missing arg to bcmp()
@@ -44,11 +55,7 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45
#include "EXTERN.h"
#include "perl.h"
#include "perly.h"
-#ifdef MSDOS
-#include "patchlev.h"
-#else
#include "patchlevel.h"
-#endif
char *getenv();
@@ -65,6 +72,7 @@ char *getenv();
#endif
static char* moreswitches();
+static void incpush();
static char* cddir;
static bool minus_c;
static char patchlevel[6];
@@ -117,6 +125,12 @@ setuid perl scripts securely.\n");
loop_ptr = -1; /* start label stack again */
goto just_doit;
}
+#ifdef TAINT
+#ifndef DOSUID
+ if (uid == euid && gid == egid)
+ taintanyway == TRUE; /* running taintperl explicitly */
+#endif
+#endif
(void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
linestr = Str_new(65,80);
str_nset(linestr,"",0);
@@ -164,6 +178,8 @@ setuid perl scripts securely.\n");
if (!e_fp) {
e_tmpname = savestr(TMPPATH);
(void)mktemp(e_tmpname);
+ if (!*e_tmpname)
+ fatal("Can't mktemp()");
e_fp = fopen(e_tmpname,"w");
if (!e_fp)
fatal("Cannot open temporary file");
@@ -234,45 +250,25 @@ setuid perl scripts securely.\n");
switch_end:
scriptname = argv[0];
if (e_fp) {
- (void)fclose(e_fp);
+ if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
+ fatal("Can't write to temp file for -e: %s", strerror(errno));
argc++,argv--;
scriptname = e_tmpname;
}
-#ifdef MSDOS
+#ifdef DOSISH
#define PERLLIB_SEP ';'
#else
#define PERLLIB_SEP ':'
#endif
#ifndef TAINT /* Can't allow arbitrary PERLLIB in setuid script */
- {
- char * s2 = getenv("PERLLIB");
-
- if ( s2 ) {
- /* Break at all separators */
- while ( *s2 ) {
- /* First, skip any consecutive separators */
- while ( *s2 == PERLLIB_SEP ) {
- /* Uncomment the next line for PATH semantics */
- /* (void)apush(stab_array(incstab),str_make(".",1)); */
- s2++;
- }
- if ( (s = index(s2,PERLLIB_SEP)) != Nullch ) {
- (void)apush(stab_array(incstab),str_make(s2,(int)(s-s2)));
- s2 = s+1;
- } else {
- (void)apush(stab_array(incstab),str_make(s2,0));
- break;
- }
- }
- }
- }
+ incpush(getenv("PERLLIB"));
#endif /* TAINT */
#ifndef PRIVLIB
#define PRIVLIB "/usr/local/lib/perl"
#endif
- (void)apush(stab_array(incstab),str_make(PRIVLIB,0));
+ incpush(PRIVLIB);
(void)apush(stab_array(incstab),str_make(".",1));
str_set(&str_no,No);
@@ -296,19 +292,28 @@ setuid perl scripts securely.\n");
bufend = s + strlen(s);
while (*s) {
-#ifndef MSDOS
+#ifndef DOSISH
s = cpytill(tokenbuf,s,bufend,':',&len);
#else
+#ifdef atarist
+ for (len = 0; *s && *s != ',' && *s != ';'; tokenbuf[len++] = *s++);
+ tokenbuf[len] = '\0';
+#else
for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++);
tokenbuf[len] = '\0';
#endif
+#endif
if (*s)
s++;
-#ifndef MSDOS
+#ifndef DOSISH
if (len && tokenbuf[len-1] != '/')
#else
+#ifdef atarist
+ if (len && ((tokenbuf[len-1] != '\\') && (tokenbuf[len-1] != '/')))
+#else
if (len && tokenbuf[len-1] != '\\')
#endif
+#endif
(void)strcat(tokenbuf+len,"/");
(void)strcat(tokenbuf+len,scriptname);
#ifdef DEBUGGING
@@ -348,8 +353,24 @@ setuid perl scripts securely.\n");
sprintf(tokenbuf, "%s", cpp);
str_cat(str,"-I");
str_cat(str,PRIVLIB);
+#ifdef MSDOS
(void)sprintf(buf, "\
-%ssed %s -e '/^[^#]/b' \
+sed %s -e \"/^[^#]/b\" \
+ -e \"/^#[ ]*include[ ]/b\" \
+ -e \"/^#[ ]*define[ ]/b\" \
+ -e \"/^#[ ]*if[ ]/b\" \
+ -e \"/^#[ ]*ifdef[ ]/b\" \
+ -e \"/^#[ ]*ifndef[ ]/b\" \
+ -e \"/^#[ ]*else/b\" \
+ -e \"/^#[ ]*elif[ ]/b\" \
+ -e \"/^#[ ]*undef[ ]/b\" \
+ -e \"/^#[ ]*endif/b\" \
+ -e \"s/^#.*//\" \
+ %s | %s -C %s %s",
+ (doextract ? "-e \"1,/^#/d\n\"" : ""),
+#else
+ (void)sprintf(buf, "\
+%s %s -e '/^[^#]/b' \
-e '/^#[ ]*include[ ]/b' \
-e '/^#[ ]*define[ ]/b' \
-e '/^#[ ]*if[ ]/b' \
@@ -361,12 +382,13 @@ setuid perl scripts securely.\n");
-e '/^#[ ]*endif/b' \
-e 's/^[ ]*#.*//' \
%s | %s -C %s %s",
-#ifdef MSDOS
- "",
+#ifdef LOC_SED
+ LOC_SED,
#else
- "/bin/",
+ "sed",
#endif
(doextract ? "-e '1,/^#/d\n'" : ""),
+#endif
scriptname, tokenbuf, str_get(str), CPPMINUS);
#ifdef DEBUGGING
if (debug & 64) {
@@ -376,7 +398,7 @@ setuid perl scripts securely.\n");
#endif
doextract = FALSE;
#ifdef IAMSUID /* actually, this is caught earlier */
- if (euid != uid && !euid) /* if running suidperl */
+ if (euid != uid && !euid) { /* if running suidperl */
#ifdef HAS_SETEUID
(void)seteuid(uid); /* musn't stay setuid root */
#else
@@ -386,6 +408,9 @@ setuid perl scripts securely.\n");
setuid(uid);
#endif
#endif
+ if (geteuid() != uid)
+ fatal("Can't do seteuid!\n");
+ }
#endif /* IAMSUID */
rsfp = mypopen(buf,"r");
}
@@ -538,7 +563,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
fatal("Can't do setuid\n");
}
- if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid)
+ if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) {
#ifdef HAS_SETEGID
(void)setegid(statbuf.st_gid);
#else
@@ -548,6 +573,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
setgid(statbuf.st_gid);
#endif
#endif
+ if (getegid() != statbuf.st_gid)
+ fatal("Can't do setegid!\n");
+ }
if (statbuf.st_mode & S_ISUID) {
if (statbuf.st_uid != euid)
#ifdef HAS_SETEUID
@@ -559,8 +587,10 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
setuid(statbuf.st_uid);
#endif
#endif
+ if (geteuid() != statbuf.st_uid)
+ fatal("Can't do seteuid!\n");
}
- else if (uid) /* oops, mustn't run as root */
+ else if (uid) { /* oops, mustn't run as root */
#ifdef HAS_SETEUID
(void)seteuid((UIDTYPE)uid);
#else
@@ -570,6 +600,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
setuid((UIDTYPE)uid);
#endif
#endif
+ if (geteuid() != uid)
+ fatal("Can't do seteuid!\n");
+ }
uid = (int)getuid();
euid = (int)geteuid();
gid = (int)getgid();
@@ -713,11 +746,15 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
rightstab = stabent("'",allstabs);
sawampersand = (amperstab || leftstab || rightstab);
if (tmpstab = stabent(":",allstabs))
- str_set(STAB_STR(tmpstab),chopset);
+ str_set(stab_val(tmpstab),chopset);
if (tmpstab = stabent("\024",allstabs))
time(&basetime);
/* these aren't necessarily magical */
+ if (tmpstab = stabent("\014",allstabs)) {
+ str_set(stab_val(tmpstab),"\f");
+ formfeed = stab_val(tmpstab);
+ }
if (tmpstab = stabent(";",allstabs))
str_set(STAB_STR(tmpstab),"\034");
if (tmpstab = stabent("]",allstabs)) {
@@ -730,7 +767,8 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
stdinstab = stabent("STDIN",TRUE);
stdinstab->str_pok |= SP_MULTI;
- stab_io(stdinstab) = stio_new();
+ if (!stab_io(stdinstab))
+ stab_io(stdinstab) = stio_new();
stab_io(stdinstab)->ifp = stdin;
tmpstab = stabent("stdin",TRUE);
stab_io(tmpstab) = stab_io(stdinstab);
@@ -738,7 +776,8 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
tmpstab = stabent("STDOUT",TRUE);
tmpstab->str_pok |= SP_MULTI;
- stab_io(tmpstab) = stio_new();
+ if (!stab_io(tmpstab))
+ stab_io(tmpstab) = stio_new();
stab_io(tmpstab)->ofp = stab_io(tmpstab)->ifp = stdout;
defoutstab = tmpstab;
tmpstab = stabent("stdout",TRUE);
@@ -747,7 +786,8 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
curoutstab = stabent("STDERR",TRUE);
curoutstab->str_pok |= SP_MULTI;
- stab_io(curoutstab) = stio_new();
+ if (!stab_io(curoutstab))
+ stab_io(curoutstab) = stio_new();
stab_io(curoutstab)->ofp = stab_io(curoutstab)->ifp = stderr;
tmpstab = stabent("stderr",TRUE);
stab_io(tmpstab) = stab_io(curoutstab);
@@ -761,6 +801,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
rs = nrs;
rslen = nrslen;
rschar = nrschar;
+ rspara = (nrslen == 2);
str_nset(stab_val(stabent("/", TRUE)), rs, rslen);
if (do_undump)
@@ -879,6 +920,33 @@ int namlen;
}
}
+static void
+incpush(p)
+char *p;
+{
+ char *s;
+
+ if (!p)
+ return;
+
+ /* Break at all separators */
+ while (*p) {
+ /* First, skip any consecutive separators */
+ while ( *p == PERLLIB_SEP ) {
+ /* Uncomment the next line for PATH semantics */
+ /* (void)apush(stab_array(incstab), str_make(".", 1)); */
+ p++;
+ }
+ if ( (s = index(p, PERLLIB_SEP)) != Nullch ) {
+ (void)apush(stab_array(incstab), str_make(p, (int)(s - p)));
+ p = s + 1;
+ } else {
+ (void)apush(stab_array(incstab), str_make(p, 0));
+ break;
+ }
+ }
+}
+
void
savelines(array, str)
ARRAY *array;
@@ -947,7 +1015,7 @@ int *arglast;
curcmd->c_filestab = fstab("(eval)");
curcmd->c_line = 1;
str_sset(linestr,str);
- str_cat(linestr,";\n"); /* be kind to them */
+ str_cat(linestr,";\n;\n"); /* be kind to them */
if (perldb)
savelines(stab_xarray(curcmd->c_filestab), linestr);
}
@@ -969,8 +1037,13 @@ int *arglast;
return sp;
}
tmpfilename = savestr(specfilename);
- if (index("/.", *tmpfilename))
+ if (*tmpfilename == '/' ||
+ (*tmpfilename == '.' &&
+ (tmpfilename[1] == '/' ||
+ (tmpfilename[1] == '.' && tmpfilename[2] == '/'))))
+ {
rsfp = fopen(tmpfilename,"r");
+ }
else {
ar = stab_array(incstab);
for (i = 0; i <= ar->ary_fill; i++) {
@@ -1061,7 +1134,7 @@ int *arglast;
}
myroot = eval_root; /* in case cmd_exec does another eval! */
- if (retval) {
+ if (retval || error_count) {
st = stack->ary_array;
sp = arglast[0];
if (gimme != G_ARRAY)
@@ -1074,6 +1147,7 @@ int *arglast;
#endif
cmd_free(eval_root);
#endif
+ /*SUPPRESS 29*/ /*SUPPRESS 30*/
if ((CMD*)eval_root == last_root)
last_root = Nullcmd;
eval_root = myroot = Nullcmd;
@@ -1301,10 +1375,13 @@ char *s;
fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
stdout);
#ifdef OS2
- fputs("OS/2 port Copyright (c) 1990, Raymond Chen, Kai Uwe Rommel\n",
+ fputs("OS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n",
stdout);
#endif
#endif
+#ifdef atarist
+ fputs("atariST series port, ++jrb bammi@cadence.com\n", stdout);
+#endif
fputs("\n\
Perl may be copied only under the terms of either the Artistic License or the\n\
GNU General Public License, which may be found in the Perl 4.0 source kit.\n",stdout);
@@ -1330,6 +1407,7 @@ GNU General Public License, which may be found in the Perl 4.0 source kit.\n",st
/* unexec() can be found in the Gnu emacs distribution */
+void
my_unexec()
{
#ifdef UNEXEC
@@ -1346,7 +1424,7 @@ my_unexec()
fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
exit(status);
#else
-#ifdef MSDOS
+#ifdef DOSISH
abort(); /* nothing else to do */
#else /* ! MSDOS */
# ifndef SIGABRT
diff --git a/perl.man b/perl.man
index 4ffb76e8e4..d17736d287 100644
--- a/perl.man
+++ b/perl.man
@@ -1,7 +1,18 @@
.rn '' }`
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:42:00 $
+''' $RCSfile: perl.man,v $$Revision: 4.0.1.6 $$Date: 92/06/08 15:07:29 $
'''
''' $Log: perl.man,v $
+''' Revision 4.0.1.6 92/06/08 15:07:29 lwall
+''' patch20: documented that numbers may contain underline
+''' patch20: clarified that DATA may only be read from main script
+''' patch20: relaxed requirement for semicolon at the end of a block
+''' patch20: added ... as variant on ..
+''' patch20: documented need for 1; at the end of a required file
+''' patch20: extended bracket-style quotes to two-arg operators: s()() and tr()()
+''' patch20: paragraph mode now skips extra newlines automatically
+''' patch20: documented PERLLIB and PERLDB
+''' patch20: documented limit on size of regexp
+'''
''' Revision 4.0.1.5 91/11/11 16:42:00 lwall
''' patch19: added little-endian pack/unpack options
'''
@@ -623,12 +634,13 @@ Numeric literals are specified in any of the usual floating point or
integer formats:
.nf
-.ne 5
+.ne 6
12345
12345.67
.23E-10
0xffff # hex
0377 # octal
+ 4_294_967_296
.fi
String literals are delimited by either single or double quotes.
@@ -687,7 +699,9 @@ They may only be used as separate tokens; they will not be interpolated
into strings.
In addition, the token _\|_END_\|_ may be used to indicate the logical end of the
script before the actual end of file.
-Any following text is ignored (but may be read via the DATA filehandle).
+Any following text is ignored, but may be read via the DATA filehandle.
+(The DATA filehandle may read data only from the main script, but not from
+any required file or evaluated string.)
The two control characters ^D and ^Z are synonyms for _\|_END_\|_.
.PP
A word that doesn't have any other interpretation in the grammar will be
@@ -944,7 +958,7 @@ The loop
}
.ne 10
-is equivalent to
+is equivalent to the following Perl-like pseudo code:
unshift(@ARGV, \'\-\') \|if \|$#ARGV < $[;
while ($ARGV = shift) {
@@ -955,12 +969,15 @@ is equivalent to
}
.fi
-except that it isn't as cumbersome to say.
+except that it isn't as cumbersome to say, and will actually work.
It really does shift array ARGV and put the current filename into
variable ARGV.
-It also uses filehandle ARGV internally.
-You can modify @ARGV before the first <> as long as you leave the first
-filename at the beginning of the array.
+It also uses filehandle ARGV internally\*(--<> is just a synonym for
+<ARGV>, which is magical.
+(The pseudo code above doesn't work because it treats <ARGV> as non-magical.)
+.PP
+You can modify @ARGV before the first <> as long as the array ends up
+containing the list of filenames you really want.
Line numbers ($.) continue as if the input was one big happy file.
(But see example under eof for how to reset line numbers on each file.)
.PP
@@ -1288,9 +1305,9 @@ before execution.)
.Sh "Simple statements"
The only kind of simple statement is an expression evaluated for its side
effects.
-Every expression (simple statement) must be terminated with a semicolon.
-Note that this is like C, but unlike Pascal (and
-.IR awk ).
+Every simple statement must be terminated with a semicolon, unless it is the
+final statement in a block, in which case the semicolon is optional.
+(Semicolon is still encouraged there if the block takes up more than one line).
.PP
Any simple statement may optionally be followed by a
single modifier, just before the terminating semicolon.
@@ -1416,20 +1433,20 @@ This is useful for writing \*(L"for (1..10)\*(R" loops and for doing
slice operations on arrays.
.Sp
In a scalar context, .\|. returns a boolean value.
-The operator is bistable, like a flip-flop..
+The operator is bistable, like a flip-flop, and
+emulates the line-range (comma) operator of sed, awk, and various editors.
Each .\|. operator maintains its own boolean state.
It is false as long as its left operand is false.
Once the left operand is true, the range operator stays true
until the right operand is true,
AFTER which the range operator becomes false again.
(It doesn't become false till the next time the range operator is evaluated.
-It can become false on the same evaluation it became true, but it still returns
-true once.)
+It can test the right operand and become false on the
+same evaluation it became true (as in awk), but it still returns true once.
+If you don't want it to test the right operand till the next
+evaluation (as in sed), use three dots (.\|.\|.) instead of two.)
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 scalar .\|. 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 &&.
The value returned is either the null string for false, or a sequence number
(beginning with 1) for true.
@@ -1472,13 +1489,13 @@ Precedence is higher than logical and relational operators, but lower than
arithmetic operators.
The operator may be any of:
.nf
- \-r File is readable by effective uid.
- \-w File is writable by effective uid.
- \-x File is executable by effective uid.
+ \-r File is readable by effective uid/gid.
+ \-w File is writable by effective uid/gid.
+ \-x File is executable by effective uid/gid.
\-o File is owned by effective uid.
- \-R File is readable by real uid.
- \-W File is writable by real uid.
- \-X File is executable by real uid.
+ \-R File is readable by real uid/gid.
+ \-W File is writable by real uid/gid.
+ \-X File is executable by real uid/gid.
\-O File is owned by real uid.
\-e File exists.
\-z File has zero size.
@@ -1655,6 +1672,20 @@ LIST operators have lowest precedence.
All other unary operators have a precedence greater than relational operators
but less than arithmetic operators.
See the section on Precedence.
+.PP
+For operators that can be used in either a scalar or array context,
+failure is generally indicated in a scalar context by returning
+the undefined value, and in an array context by returning the null list.
+Remember though that
+THERE IS NO GENERAL RULE FOR CONVERTING A LIST INTO A SCALAR.
+Each operator decides which sort of scalar it would be most
+appropriate to return.
+Some operators return the length of the list
+that would have been returned in an array context.
+Some operators return the first value in the list.
+Some operators return the last value in the list.
+Some operators return a count of successful operations.
+In general, they do what you want, unless you want consistency.
.Ip "/PATTERN/" 8 4
See m/PATTERN/.
.Ip "?PATTERN?" 8 4
@@ -2389,7 +2420,8 @@ getpriority(2).
.Ip "endservent" 8
These routines perform the same functions as their counterparts in the
system library.
-The return values from the various get routines are as follows:
+Within an array context,
+the return values from the various get routines are as follows:
.nf
($name,$passwd,$uid,$gid,
@@ -2401,10 +2433,29 @@ The return values from the various get routines are as follows:
($name,$aliases,$port,$proto) = getserv.\|.\|.
.fi
+(If the entry doesn't exist you get a null list.)
+.Sp
+Within a scalar context, you get the name, unless the function was a
+lookup by name, in which case you get the other thing, whatever it is.
+(If the entry doesn't exist you get the undefined value.)
+For example:
+.nf
+
+ $uid = getpwnam
+ $name = getpwuid
+ $name = getpwent
+ $gid = getgrnam
+ $name = getgrgid
+ $name = getgrent
+ etc.
+
+.fi
The $members value returned by getgr.\|.\|. is a space separated list
of the login names of the members of the group.
.Sp
-The @addrs value returned by the gethost.\|.\|. functions is a list of the
+For the gethost.\|.\|. functions, if the h_errno variable is supported in C,
+it will be returned to you via $? if the function call fails.
+The @addrs value returned by a successful call is a list of the
raw addresses returned by the corresponding system library call.
In the Internet domain, each address is four bytes long and you can unpack
it by saying something like:
@@ -2807,7 +2858,7 @@ you should be using s///g for such modifications.) Examples:
($one,$five,$fifteen) = (\`uptime\` =~ /(\ed+\e.\ed+)/g);
# scalar context
- $/ = 1; $* = 1;
+ $/ = ""; $* = 1;
while ($paragraph = <>) {
while ($paragraph =~ /[a-z][\'")]*[.!?]+[\'")]*\es/g) {
$sentences++;
@@ -3330,6 +3381,9 @@ Has semantics similar to the following subroutine:
.fi
Note that the file will not be included twice under the same specified name.
+The file must return true as the last statement to indicate successful
+execution of any initialization code, so it's customary to end
+such a file with \*(L"1;\*(R" unless you're sure it'll return true otherwise.
.Ip "reset(EXPR)" 8 6
.Ip "reset EXPR" 8
.Ip "reset" 8
@@ -3404,6 +3458,9 @@ if single quotes are used, no
interpretation is done on the replacement string (the e modifier overrides
this, however); if backquotes are used, the replacement string is a command
to execute whose output will be used as the actual replacement text.
+If the PATTERN is delimited by bracketing quotes, the REPLACEMENT
+has its own pair of quotes, which may or may not be bracketing quotes, e.g.
+s(foo)(bar) or s<foo>/bar/.
If no string is specified via the =~ or !~ operator,
the $_ string is searched and modified.
(The string specified with =~ must be a scalar variable, an array element,
@@ -3661,19 +3718,19 @@ Examples:
.ne 2
# same thing, but with explicit sort routine
- @articles = sort {$a cmp $b;} @files;
+ @articles = sort {$a cmp $b} @files;
.ne 2
# same thing in reversed order
- @articles = sort {$b cmp $a;} @files;
+ @articles = sort {$b cmp $a} @files;
.ne 2
# sort numerically ascending
- @articles = sort {$a <=> $b;} @files;
+ @articles = sort {$a <=> $b} @files;
.ne 2
# sort numerically descending
- @articles = sort {$b <=> $a;} @files;
+ @articles = sort {$b <=> $a} @files;
.ne 5
# sort using explicit subroutine name
@@ -3826,6 +3883,7 @@ If EXPR is omitted, does srand(time).
.Ip "stat SCALARVARIABLE" 8
Returns a 13-element array giving the statistics for a file, either the file
opened via FILEHANDLE, or named by EXPR.
+Returns a null list if the stat fails.
Typically used as follows:
.nf
@@ -3902,7 +3960,7 @@ contain a match:
.ne 12
$search = \'while (<>) { study;\';
foreach $word (@words) {
- $search .= "++\e$seen{\e$ARGV} if /\eb$word\eb/;\en";
+ $search .= "++\e$seen{\e$ARGV} if /\e\eb$word\e\eb/;\en";
}
$search .= "}";
@ARGV = @files;
@@ -4023,6 +4081,9 @@ devotees,
.I y
is provided as a synonym for
.IR tr .
+If the SEARCHLIST is delimited by bracketing quotes, the REPLACEMENTLIST
+has its own pair of quotes, which may or may not be bracketing quotes, e.g.
+tr[A-Z][a-z] or tr(+-*/)/ABCD/.
.Sp
If the c modifier is specified, the SEARCHLIST character set is complemented.
If the d modifier is specified, any characters specified by SEARCHLIST that
@@ -4880,6 +4941,12 @@ RS variable, including treating blank lines as delimiters
if set to the null string.
You may set it to a multicharacter string to match a multi-character
delimiter.
+Note that setting it to "\en\en" means something slightly different
+than setting it to "", if the file contains consecutive blank lines.
+Setting it to "" will treat two or more consecutive blank lines as a single
+blank line.
+Setting it to "\en\en" will blindly assume that the next input character
+belongs to the next paragraph, even if it's a newline.
(Mnemonic: / is used to delimit line boundaries when quoting poetry.)
.Ip $, 8
The output field separator for the print operator.
@@ -4974,16 +5041,17 @@ $? & 255 gives which signal, if any, the process died from, and whether
there was a core dump.
(Mnemonic: similar to sh and ksh.)
.Ip $& 8 4
-The string matched by the last pattern match (not counting any matches hidden
+The string matched by the last successful pattern match
+(not counting any matches hidden
within a BLOCK or eval enclosed by the current BLOCK).
(Mnemonic: like & in some editors.)
.Ip $\` 8 4
-The string preceding whatever was matched by the last pattern match
+The string preceding whatever was matched by the last successful pattern match
(not counting any matches hidden within a BLOCK or eval enclosed by the current
BLOCK).
(Mnemonic: \` often precedes a quoted string.)
.Ip $\' 8 4
-The string following whatever was matched by the last pattern match
+The string following whatever was matched by the last successful pattern match
(not counting any matches hidden within a BLOCK or eval enclosed by the current
BLOCK).
(Mnemonic: \' often follows a quoted string.)
@@ -5158,6 +5226,8 @@ Use undef to disable inplace editing.
(Mnemonic: value of
.B \-i
switch.)
+.Ip $^L 8 2
+What formats output to perform a formfeed. Default is \ef.
.Ip $^P 8 2
The internal flag that the debugger clears so that it doesn't
debug itself. You could conceivable disable debugging yourself
@@ -5635,14 +5705,26 @@ careful what you print out.
The tainting mechanism is intended to prevent stupid mistakes, not to remove
the need for thought.
.SH ENVIRONMENT
-.I Perl
-uses PATH in executing subprocesses, and in finding the script if \-S
+.Ip HOME 12 4
+Used if chdir has no argument.
+.Ip LOGDIR 12 4
+Used if chdir has no argument and HOME is not set.
+.Ip PATH 12 4
+Used in executing subprocesses, and in finding the script if \-S
is used.
-HOME or LOGDIR are used if chdir has no argument.
+.Ip PERLLIB 12 4
+A colon-separated list of directories in which to look for Perl library
+files before looking in the standard library and the current directory.
+.Ip PERLDB 12 4
+The command used to get the debugger code. If unset, uses
+.br
+
+ require 'perldb.pl'
+
.PP
Apart from these,
.I perl
-uses no environment variables, except to make them available
+uses no other environment variables, except to make them available
to the script being executed, and to child processes.
However, scripts running setuid would do well to execute the following lines
before doing anything else, just to keep people honest:
@@ -5686,9 +5768,9 @@ Accustomed
users should take special note of the following:
.Ip * 4 2
Semicolons are required after all simple statements in
-.IR perl .
-Newline
-is not a statement delimiter.
+.I perl
+(except at the end of a block).
+Newline is not a statement delimiter.
.Ip * 4 2
Curly brackets are required on ifs and whiles.
.Ip * 4 2
@@ -5917,6 +5999,7 @@ While none of the built-in data types have any arbitrary size limits (apart
from memory size), there are still a few arbitrary limits:
a given identifier may not be longer than 255 characters,
and no component of your PATH may be longer than 255 if you use \-S.
+A regular expression may not compile to more than 32767 bytes internally.
.PP
.I Perl
actually stands for Pathologically Eclectic Rubbish Lister, but don't tell