pike.git
/
src
/
modules
/
Perl
/
perlmod.c
version
»
Context lines:
10
20
40
80
file
none
3
pike.git/src/modules/Perl/perlmod.c:1:
/* || This file is part of Pike. For copyright information see COPYRIGHT. || Pike is distributed under GPL, LGPL and MPL. See the file COPYING || for more information.
-
|| $Id: perlmod.c,v 1.
32
2002
/
11
/
26
14
:
22
:
47
nilsson Exp $
+
|| $Id: perlmod.c,v 1.
33
2003
/
09
/
05
21
:
38
:
12
nilsson Exp $
*/ #define NO_PIKE_SHORTHAND #include "builtin_functions.h" #include "global.h" #include "svalue.h" #include "array.h" #include "stralloc.h" #include "interpret.h" #include "module_support.h" #include "threads.h" #include "mapping.h" #include "perl_machine.h"
-
+
#include "security.h"
#ifdef HAVE_PERL /* #define PERL_560 1 */ #include <EXTERN.h> #include <perl.h> #ifdef USE_THREADS
pike.git/src/modules/Perl/perlmod.c:350:
{ struct perlmod_storage *ps = _THIS; #ifdef PIKE_PERLDEBUG fprintf(stderr, "[perlmod_create, %d args]\n", args); #ifdef MY_XS fprintf(stderr, "[has MY_XS]\n"); #endif #endif
-
if
(
args
!=
0)
Pike_error
("Perl->create
takes
no arguments
.");
+
CHECK_SECURITY_OR_ERROR
(
SECURITY_BIT_SECURITY,
+
("Perl->create
:
Permission
denied
.
\n
")
)
;
-
+
if (args != 0) Pike_error("Perl->create takes no arguments.\n");
+
if (!ps || !ps->perl) Pike_error("No perl interpreter available.\n"); MT_PERMIT; if(!ps->constructed) { perl_construct(ps->perl); ps->constructed++; } if (!ps->parsed) { _perl_parse(ps, 3, dummyargv, NULL);
pike.git/src/modules/Perl/perlmod.c:394:
struct mapping *env_mapping=0; struct perlmod_storage *ps = _THIS; #ifndef MY_XS extern void xs_init(void); #endif #ifdef PIKE_PERLDEBUG fprintf(stderr, "[perlmod_parse, %d args]\n", args); #endif
+
CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY,
+
("Perl->parse: Permission denied.\n"));
+
check_all_args("Perl->parse",args,BIT_ARRAY, BIT_MAPPING|BIT_VOID, 0); if(!ps->perl) Pike_error("No perl interpreter available.\n"); switch(args) { default: env_mapping = Pike_sp[1-args].u.mapping; mapping_fix_type_field(env_mapping); if(m_ind_types(env_mapping) & ~BIT_STRING)
pike.git/src/modules/Perl/perlmod.c:476:
/*! @decl int run() *! *! Run a previously parsed Perl script file. Returns a status code. */ static void perlmod_run(INT32 args) { INT32 i; struct perlmod_storage *ps = _THIS;
+
CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY,
+
("Perl->run: Permission denied.\n"));
+
if(!ps->perl) Pike_error("No perl interpreter available.\n"); pop_n_elems(args); if(!_THIS->constructed || !_THIS->parsed) Pike_error("No Perl program loaded (run() called before parse()).\n"); MT_PERMIT; i=perl_run(ps->perl); MT_FORBID;
pike.git/src/modules/Perl/perlmod.c:573:
} /*! @decl mixed eval(string expression) *! *! Evalute a Perl expression in a scalar context, and return the *! result if it is a simple value type. Unsupported value types *! are rendered as 0. */ static void perlmod_eval(INT32 args)
-
{ _
perlmod
_
eval
(
args
,
G_SCALAR
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->eval: Permission denied.\n"
)
)
;
-
+
_perlmod_eval(args, G_SCALAR);
+
}
+
/*! @decl mixed eval_list(string expression) *! *! Evalute a Perl expression in a list context, and return the *! result if it is a simple value type, or an array of simple value *! types. Unsupported value types are rendered as 0. */ static void perlmod_eval_list(INT32 args)
-
{ _
perlmod
_
eval
(
args
,
G
_
ARRAY
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->eval
_
list: Permission denied.\n"
)
)
;
-
+
_perlmod_eval(args, G_ARRAY);
+
}
+
static void _perlmod_call(INT32 args, int perlflags) { struct perlmod_storage *ps = _THIS; int i, n; char *pv; dSP; #ifdef PIKE_PERLDEBUG fprintf(stderr, "[perlmod_call: args=%d]\n", args);
pike.git/src/modules/Perl/perlmod.c:720:
*! @param name *! The name of the subroutine to call, as an 8-bit string. *! *! @param arguments *! Zero or more arguments to the function. Only simple value *! types are supported. Unsupported value types will cause an *! error to be thrown. */ static void perlmod_call(INT32 args)
-
{ _
perlmod
_
call
(
args
,
G_SCALAR
|
G_EVAL
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->call: Permission denied.\n"
)
)
;
-
+
_perlmod_call(args, G_SCALAR | G_EVAL);
+
}
+
/*! @decl mixed call_list(string name, mixed ... arguments) *! *! Call a Perl subroutine in a list context, and return the *! result if it is a simple value type, or an array of simple *! value types. Unsupported value types are rendered as 0. *! *! @param name *! The name of the subroutine to call, as an 8-bit string. *! *! @param arguments *! Zero or more arguments to the function. Only simple value *! types are supported. Unsupported value types will cause an *! error to be thrown. */ static void perlmod_call_list(INT32 args)
-
{ _
perlmod
_
call
(
args
,
G_ARRAY
|
G
_
EVAL
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->call
_
list:
Permission
denied.\n"
)
)
;
-
+
_perlmod_call(args, G_ARRAY | G_EVAL);
+
}
+
static void _perlmod_varop(INT32 args, int op, int type) /* To avoid excessive code duplication, this function does most of the * actual work of getting and setting values of scalars, arrays and * hashes. There are wrapper functions below that use this function. */ { int i; int wanted_args = (type == 'S' ? 1 : 2); if (op == 'W') ++wanted_args;
pike.git/src/modules/Perl/perlmod.c:841:
*! Set the value of a Perl scalar variable. *! *! @param name *! Name of the scalar variable, as an 8-bit string. *! *! @param value *! The new value. Only simple value types are supported. Throws *! an error for unsupported value types. */ static void perlmod_set_scalar(INT32 args)
-
{ _
perlmod
_
varop
(
args
,
'W',
'S'
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->set_scalar: Permission denied.\n"
)
)
;
-
+
_perlmod_varop(args, 'W', 'S');
+
}
+
/*! @decl mixed get_array_item(string name, int index) *! *! Get the value of an entry in a Perl array variable. Returns the *! value, or a zero-type value if indexing outside the array, or a *! plain zero if the value type was not supported. *! *! @param name *! Name of the array variable, as an 8-bit string. *! *! @param index
pike.git/src/modules/Perl/perlmod.c:877:
*! *! @param index *! Array index. An error is thrown if the index is negative, *! non-integer or a bignum. *! *! @param value *! New value. Only simple value types are supported. An error is *! thrown for unsupported value types. */ static void perlmod_set_array_item(INT32 args)
-
{ _
perlmod
_
varop
(
args
,
'W',
'A'
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->create: Permission denied.\n"
)
)
;
-
+
_perlmod_varop(args, 'W', 'A');
+
}
+
/*! @decl mixed get_hash_item(string name, mixed key) *! *! Get the value of an entry in a Perl hash variable. Returns the value, *! or a zero-type value if the hash had no entry for the given key, or *! a plain 0 if the returned value type was not supported. *! *! @param name *! Name of the array variable, as an 8-bit string. *! *! @param key
pike.git/src/modules/Perl/perlmod.c:911:
*! *! @param key *! Hash key. Only simple value types are supported. An error is *! thrown for unsupported value types. *! *! @param value *! New value. Only simple value types are supported. An error is *! thrown for unsupported value types. */ static void perlmod_set_hash_item(INT32 args)
-
{ _
perlmod
_
varop
(
args
,
'W',
'H'
);
}
+
{
+
CHECK
_
SECURITY
_
OR_ERROR
(
SECURITY_BIT_SECURITY
,
+
("Perl->set_hash_item: Permission denied.\n"
)
)
;
-
+
_perlmod_varop(args, 'W', 'H');
+
}
+
/*! @decl int array_size(string name) *! *! Get the size of the Perl array variable with the given name. *! *! @param name *! Name of the array variable, as an 8-bit string. */ static void perlmod_array_size(INT32 args) { AV *av;