Skip to content

Commit

Permalink
Redesign Clojail testers to be collections of functions.
Browse files Browse the repository at this point in the history
  • Loading branch information
@Raynes
Raynes committed Sep 3, 2012
1 parent 69c828a commit b491032
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 113 deletions.
80 changes: 6 additions & 74 deletions src/clojail/core.clj
View file
@@ -1,6 +1,3 @@
;; Clojail is an easy way to sandbox your code. Whether you want to allow evaluation on a website,
;; in an IRC bot, or anything else you can think of, Clojail wants to be the easiest and most
;; comprehensive way to do that. But it isn't easy.
(ns clojail.core (ns clojail.core
(:use clojure.stacktrace (:use clojure.stacktrace
[clojure.walk :only [walk postwalk-replace]] [clojure.walk :only [walk postwalk-replace]]
Expand All @@ -9,11 +6,6 @@
(:import (java.util.concurrent TimeoutException TimeUnit FutureTask) (:import (java.util.concurrent TimeoutException TimeUnit FutureTask)
(clojure.lang LispReader$ReaderException))) (clojure.lang LispReader$ReaderException)))


;; postwalk is like a magical recursive doall, to force lazy-seqs
;; within the timeout context; but since it doesn't maintain perfect
;; structure for *every* data type, we want to actually return the
;; original value after we force it, not the result of postwalk
;; replacement
(defn eagerly-consume (defn eagerly-consume
"Recursively force all lazy-seqs in val." "Recursively force all lazy-seqs in val."
[val] [val]
Expand All @@ -22,7 +14,6 @@
(catch Throwable _)) (catch Throwable _))
val) val)


;; It sucks to have to deal with TimeUnits. They're so damned long.
(def ^{:doc "Create a map of pretty keywords to ugly TimeUnits"} (def ^{:doc "Create a map of pretty keywords to ugly TimeUnits"}
uglify-time-unit uglify-time-unit
(into {} (for [[enum aliases] {TimeUnit/NANOSECONDS [:ns :nanoseconds] (into {} (for [[enum aliases] {TimeUnit/NANOSECONDS [:ns :nanoseconds]
Expand All @@ -32,11 +23,6 @@
alias aliases] alias aliases]
{alias enum}))) {alias enum})))


;; This function uses some deprecated Java methods to stop threads, but the
;; reason they're deprecated doesn't really apply here. Just because people
;; don't use them properly doesn't mean they aren't useful.
;;
;; This function is useful in general, and that's why it is public.
(defn thunk-timeout (defn thunk-timeout
"Takes a function and an amount of time to wait for the function to finish "Takes a function and an amount of time to wait for the function to finish
executing. The sandbox can do this for you. unit is any of :ns, :us, :ms, executing. The sandbox can do this for you. unit is any of :ns, :us, :ms,
Expand Down Expand Up @@ -108,9 +94,6 @@
%) %)
(-> s macroexpand-most vector flatten-all))))) (-> s macroexpand-most vector flatten-all)))))


;; Because the dot (.) interop form is a special form, we can't just rebind it or anything.
;; Instead, we need to replace it entirely with a safe macro of our own. To do this, we need
;; to replace all . symbols with 'dot', the name of our own safe dot macro.
(defn- dotify (defn- dotify
"Replace all . symbols with 'dot." "Replace all . symbols with 'dot."
[form] [form]
Expand All @@ -125,67 +108,19 @@
. (cons 'dot (recurse (rest form))) . (cons 'dot (recurse (rest form)))
(recurse form))))))) (recurse form)))))))


;; Compose our earlier functions.
(def ^{:private true (def ^{:private true
:doc "Fix code to make interop safe."} :doc "Fix code to make interop safe."}
ensafen ensafen
(comp dotify macroexpand-most)) (comp dotify macroexpand-most))


(defprotocol Checkable
"A protocol for things that can be checked against objects for safety."
(bad? [this obj] "Check if an object should be allowed or not. Returns true if the object is unsafe."))

(extend-protocol Checkable
clojure.lang.Var
(bad? [this obj] (= this obj))

clojure.lang.IFn
(bad? [this obj] (this obj))

java.lang.String
(bad? [this obj] (-> this read-string eval (bad? obj)))

java.lang.Package
(bad? [this obj]
(condp = (type obj)
java.lang.Package (= this obj)
java.lang.Class (= this (.getPackage obj))
nil))

clojure.lang.Symbol
(bad? [this obj] (= this obj))

java.lang.Object
(bad? [this obj] (= this obj))

nil
(bad? [this obj] false))

