Roxen.git / server / modules / scripting / perl.pike

version» Context lines:

Roxen.git/server/modules/scripting/perl.pike:1:   #include <module.h>   inherit "module";   inherit "roxenlib";      // Experimental Perl script and tag handler module.   // by Leif Stensson.      string cvs_version = -  "$Id: perl.pike,v 2.3 2000/08/17 10:17:14 leif Exp $"; +  "$Id: perl.pike,v 2.4 2000/08/17 15:18:52 leif Exp $";      constant module_type = MODULE_EXPERIMENTAL |    MODULE_FILE_EXTENSION | MODULE_PARSER;      constant module_name = "Perl support";   constant module_doc =    "EXPERIMENTAL MODULE! This module provides a faster way of running "    "Perl scripts with Roxen. "    "The module also optionally provides a &lt;perl&gt;..&lt;/perl&gt; "    "container to run Perl code from inside RXML pages.";      static string recent_error = 0;   static int parsed_tags = 0, script_calls = 0, script_errors = 0;    -  + static mapping handler_settings = ([ ]); +    constant thread_safe = 1;      #ifdef THREADS   static object mutex = Thread.Mutex();   #endif      void create()   {    defvar("extensions", ({ "pl", "perl" }), "Extensions", TYPE_STRING_LIST,    "List of URL extensions that should be taken to indicate that the "
Roxen.git/server/modules/scripting/perl.pike:63:    "Allow RXML parsing of tag results.");       defvar("bindir", "perl/bin", "Perl Helper Binaries", TYPE_DIR,    "Perl helper binaries directory.");       defvar("parallel", 2, "Parallel scripts", TYPE_MULTIPLE_INT,    "Number of scripts/tags that may be evaluated in parallel. Don't set "    "this higher than necessary, since it may cause the server to block. "    "The default for this setting is 2.",    ({ 1, 2, 3, 4, 5 }) ); +  +  defvar("identity", "nobody:*", "Run Perl as...", TYPE_STRING, +  "User and group to run Perl scripts and tags as. The default for " +  "this option is `nobody:*'. Note that Roxen can't change user ID " +  "unless it has sufficient permissions to do so.");   }      string status()   { string s = "<b>Script calls</b>: " + script_calls + " <br />\n" +    "<b>Script errors</b>: " + script_errors + " <br />\n" +    "<b>Parsed tags</b>: " + parsed_tags + " <br />\n";    -  +  if (handler_settings->set_uid) +  s += sprintf("<b>Subprocess UID</b>: set uid=%O <br />\n", +  handler_settings->set_uid); +  else +  s += "<b>Subprocess UID</b>: same as Roxen<br />\n"; +  +  s += "<b>Helper script</b>: "; +  if (Stdio.File(QUERY(bindir)+"/perlrun", "r")) +  s += "found: " + QUERY(bindir)+"/perlrun <br />\n"; +  else +  s += "not found.<br />\n"; +     if (recent_error)    s += "<b>Most recent error</b>: " + recent_error + " <br />\n";       return s;   }    -  + static object gethandler() + { return ExtScript.getscripthandler(QUERY(bindir)+"/perlrun", +  QUERY(parallel), handler_settings); + } +  + static void fix_settings() + { +  string u, g; +  mapping s = ([ ]); +  +  if (sscanf(QUERY(identity), "%s:%s", u, g) == 2) +  { +  array ua = getpwnam(u), ga = getgrnam(g); +  +  if (!ua) ua = getpwuid((int) u); +  if (!ga) ga = getgrgid((int) g); +  +  if (ua) s->set_uid = ua[2]; +  if (ga) s->set_gid = ga[2]; +  } +  +  handler_settings = s; + } +    static void periodic() - { ExtScript.periodic_cleanup(); + { +  fix_settings(); +  ExtScript.periodic_cleanup();    call_out(periodic, 900);   }      void start() - { call_out(periodic, 900); + { fix_settings(); +  call_out(periodic, 900);   }      mixed handle_file_extension(Stdio.File file, string ext, object id) - { object h = ExtScript.getscripthandler(QUERY(bindir)+"/perlrun", -  QUERY(parallel)); + { object h = gethandler();       if (id->realfile && stringp(id->realfile))    { array result;    -  +  NOCACHE(); +     if (!h) return http_string_answer("<h1>Script support failed.</h1>");       mixed bt = catch (result = h->run(id->realfile, id));       ++script_calls;       if (bt)    { ++script_errors; -  report_error("Perl script '" + id->realfile + "' failed.\n"); +  report_error("Perl script `" + id->realfile + "' failed.\n");    if (QUERY(showbacktrace))    return http_string_answer("<h1>Script Error!</h1>\n<pre>" +    describe_backtrace(bt) + "\n</pre>");    else    return http_string_answer("<h1>Script Error!</h1>");    }    else if (sizeof(result) > 1)    { string r = result[1];   // werror("Result: " + sprintf("%O", r) + "\n");    if (r == "") r = " "; // Some browsers don't like null answers.
Roxen.git/server/modules/scripting/perl.pike:145:   }      constant simpletag_perl_flags = 0;      mixed simpletag_perl(string tag, mapping attr, string contents, object id,    RXML.Frame frame)   {    if (!QUERY(tagenable))    RXML.run_error("<perl>...</perl> tag not enabled in this server.");    -  object h = ExtScript.getscripthandler(QUERY(bindir)+"/perlrun", -  QUERY(parallel)); +  object h = gethandler();       if (!h)    RXML.run_error("Perl tag support unavailable.");    -  +  NOCACHE(); +     array result;    mixed bt = catch (result = h->eval(contents, id));    ++parsed_tags;       if (bt)    {    werror("Perl tag backtrace:\n" + describe_backtrace(bt) + "\n");    RXML.run_error("Perl tag");    }    else if (sizeof(result) > 1)
Roxen.git/server/modules/scripting/perl.pike:179:    return result[1];    }    else    return sprintf("SCRIPT ERROR: bad result: %O", result);       return "<b>(No perl tag support?)</b>";   }      mixed simple_pi_tag_perl(string tag, mapping attr, string contents, object id,    RXML.Frame frame) - { return simpletag_perl(tag, attr, contents, id, frame); + { +  return simpletag_perl(tag, attr, contents, id, frame);   }      array(string) query_file_extensions() - { return QUERY(extensions); + { +  return QUERY(extensions);   }