(defnk new-sandbox-compiler
"Creates a sandbox that returns rerunable code. You can pass locals
which will be passed to the 'compiled' function in the same order
as defined before 'compilation'. The compiled code is a function that
takes one or more parameters. The first parameter is a hash map of
bindings like {'*out* my-writer} that will beind within the execution.
Every following value is mapped to a local value given at compile time
in the same order so:
(def my-writer (java.io.StringWriter.))
(def code (compiler \"(println a)\" a))
(code {'*out my-writer} 1) ; will write 1 into my-writer instead of the
standard output.
If :remember-state >= 1 the namespace will be torn down with every time
the code is executed and rebuild with the history of state changing
functions. State changing means having def, def*, alter, swap! or dosync
in it."
[:namespace (gensym "net.licenser.sandbox.box")
:tester secure-tester
:timeout *default-sandbox-timeout*
:context (-> (empty-perms-list) domain context)
:object-tester default-obj-tester
:remember-state 0]
(let [history (atom [])]
(fn sandbox-compiler [form & locals]
(let [form (dot-replace form)]
(if (tester form namespace)
(fn sandbox-entry-point
([bindings & values]
(binding [*ns* (create-ns namespace)]
(refer 'clojure.core)
(dorun (map (partial intern namespace) locals values))
(thunk-timeout
(fn timeout-box []
(sandbox
(fn sandboxed-code []
(push-thread-bindings
(assoc (apply hash-map
(flatten
(map (fn jvm-sandbox-runable-code [[k v]] [(resolve k) v]) (seq bindings))))
(var *ns*) (create-ns namespace)))
(if (not (zero? remember-state))
(doseq [d @history]
(try
(let [r (binding [*read-eval* false *ns* (create-ns namespace) dot (dot-maker object-tester)] (refer 'clojure.core) (eval '(def dot net.licenser.sandbox/dot)) (eval d))]
(if (coll? r) (doall r) r))
(catch Exception e
(swap! history #(remove (partial = d) %))))))
(try
(let [r
(binding [*read-eval* false
*ns* (create-ns namespace)
dot (dot-maker object-tester)]
(eval '(def dot net.licenser.sandbox/dot))
(eval form))]
(if (and (not (zero? remember-state)) (has-state? form))
(do
(if (>= (count @history) remember-state)
(swap! history #(conj (rest %) form))
(swap! history conj form))
(remove-ns namespace)))
(if (coll? r) (doall r) r))
(finally (pop-thread-bindings)))) context)) timeout)))
([] (sandbox-entry-point {})))
(throw (SecurityException. (str "Code did not pass sandbox guidelines: " (pr-str (find-bad-forms tester namespace form))))))))))
Used in 0 other vars
Comments top
No comments for new-sandbox-compiler. Log in to add a comment.