perl_mlb

 view release on metacpan or  search on metacpan

os2/Opcode.pm  view on Meta::CPAN

$VERSION = "1.05";
$XS_VERSION = "1.03";

use Carp;
use Exporter ();
use XSLoader ();

BEGIN {
    @ISA = qw(Exporter);
    @EXPORT_OK = qw(
	opset ops_to_opset
	opset_to_ops opset_to_hex invert_opset
	empty_opset full_opset
	opdesc opcodes opmask define_optag
	opmask_add verify_opset opdump
    );
}

sub opset (;@);
sub opset_to_hex ($);
sub opdump (;$);
use subs @EXPORT_OK;

XSLoader::load 'Opcode', $XS_VERSION;

_init_optags();

sub ops_to_opset { opset @_ }	# alias for old name

sub opset_to_hex ($) {
    return "(invalid opset)" unless verify_opset($_[0]);
    unpack("h*",$_[0]);
}

sub opdump (;$) {
	my $pat = shift;
    # handy utility: perl -MOpcode=opdump -e 'opdump File'
    foreach(opset_to_ops(full_opset)) {
        my $op = sprintf "  %12s  %s\n", $_, opdesc($_);
		next if defined $pat and $op !~ m/$pat/i;
		print $op;
    }
}



sub _init_optags {
    my(%all, %seen);
    @all{opset_to_ops(full_opset)} = (); # keys only

    local($_);
    local($/) = "\n=cut"; # skip to optags definition section
    <DATA>;
    $/ = "\n=";		# now read in 'pod section' chunks
    while(<DATA>) {
	next unless m/^item\s+(:\w+)/;
	my $tag = $1;

	# Split into lines, keep only indented lines
	my @lines = grep { m/^\s/    } split(/\n/);
	foreach (@lines) { s/--.*//  } # delete comments
	my @ops   = map  { split ' ' } @lines; # get op words

	foreach(@ops) {
	    warn "$tag - $_ already tagged in $seen{$_}\n" if $seen{$_};
	    $seen{$_} = $tag;
	    delete $all{$_};
	}
	# opset will croak on invalid names
	define_optag($tag, opset(@ops));
    }
    close(DATA);
    warn "Untagged opnames: ".join(' ',keys %all)."\n" if %all;
}


1;

__DATA__

os2/Opcode.pm  view on Meta::CPAN

Operator tags can be used to refer to groups (or sets) of operators.
Tag names always begin with a colon. The Opcode module defines several
optags and the user can define others using the define_optag function.

=item a negated opname or optag

An opname or optag can be prefixed with an exclamation mark, e.g., !mkdir.
Negating an opname or optag means remove the corresponding ops from the
accumulated set of ops at that point.

=item an operator set (opset)

An I<opset> as a binary string of approximately 44 bytes which holds a
set or zero or more operators.

The opset and opset_to_ops functions can be used to convert from
a list of operators to an opset and I<vice versa>.

Wherever a list of operators can be given you can use one or more opsets.
See also Manipulating Opsets below.

=back


=head1 Opcode Functions

The Opcode package contains functions for manipulating operator names
tags and sets. All are available for export by the package.

=over 8

=item opcodes

In a scalar context opcodes returns the number of opcodes in this
version of perl (around 350 for perl-5.7.0).

In a list context it returns a list of all the operator names.
(Not yet implemented, use @names = opset_to_ops(full_opset).)

=item opset (OP, ...)

Returns an opset containing the listed operators.

=item opset_to_ops (OPSET)

Returns a list of operator names corresponding to those operators in
the set.

=item opset_to_hex (OPSET)

Returns a string representation of an opset. Can be handy for debugging.

=item full_opset

Returns an opset which includes all operators.

=item empty_opset

Returns an opset which contains no operators.

=item invert_opset (OPSET)

Returns an opset which is the inverse set of the one supplied.

=item verify_opset (OPSET, ...)

Returns true if the supplied opset looks like a valid opset (is the
right length etc) otherwise it returns false. If an optional second
parameter is true then verify_opset will croak on an invalid opset
instead of returning false.

Most of the other Opcode functions call verify_opset automatically
and will croak if given an invalid opset.

=item define_optag (OPTAG, OPSET)

Define OPTAG as a symbolic name for OPSET. Optag names always start
with a colon C<:>.

The optag name used must not be defined already (define_optag will
croak if it is already defined). Optag names are global to the perl
process and optag definitions cannot be altered or deleted once
defined.

It is strongly recommended that applications using Opcode should use a
leading capital letter on their tag names since lowercase names are
reserved for use by the Opcode module. If using Opcode within a module
you should prefix your tags names with the name of your module to
ensure uniqueness and thus avoid clashes with other modules.

=item opmask_add (OPSET)

Adds the supplied opset to the current opmask. Note that there is
currently I<no> mechanism for unmasking ops once they have been masked.
This is intentional.

=item opmask

Returns an opset corresponding to the current opmask.

=item opdesc (OP, ...)

This takes a list of operator names and returns the corresponding list
of operator descriptions.

=item opdump (PAT)

Dumps to STDOUT a two column list of op names and op descriptions.
If an optional pattern is given then only lines which match the

os2/Opcode.pm  view on Meta::CPAN

	perl -MOpcode=opdump -e 'opdump Eval'

=back

=head1 Manipulating Opsets

Opsets may be manipulated using the perl bit vector operators & (and), | (or),
^ (xor) and ~ (negate/invert).

However you should never rely on the numerical position of any opcode
within the opset. In other words both sides of a bit vector operator
should be opsets returned from Opcode functions.

Also, since the number of opcodes in your current version of perl might
not be an exact multiple of eight, there may be unused bits in the last
byte of an upset. This should not cause any problems (Opcode functions
ignore those extra bits) but it does mean that using the ~ operator
will typically not produce the same 'physical' opset 'string' as the
invert_opset function.


=head1 TO DO (maybe)

    $bool = opset_eq($opset1, $opset2)	true if opsets are logically eqiv

    $yes = opset_can($opset, @ops)	true if $opset has all @ops set

    @diff = opset_diff($opset1, $opset2) => ('foo', '!bar', ...)

=cut

# the =cut above is used by _init_optags() to get here quickly

=head1 Predefined Opcode Tags

=over 5

=item :base_core

os2/Safe.pm  view on Meta::CPAN

    # Uses a closure (on $__ExPr__) to pass in the code to be executed.
    # (eval on one line to keep line numbers as expected by caller)
    eval sprintf
    'package %s; %s strict; sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
		$_[0], $_[1] ? 'use' : 'no';
}

