perl 5.003_01: [patch re-organisation and patch series introduction]

This is my patch _01 to perl5.003.

This patch contains the last few months' worth of bugfixes and
additions, since the patch to version 5.003 was deliberately kept
 small.  A summary of major revisions and additions can be found
in the diff of the Changes file from the standard distribution,
which is the first diff in the patch below.

The detailed changes to each file are described at the head of the diff
for that file, on lines beginning with #~, so you can extract the
comments by saying perl -ne 'print if /^(?:#~|diff)/'.

This patch is a series of context diffs, since some people have
mentioned that their copy of patch can't handle unidiffs.
Please apply it to a clean copy of perl5.003 using patch -p1 -N.
Before applying the patch, please execute the following commands,
or their moral equivalent; you may feed this patch to /bin/sh in
order to do so.

Enjoy.

Charles Bailey <bailey@genetics.upenn.edu>
July 31, 1996

[ re-organisation changes:
# The code for the Safe extension has been subsumed into the Opcode extension,
# though the calling sequence hasn't changed
rm -rf ext/Safe
rm -f t/lib/safe.t

# Removed due to copyright notice.  Text documentation is supplied.
rm -f ext/SDBM_File/sdbm/readme.ps

# Changes subsumed into new version of DB_File
rm -f os2/diff.db_file

# Moved to main source directory as README.os2
rm -f os2/README
]

3 files changed, 0 insertions, 808 deletions

