I feel it would be particularly useful to be able to create slave
interpreters from Perl. This patch includes this capability and allows
sandbox (MakeSafe) execution of Tcl code.

Usage as follows:

 use Tcl;
 my $interp=Tcl::new();
 # Arbitrary name and a boolean 'safe' argument
 my $safeslave=$interp->CreateSlave('name',1);
 open (my $fh, 'script.tcl');
 $safeslave->EvalFileHandle($fh);

Speaking to Jeff, he argued perhaps changing the name of the method and accepting a hash argument:
 <tclguy> my $interp = new Tcl;
 <tclguy> my $safeslave = $interp->interp_create(-safe => 1);

I'm submitting this for review, thoughts, considerations, and possible inclusion.

--
Regards,
Eric Windisch


diff -ru Tcl-0.98/Tcl.pm Tcl-0.98-vlw5iq/Tcl.pm
--- Tcl-0.98/Tcl.pm 2009-11-24 04:01:15.000000000 +0000
+++ Tcl-0.98-vlw5iq/Tcl.pm 2010-03-19 17:10:30.000000000 +0000
@@ -77,6 +77,15 @@

Invoke I<Tcl_Init> on the interpeter.

+=item $interp->CreateSlave (NAME, SAFE)
+
+Invoke I<Tcl_CreateSlave> on the interpeter. Name is arbitrary.
+The safe variable, if true, creates a safe sandbox interpreter.
+ See: http://www.tcl.tk/software/plugin/safetcl.html
+ http://www.tcl.tk/man/tcl8.4/TclCmd/safe.htm
+
+This command returns a new interpreter.
+
=item $interp->Eval (STRING, FLAGS)

Evaluate script STRING in the interpreter. If the script returns
diff -ru Tcl-0.98/Tcl.xs Tcl-0.98-vlw5iq/Tcl.xs
--- Tcl-0.98/Tcl.xs 2009-11-24 04:01:15.000000000 +0000
+++ Tcl-0.98-vlw5iq/Tcl.xs 2010-03-19 17:02:18.000000000 +0000
@@ -995,6 +995,31 @@
RETVAL

SV *
+Tcl_CreateSlave(master,name,safe)
+ Tcl master
+ char * name
+ int safe
+ CODE:
+ RETVAL = newSV(0);
+ /*
+ * We might consider Tcl_Preserve/Tcl_Release of the interp.
+ */
+ if (initialized) {
+ Tcl interp = Tcl_CreateSlave(master,name,safe);
+ /*
+ * Add to the global hash of live interps.
+ */
+ if (hvInterps) {
+ (void) hv_store(hvInterps, (const char *) &interp,
+ sizeof(Tcl), &PL_sv_undef, 0);
+ }
+ /* Create lets us set a class, should we do this too? */
+ sv_setref_pv(RETVAL, "Tcl", (void*)interp);
+ }
+ OUTPUT:
+ RETVAL
+
+SV *
Tcl_result(interp)
Tcl interp
CODE:


Reply via email to