use Carp;

use Opcode 1.01, qw(
    opset opset_to_ops opmask_add
    empty_opset full_opset invert_opset verify_opset
    opdesc opcodes opmask define_optag opset_to_hex
);

*ops_to_opset = \&opset;   # Temporary alias for old Penguins


my $default_root  = 0;
my $default_share = ['*_']; #, '*main::'];

sub new {
    my($class, $root, $mask) = @_;
    my $obj = {};
    bless $obj, $class;

os2/Safe.pm  view on Meta::CPAN

    return $obj->{Mask} unless @_;
    $obj->deny_only(@_);
}

# v1 compatibility methods
sub trap   { shift->deny(@_)   }
sub untrap { shift->permit(@_) }

sub deny {
    my $obj = shift;
    $obj->{Mask} |= opset(@_);
}
sub deny_only {
    my $obj = shift;
    $obj->{Mask} = opset(@_);
}

sub permit {
    my $obj = shift;
    # XXX needs testing
    $obj->{Mask} &= invert_opset opset(@_);
}
sub permit_only {
    my $obj = shift;
    $obj->{Mask} = invert_opset opset(@_);
}


sub dump_mask {
    my $obj = shift;
    print opset_to_hex($obj->{Mask}),"\n";
}



sub share {
    my($obj, @vars) = @_;
    $obj->share_from(scalar(caller), \@vars);
}

sub share_from {

os2/Safe.pm  view on Meta::CPAN

Code evaluated in a compartment compiles subject to the
compartment's operator mask. Attempting to evaluate code in a
compartment which contains a masked operator will cause the
compilation to fail with an error. The code will not be executed.

The default operator mask for a newly created compartment is
the ':default' optag.

It is important that you read the Opcode(3) module documentation
for more information, especially for detailed definitions of opnames,
optags and opsets.

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
    }

os2/ops.pm  view on Meta::CPAN

package ops;

our $VERSION = '1.00';

use Opcode qw(opmask_add opset invert_opset);

sub import {
    shift;
    # Not that unimport is the prefered form since import's don't
	# accumulate well owing to the 'only ever add opmask' rule.
	# E.g., perl -Mops=:set1 -Mops=:setb is unlikely to do as expected.
    opmask_add(invert_opset opset(@_)) if @_;
}

sub unimport {
    shift;
    opmask_add(opset(@_)) if @_;
}

1;

__END__

=head1 NAME

ops - Perl pragma to restrict unsafe operations when compiling