pike.git / src / modules / Perl / perlmod.c

version» Context lines:

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;