diff --git a/ext/Safe/Makefile.PL b/ext/Safe/Makefile.PL
deleted file mode 100644
index 108109f61d..0000000000
--- a/ext/Safe/Makefile.PL
+++ /dev/null
@@ -1,7 +0,0 @@
-use ExtUtils::MakeMaker;
-WriteMakefile(
-    NAME	=> 'Safe',
-    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
-    XSPROTOARG => '-noprototypes', 		# XXX remove later?
-    VERSION_FROM => 'Safe.pm',
-);
diff --git a/ext/Safe/Safe.pm b/ext/Safe/Safe.pm
deleted file mode 100644
index 0fafcbe741..0000000000
--- a/ext/Safe/Safe.pm
+++ /dev/null
@@ -1,670 +0,0 @@
-package Safe;
-
-use vars qw($VERSION @ISA @EXPORT_OK);
-
-require Exporter;
-require DynaLoader;
-use Carp;
-$VERSION = "1.00";
-@ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname opdesc
-		MAXO emptymask fullmask);
-
-=head1 NAME
-
-Safe - Safe extension module for Perl
-
-=head1 DESCRIPTION
-
-The Safe extension module allows the creation of compartments
-in which perl code can be evaluated. Each compartment has
-
-=over 8
-
-=item a new namespace
-
-The "root" of the namespace (i.e. "main::") is changed to a
-different package and code evaluated in the compartment cannot
-refer to variables outside this namespace, even with run-time
-glob lookups and other tricks. Code which is compiled outside
-the compartment can choose to place variables into (or share
-variables with) the compartment's namespace and only that
-data will be visible to code evaluated in the compartment.
-
-By default, the only variables shared with compartments are the
-"underscore" variables $_ and @_ (and, technically, the much less
-frequently used %_, the _ filehandle and so on). This is because
-otherwise perl operators which default to $_ will not work and neither
-will the assignment of arguments to @_ on subroutine entry.
-
-=item an operator mask
-
-Each compartment has an associated "operator mask". Recall that
-perl code is compiled into an internal format before execution.
-Evaluating perl code (e.g. via "eval" or "do 'file'") causes
-the code to be compiled into an internal format and then,
-provided there was no error in the compilation, executed.
-Code evaulated in a compartment compiles subject to the
-compartment's operator mask. Attempting to evaulate code in a
-compartment which contains a masked operator will cause the
-compilation to fail with an error. The code will not be executed.
-
-By default, the operator mask for a newly created compartment masks
-out all operations which give "access to the system" in some sense.
-This includes masking off operators such as I<system>, I<open>,
-I<chown>, and I<shmget> but does not mask off operators such as
-I<print>, I<sysread> and I<E<lt>HANDLE<gt>>. Those file operators
-are allowed since for the code in the compartment to have access
-to a filehandle, the code outside the compartment must have explicitly
-placed the filehandle variable inside the compartment.
-
-Since it is only at the compilation stage that the operator mask
-applies, controlled access to potentially unsafe operations can
-be achieved by having a handle to a wrapper subroutine (written
-outside the compartment) placed into the compartment. For example,
-
-    $cpt = new Safe;
-    sub wrapper {
-        # vet arguments and perform potentially unsafe operations
-    }
-    $cpt->share('&wrapper');
-
-=back
-
-=head2 Operator masks
-
-An operator mask exists at user-level as a string of bytes of length
-MAXO, each of which is either 0x00 or 0x01. Here, MAXO is the number
-of operators in the current version of perl. The subroutine MAXO()
-(available for export by package Safe) returns the number of operators
-in the current version of perl. Note that, unlike the beta versions of
-the Safe extension, this is a reliable count of the number of
-operators in the currently running perl executable. The presence of a
-0x01 byte at offset B<n> of the string indicates that operator number
-B<n> should be masked (i.e. disallowed).  The Safe extension makes
-available routines for converting from operator names to operator
-numbers (and I<vice versa>) and for converting from a list of operator
-names to the corresponding mask (and I<vice versa>).
-
-=head2 Methods in class Safe
-
-To create a new compartment, use
-
-    $cpt = new Safe;
-
-Optional arguments are (NAMESPACE, MASK), where
-
-=over 8
-
-=item NAMESPACE
-
-is the root namespace to use for the compartment (defaults to
-"Safe::Root000000000", auto-incremented for each new compartment); and
-
-=item MASK
-
-is the operator mask to use (defaults to a fairly restrictive set).
-
-=back
-
-The following methods can then be used on the compartment
-object returned by the above constructor. The object argument
-is implicit in each case.
-
-=over 8
-
-=item root (NAMESPACE)
-
-This is a get-or-set method for the compartment's namespace. With the
-NAMESPACE argument present, it sets the root namespace for the
-compartment. With no NAMESPACE argument present, it returns the
-current root namespace of the compartment.
-
-=item mask (MASK)
-
-This is a get-or-set method for the compartment's operator mask.
-With the MASK argument present, it sets the operator mask for the
-compartment. With no MASK argument present, it returns the
-current operator mask of the compartment.
-
-=item trap (OP, ...)
-
-This sets bits in the compartment's operator mask corresponding
-to each operator named in the list of arguments. Each OP can be
-either the name of an operation or its number. See opcode.h or
-opcode.pl in the main perl distribution for a canonical list of
-operator names.
-
-=item untrap (OP, ...)
-
-This resets bits in the compartment's operator mask corresponding
-to each operator named in the list of arguments. Each OP can be
-either the name of an operation or its number. See opcode.h or
-opcode.pl in the main perl distribution for a canonical list of
-operator names.
-
-=item share (VARNAME, ...)
-
-This shares the variable(s) in the argument list with the compartment.
-Each VARNAME must be the B<name> of a variable with a leading type
-identifier included. Examples of legal variable names are '$foo' for
-a scalar, '@foo' for an array, '%foo' for a hash, '&foo' for a
-subroutine and '*foo' for a glob (i.e. all symbol table entries
-associated with "foo", including scalar, array, hash, sub and filehandle).
-
-=item varglob (VARNAME)
-
-This returns a glob for the symbol table entry of VARNAME in the package
-of the compartment. VARNAME must be the B<name> of a variable without
-any leading type marker. For example,
-
-    $cpt = new Safe 'Root';
-    $Root::foo = "Hello world";
-    # Equivalent version which doesn't need to know $cpt's package name:
-    ${$cpt->varglob('foo')} = "Hello world";
-
-
-=item reval (STRING)
-
-This evaluates STRING as perl code inside the compartment. The code
-can only see the compartment's namespace (as returned by the B<root>
-method). Any attempt by code in STRING to use an operator which is
-in the compartment's mask will cause an error (at run-time of the
-main program but at compile-time for the code in STRING). The error
-is of the form "%s trapped by operation mask operation...". If an
-operation is trapped in this way, then the code in STRING will not
-be executed. If such a trapped operation occurs or any other
-compile-time or return error, then $@ is set to the error message,
-just as with an eval(). If there is no error, then the method returns
-the value of the last expression evaluated, or a return statement may
-be used, just as with subroutines and B<eval()>. Note that this
-behaviour differs from the beta distribution of the Safe extension
-where earlier versions of perl made it hard to mimic the return
-behaviour of the eval() command.
-
-=item rdo (FILENAME)
-
-This evaluates the contents of file FILENAME inside the compartment.
-See above documentation on the B<reval> method for further details.
-
-=back
-
-=head2 Subroutines in package Safe
-
-The Safe package contains subroutines for manipulating operator
-names and operator masks. All are available for export by the package.
-The canonical list of operator names is the contents of the array
-op_name defined and initialised in file F<opcode.h> of the Perl
-source distribution.
-
-=over 8
-
-=item ops_to_mask (OP, ...)
-
-This takes a list of operator names and returns an operator mask
-with precisely those operators masked.
-
-=item mask_to_ops (MASK)
-
-This takes an operator mask and returns a list of operator names
-corresponding to those operators which are masked in MASK.
-
-=item opcode (OP, ...)
-
-This takes a list of operator names and returns the corresponding
-list of opcodes (which can then be used as byte offsets into a mask).
-
-=item opname (OP, ...)
-
-This takes a list of opcodes and returns the corresponding list of
-operator names.
-
-=item fullmask
-
-This just returns a mask which has all operators masked.
-It returns the string "\1" x MAXO().
-
-=item emptymask
-
-This just returns a mask which has all operators unmasked.
-It returns the string "\0" x MAXO(). This is useful if you
-want a compartment to make use of the namespace protection
-features but do not want the default restrictive mask.
-
-=item MAXO
-
-This returns the number of operators (and hence the length of an
-operator mask). Note that, unlike the beta distributions of the
-Safe extension, this is derived from a genuine integer variable
-in the perl executable and not from a preprocessor constant.
-This means that the Safe extension is more robust in the presence
-of mismatched versions of the perl executable and the Safe extension.
-
-=item op_mask
-
-This returns the operator mask which is actually in effect at the
-time the invocation to the subroutine is compiled. In general,
-this is probably not terribly useful.
-
-=back
-
-=head2 AUTHOR
-
-Malcolm Beattie, mbeattie@sable.ox.ac.uk.
-
-=cut
-
-my $default_root = 'Root000000000';
-
-my $default_mask;
-
-sub new {
-    my($class, $root, $mask) = @_;
-    my $obj = {};
-    bless $obj, $class;
-    $obj->root(defined($root) ? $root : ("Safe::".$default_root++));
-    $obj->mask(defined($mask) ? $mask : $default_mask);
-    # We must share $_ and @_ with the compartment or else ops such
-    # as split, length and so on won't default to $_ properly, nor
-    # will passing argument to subroutines work (via @_). In fact,
-    # for reasons I don't completely understand, we need to share
-    # the whole glob *_ rather than $_ and @_ separately, otherwise
-    # @_ in non default packages within the compartment don't work.
-    *{$obj->root . "::_"} = *_;
-    return $obj;
-}
-
-sub DESTROY {
-    my($obj) = @_;
-    my $root = $obj->root();
-    if ($root =~ /^Safe::(Root\d+)$/){
-	$root = $1;
-	delete $ {"Safe::"}{"$root\::"};
-    }
-}
-
-sub root {
-    my $obj = shift;
-    if (@_) {
-	$obj->{Root} = $_[0];
-    } else {
-	return $obj->{Root};
-    }
-}
-
-sub mask {
-    my $obj = shift;
-    if (@_) {
-	$obj->{Mask} = verify_mask($_[0]);
-    } else {
-	return $obj->{Mask};
-    }
-}
-
-sub verify_mask {
-    my($mask) = @_;
-    if (length($mask) != MAXO() || $mask !~ /^[\0\1]+$/) {
-	croak("argument is not a mask");
-    }
-    return $mask;
-}
-
-sub trap {
-    my $obj = shift;
-    $obj->setmaskel("\1", @_);
-}
-
-sub untrap {
-    my $obj = shift;
-    $obj->setmaskel("\0", @_);
-}
-
-sub emptymask { "\0" x MAXO() }
-sub fullmask { "\1" x MAXO() }
-
-sub setmaskel {
-    my $obj = shift;
-    my $val = shift;
-    croak("bad value for mask element") unless $val eq "\0" || $val eq "\1";
-    my $maskref = \$obj->{Mask};
-    my ($op, $opcode);
-    foreach $op (@_) {
-	$opcode = ($op =~ /^\d/) ? $op : opcode($op);
-	substr($$maskref, $opcode, 1) = $val;
-    }
-}
-
-sub share {
-    my $obj = shift;
-    my $root = $obj->root();
-    my ($arg);
-    foreach $arg (@_) {
-	my $var;
-	($var = $arg) =~ s/^(.)//;
-	my $caller = caller;
-	*{$root."::$var"} = ($1 eq '$') ? \${$caller."::$var"}
-			  : ($1 eq '@') ? \@{$caller."::$var"}
-			  : ($1 eq '%') ? \%{$caller."::$var"}
-			  : ($1 eq '*') ? *{$caller."::$var"}
-			  : ($1 eq '&') ? \&{$caller."::$var"}
-			  : croak(qq(No such variable type for "$1$var"));
-    }
-}
-
-sub varglob {
-    my ($obj, $var) = @_;
-    return *{$obj->root()."::$var"};
-}
-
-sub reval {
-    my ($obj, $expr) = @_;
-    my $root = $obj->{Root};
-    my $mask = $obj->{Mask};
-    verify_mask($mask);
-
-    my $evalsub = eval sprintf(<<'EOT', $root);
-	package %s;
-	sub {
-	    eval $expr;
-	}
-EOT
-    return safe_call_sv($root, $mask, $evalsub);
-}
-
-sub rdo {
-    my ($obj, $file) = @_;
-    my $root = $obj->{Root};
-    my $mask = $obj->{Mask};
-    verify_mask($mask);
-
-    $file =~ s/"/\\"/g; # just in case the filename contains any double quotes
-    my $evalsub = eval sprintf(<<'EOT', $root, $file);
-	package %s;
-	sub {
-	    do "%s";
-	}
-EOT
-    return safe_call_sv($root, $mask, $evalsub);
-}
-
-bootstrap Safe $VERSION;
-
-$default_mask = fullmask;
-my $name;
-while (defined ($name = <DATA>)) {
-    chomp $name;
-    next if $name =~ /^#/;
-    my $code = opcode($name);
-    substr($default_mask, $code, 1) = "\0";
-}
-
-1;
-
-__DATA__
-null
-stub
-scalar
-pushmark
-wantarray
-const
-gvsv
-gv
-gelem
-padsv
-padav
-padhv
-padany
-pushre
-rv2gv
-rv2sv
-av2arylen
-rv2cv
-anoncode
-prototype
-refgen
-srefgen
-ref
-bless
-glob
-readline
-rcatline
-regcmaybe
-regcomp
-match
-subst
-substcont
-trans
-sassign
-aassign
-chop
-schop
-chomp
-schomp
-defined
-undef
-study
-pos
-preinc
-i_preinc
-predec
-i_predec
-postinc
-i_postinc
-postdec
-i_postdec
-pow
-multiply
-i_multiply
-divide
-i_divide
-modulo
-i_modulo
-repeat
-add
-i_add
-subtract
-i_subtract
-concat
-stringify
-left_shift
-right_shift
-lt
-i_lt
-gt
-i_gt
-le
-i_le
-ge
-i_ge
-eq
-i_eq
-ne
-i_ne
-ncmp
-i_ncmp
-slt
-sgt
-sle
-sge
-seq
-sne
-scmp
-bit_and
-bit_xor
-bit_or
-negate
-i_negate
-not
-complement
-atan2
-sin
-cos
-rand
-srand
-exp
-log
-sqrt
-int
-hex
-oct
-abs
-length
-substr
-vec
-index
-rindex
-sprintf
-formline
-ord
-chr
-crypt
-ucfirst
-lcfirst
-uc
-lc
-quotemeta
-rv2av
-aelemfast
-aelem
-aslice
-each
-values
-keys
-delete
-exists
-rv2hv
-helem
-hslice
-split
-join
-list
-lslice
-anonlist
-anonhash
-splice
-push
-pop
-shift
-unshift
-reverse
-grepstart
-grepwhile
-mapstart
-mapwhile
-range
-flip
-flop
-and
-or
-xor
-cond_expr
-andassign
-orassign
-method
-entersub
-leavesub
-caller
-warn
-die
-reset
-lineseq
-nextstate
-dbstate
-unstack
-enter
-leave
-scope
-enteriter
-iter
-enterloop
-leaveloop
-return
-last
-next
-redo
-goto
-close
-fileno
-tie
-untie
-dbmopen
-dbmclose
-sselect
-select
-getc
-read
-enterwrite
-leavewrite
-prtf
-print
-sysread
-syswrite
-send
-recv
-eof
-tell
-seek
-truncate
-fcntl
-ioctl
-sockpair
-bind
-connect
-listen
-accept
-shutdown
-gsockopt
-ssockopt
-getsockname
-ftrwrite
-ftsvtx
-open_dir
-readdir
-telldir
-seekdir
-rewinddir
-kill
-getppid
-getpgrp
-setpgrp
-getpriority
-setpriority
-time
-tms
-localtime
-alarm
-dofile
-entereval
-leaveeval
-entertry
-leavetry
-ghbyname
-ghbyaddr
-ghostent
-gnbyname
-gnbyaddr
-gnetent
-gpbyname
-gpbynumber
-gprotoent
-gsbyname
-gsbyport
-gservent
-shostent
-snetent
-sprotoent
-sservent
-ehostent
-enetent
-eprotoent
-eservent
-gpwnam
-gpwuid
-gpwent
-spwent
-epwent
-ggrnam
-ggrgid
-ggrent
-sgrent
-egrent
diff --git a/ext/Safe/Safe.xs b/ext/Safe/Safe.xs
deleted file mode 100644
index 6b25924a33..0000000000
--- a/ext/Safe/Safe.xs
+++ /dev/null
@@ -1,131 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-/* maxo should never differ from MAXO but leave some room anyway */
-#define OP_MASK_BUF_SIZE (MAXO + 100)
-
-MODULE = Safe	PACKAGE = Safe
-
-void
-safe_call_sv(package, mask, codesv)
-	char *	package
-	SV *	mask
-	SV *	codesv
-    CODE:
-	int i;
-	char *str;
-	STRLEN len;
-	char op_mask_buf[OP_MASK_BUF_SIZE];
-
-	assert(maxo < OP_MASK_BUF_SIZE);
-	ENTER;
-	SAVETMPS;
-	save_hptr(&defstash);
-	save_aptr(&endav);
-	SAVEPPTR(op_mask);
-	op_mask = &op_mask_buf[0];
-	str = SvPV(mask, len);
-	if (maxo != len)
-	    croak("Bad mask length");
-	for (i = 0; i < maxo; i++)
-	    op_mask[i] = str[i];
-	defstash = gv_stashpv(package, TRUE);
-	endav = (AV*)sv_2mortal((SV*)newAV()); /* Ignore END blocks for now */
-	GvHV(gv_fetchpv("main::", TRUE, SVt_PVHV)) = defstash;
-	PUSHMARK(sp);
-	i = perl_call_sv(codesv, G_SCALAR|G_EVAL|G_KEEPERR);
-	SPAGAIN;
-	ST(0) = i ? newSVsv(POPs) : &sv_undef;
-	PUTBACK;
-	FREETMPS;
-	LEAVE;
-	sv_2mortal(ST(0));
-
-void
-op_mask()
-    CODE:
-	ST(0) = sv_newmortal();
-	if (op_mask)
-	    sv_setpvn(ST(0), op_mask, maxo);
-
-void
-mask_to_ops(mask)
-	SV *	mask
-    PPCODE:
-	STRLEN len;
-	char *maskstr = SvPV(mask, len);
-	int i;
-	if (maxo != len)
-	    croak("Bad mask length");
-	for (i = 0; i < maxo; i++)
-	    if (maskstr[i])
-		XPUSHs(sv_2mortal(newSVpv(op_name[i], 0)));
-
-void
-ops_to_mask(...)
-    CODE:
-	int i, j;
-	char mask[OP_MASK_BUF_SIZE], *op;
-	Zero(mask, sizeof mask, char);
-	for (i = 0; i < items; i++)
-	{
-	    op = SvPV(ST(i), na);
-	    for (j = 0; j < maxo && strNE(op, op_name[j]); j++) /* nothing */ ;
-	    if (j < maxo)
-		mask[j] = 1;
-	    else
-	    {
-		Safefree(mask);
-		croak("bad op name \"%s\" in mask", op);
-	    }
-	}
-	ST(0) = sv_2mortal(newSVpv(mask,maxo));
-
-void
-opname(...)
-    PPCODE:
-	int i, myopcode;
-	for (i = 0; i < items; i++)
-	{
-	    myopcode = SvIV(ST(i));
-	    if (myopcode < 0 || myopcode >= maxo)
-		croak("opcode out of range");
-	    XPUSHs(sv_2mortal(newSVpv(op_name[myopcode], 0)));
-	}
-
-void
-opdesc(...)
-    PPCODE:
-	int i, myopcode;
-	for (i = 0; i < items; i++)
-	{
-	    myopcode = SvIV(ST(i));
-	    if (myopcode < 0 || myopcode >= maxo)
-		croak("opcode out of range");
-	    XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
-	}
-
-void
-opcode(...)
-    PPCODE:
-	int i, j;
-	char *op;
-	for (i = 0; i < items; i++)
-	{
-	    op = SvPV(ST(i), na);
-	    for (j = 0; j < maxo; j++) {
-		if (strEQ(op, op_name[j]) || strEQ(op, op_desc[j]))
-		    break;
-	    }
-	    if (j == maxo)
-		croak("bad op name \"%s\"", op);
-	    XPUSHs(sv_2mortal(newSViv(j)));
-	}
-
-int
-MAXO()
-    CODE:
-	RETVAL = maxo;
-    OUTPUT:
-	RETVAL