(defn unsafe? [tester obj] (defn unsafe? [tester obj]
(and (some #(bad? % obj) tester) obj)) (some #(% obj) tester))


;; The clojail equivalent of motion detectors.
(defn check-form (defn check-form
"Check a form to see if it trips a tester." "Check a form to see if it trips a tester."
[form tester nspace] [form tester nspace]
(some (partial unsafe? tester) (separate form nspace))) (some (partial unsafe? tester) (separate form nspace)))


;; We have to run the sandbox against packages as well as classes,
;; but macros can't embed Package objects in code by default. This
;; is a simple print-dup method so that we can embed them in our dot
;; macro.
(defmethod print-dup java.lang.Package
([p out]
(.write out (str "#=(java.lang.Package/getPackage \""
(.getName p)
"\")"))))

(defmethod print-dup clojure.lang.Fn
[p out]
(if (= :serializable.fn/serializable-fn (type p))
(.write out (str "#=(eval " (binding [*print-dup* false] (pr-str p)) ")"))
(print-ctor p (fn [p out]) out)))

(defn security-exception [problem] (defn security-exception [problem]
(throw (throw
(SecurityException. (SecurityException.
Expand All @@ -195,11 +130,11 @@
"Returns a safe . macro." "Returns a safe . macro."
[tester-str] [tester-str]
`(defmacro ~'dot [object# method# & args#] `(defmacro ~'dot [object# method# & args#]
`(let [~'tester-obj# (binding [*read-eval* true] (read-string ~~tester-str)) `(let [~'tester-obj# (binding [*read-eval* true] (eval (read-string ~~tester-str)))
~'obj# ~object# ~'obj# ~object#
~'obj-class# (class ~'obj#)] ~'obj-class# (class ~'obj#)]
(if-let [~'bad# (some (partial unsafe? ~'tester-obj#) [~'obj-class# ~'obj# (.getPackage ~'obj-class#)])] (if-let [~'bad# (some (partial clojail.core/unsafe? ~'tester-obj#) [~'obj-class# ~'obj# (.getPackage ~'obj-class#)])]
(security-exception ~'bad#) (clojail.core/security-exception ~'bad#)
(. ~object# ~method# ~@args#))))) (. ~object# ~method# ~@args#)))))


(defn- user-defs (defn- user-defs
Expand All @@ -223,9 +158,6 @@
(when (> (count new-defs) max-defs) (when (> (count new-defs) max-defs)
(bulk-unmap nspace new-defs)))) (bulk-unmap nspace new-defs))))


(defn- read-tester [tester]
(with-out-str (binding [*print-dup* true] (pr tester))))

(defn- evaluator [code tester-str context nspace bindings] (defn- evaluator [code tester-str context nspace bindings]
(fn [] (fn []
(binding [*ns* nspace (binding [*ns* nspace
Expand Down Expand Up @@ -287,7 +219,7 @@
(eval init)) (eval init))
(let [init-defs (conj (user-defs nspace) 'dot)] (let [init-defs (conj (user-defs nspace) 'dot)]
(fn [code tester & [bindings]] (fn [code tester & [bindings]]
(let [tester-str (read-tester tester) (let [tester-str (pr-str tester)
old-defs (user-defs nspace)] old-defs (user-defs nspace)]
(when jvm (set-security-manager (SecurityManager.))) (when jvm (set-security-manager (SecurityManager.)))
(try (try
Expand Down Expand Up @@ -336,4 +268,4 @@ IllegalStateException; other exceptions will be thrown unchanged."
:else (throw (repackage cause))))))))) :else (throw (repackage cause)))))))))
([str] ([str]
(with-in-str str (with-in-str str
(safe-read)))) (safe-read))))
97 changes: 58 additions & 39 deletions src/clojail/testers.clj
View file
Expand Up @@ -5,61 +5,80 @@
(:require [bultitude.core :as nses] (:require [bultitude.core :as nses]
[serializable.fn :as sfn])) [serializable.fn :as sfn]))


(deftype ClojailPackage [package])

(defmethod print-method ClojailPackage
[p out]
(.write out (str "#=(clojail.testers/->ClojailPackage \""
(.package p)
"\")")))

(defn p (defn p
"Create a package object for putting in a tester." "Create package objects for putting in a tester."
[s] (Package/getPackage s)) [& packages]
(map #(->ClojailPackage %) packages))


(defn prefix-checker [n] (defn blacklist-nses
"Blacklist Clojure namespaces. nses should be a collection of namespaces."
[nses]
(sfn/fn [s] (sfn/fn [s]
(when (symbol? s) (first (filter #(or (= s %)
(.startsWith (name s) (str n))))) (when (symbol? s)
(.startsWith (name s) (str %))))
nses))))


(defn suffix-tester [n] (defn blacklist-symbols
"Blacklist symbols. Second argument should be a set of symbols."
[symbols]
(sfn/fn [s] (sfn/fn [s]
(when (symbol? s) (when (symbol? s)
(.endsWith (name s) (munge (str "$" n)))))) (first (filter #(or (= s %)

(.endsWith (name s) (munge (str "$" %))))
(defn blacklist-ns symbols)))))
"Blacklist a Clojure namespace."
[tester n]
(conj tester n (prefix-checker n)))

(defn blacklist-symbols
"Blacklist symbols."
[tester & symbols]
(into tester (concat symbols (map suffix-tester symbols))))


(defn blacklist-packages (defn blacklist-packages
"Blacklist a bunch of Java packages at once." "Blacklist packages. packages should be a collection of ClojailPackage objects.
[tester & packages] These can be created with the p function."
(into tester (map p packages))) [packages]
(sfn/fn [obj]
(let [obj (if (= Class (type obj))
(.getPackage obj)
obj)]
(when obj
(first (filter #(let [pack (.package %)]
(or (= obj (Package/getPackage pack))
(= obj (symbol pack))))
packages))))))

(defn blacklist-objects
"Blacklist some objects. objs should be a collection of things."
[objs]
(sfn/fn [s] (first (filter #(= s %) objs))))


(defn blanket (defn blanket
"Takes a tester and some namespace prefixes as strings. Looks up "Takes a tester and some namespace prefixes as strings. Looks up
the prefixes with bultitude, getting a list of all namespaces on the prefixes with bultitude, getting a list of all namespaces on
the classpath matching those prefixes." the classpath matching those prefixes."
[tester & prefixes] [& prefixes]
(reduce blacklist-ns tester (blacklist-nses (mapcat (partial nses/namespaces-on-classpath :prefix) prefixes)))
(mapcat (partial nses/namespaces-on-classpath :prefix) prefixes)))


(def ^{:doc "A tester that attempts to be secure, and allows def."} (def ^{:doc "A tester that attempts to be secure, and allows def."}
secure-tester-without-def secure-tester-without-def
(-> #{clojure.lang.Compiler clojure.lang.Ref clojure.lang.Reflector [(blacklist-objects [clojure.lang.Compiler clojure.lang.Ref clojure.lang.Reflector
clojure.lang.Namespace 'System/out 'System/in 'System/err clojure.lang.Namespace clojure.lang.Var clojure.lang.RT])
clojure.lang.Var clojure.lang.RT} (blacklist-packages (p "java.lang.reflect"
(blacklist-packages "java.lang.reflect"
"java.security" "java.security"
"java.util.concurrent" "java.util.concurrent"
"java.awt") "java.awt"))
(blacklist-symbols (blacklist-symbols
'alter-var-root 'intern 'eval 'catch '#{alter-var-root intern eval catch
'load-string 'load-reader 'addMethod 'ns-resolve 'resolve 'find-var load-string load-reader addMethod ns-resolve resolve find-var
'*read-eval* 'ns-publics 'ns-unmap 'set! 'ns-map 'ns-interns 'the-ns *read-eval* ns-publics ns-unmap set! ns-map ns-interns the-ns
'push-thread-bindings 'pop-thread-bindings 'future-call 'agent 'send push-thread-bindings pop-thread-bindings future-call agent send
'send-off 'pmap 'pcalls 'pvals 'in-ns 'System/out 'System/in 'System/err send-off pmap pcalls pvals in-ns System/out System/in System/err
'with-redefs) with-redefs})
(blanket "clojail"))) (blanket "clojail")])


(def ^{:doc "A somewhat secure tester. No promises."} (def ^{:doc "A somewhat secure tester. No promises."}
secure-tester secure-tester
(conj secure-tester-without-def 'def)) (conj secure-tester-without-def (blacklist-symbols '#{def})))

0 comments on commit b491032

Please sign in to comment.