Permalink
Browse files

Redesign Clojail testers to be collections of functions.

  • Loading branch information...
1 parent 69c828a commit b49103211fd41c513d1ec3cd9f0c4ae171166806 @Raynes Raynes committed Sep 3, 2012
Showing with 64 additions and 113 deletions.
  1. +6 −74 src/clojail/core.clj
  2. +58 −39 src/clojail/testers.clj
View
@@ -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
(:use clojure.stacktrace
[clojure.walk :only [walk postwalk-replace]]
@@ -9,11 +6,6 @@
(:import (java.util.concurrent TimeoutException TimeUnit FutureTask)
(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
"Recursively force all lazy-seqs in val."
[val]
@@ -22,7 +14,6 @@
(catch Throwable _))
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"}
uglify-time-unit
(into {} (for [[enum aliases] {TimeUnit/NANOSECONDS [:ns :nanoseconds]
@@ -32,11 +23,6 @@
alias aliases]
{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
"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,
@@ -108,9 +94,6 @@
%)
(-> 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
"Replace all . symbols with 'dot."
[form]
@@ -125,67 +108,19 @@
. (cons 'dot (recurse (rest form)))
(recurse form)))))))
-;; Compose our earlier functions.
(def ^{:private true
:doc "Fix code to make interop safe."}
ensafen
(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]
- (and (some #(bad? % obj) tester) obj))
+ (some #(% obj) tester))
-;; The clojail equivalent of motion detectors.
(defn check-form
"Check a form to see if it trips a tester."
[form tester 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]
(throw
(SecurityException.
@@ -195,11 +130,11 @@
"Returns a safe . macro."
[tester-str]
`(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-class# (class ~'obj#)]
- (if-let [~'bad# (some (partial unsafe? ~'tester-obj#) [~'obj-class# ~'obj# (.getPackage ~'obj-class#)])]
- (security-exception ~'bad#)
+ (if-let [~'bad# (some (partial clojail.core/unsafe? ~'tester-obj#) [~'obj-class# ~'obj# (.getPackage ~'obj-class#)])]
+ (clojail.core/security-exception ~'bad#)
(. ~object# ~method# ~@args#)))))
(defn- user-defs
@@ -223,9 +158,6 @@
(when (> (count new-defs) max-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]
(fn []
(binding [*ns* nspace
@@ -287,7 +219,7 @@
(eval init))
(let [init-defs (conj (user-defs nspace) 'dot)]
(fn [code tester & [bindings]]
- (let [tester-str (read-tester tester)
+ (let [tester-str (pr-str tester)
old-defs (user-defs nspace)]
(when jvm (set-security-manager (SecurityManager.)))
(try
@@ -336,4 +268,4 @@ IllegalStateException; other exceptions will be thrown unchanged."
:else (throw (repackage cause)))))))))
([str]
(with-in-str str
- (safe-read))))
+ (safe-read))))
@@ -5,61 +5,80 @@
(:require [bultitude.core :as nses]
[serializable.fn :as sfn]))
+(deftype ClojailPackage [package])
+
+(defmethod print-method ClojailPackage
+ [p out]
+ (.write out (str "#=(clojail.testers/->ClojailPackage \""
+ (.package p)
+ "\")")))
+
(defn p
- "Create a package object for putting in a tester."
- [s] (Package/getPackage s))
+ "Create package objects for putting in a tester."
+ [& 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]
- (when (symbol? s)
- (.startsWith (name s) (str n)))))
+ (first (filter #(or (= s %)
+ (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]
(when (symbol? s)
- (.endsWith (name s) (munge (str "$" n))))))
-
-(defn blacklist-ns
- "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))))
+ (first (filter #(or (= s %)
+ (.endsWith (name s) (munge (str "$" %))))
+ symbols)))))
(defn blacklist-packages
- "Blacklist a bunch of Java packages at once."
- [tester & packages]
- (into tester (map p packages)))
+ "Blacklist packages. packages should be a collection of ClojailPackage objects.
+ These can be created with the p function."
+ [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
"Takes a tester and some namespace prefixes as strings. Looks up
- the prefixes with bultitude, getting a list of all namespaces on
- the classpath matching those prefixes."
- [tester & prefixes]
- (reduce blacklist-ns tester
- (mapcat (partial nses/namespaces-on-classpath :prefix) prefixes)))
+ the prefixes with bultitude, getting a list of all namespaces on
+ the classpath matching those prefixes."
+ [& prefixes]
+ (blacklist-nses (mapcat (partial nses/namespaces-on-classpath :prefix) prefixes)))
(def ^{:doc "A tester that attempts to be secure, and allows def."}
secure-tester-without-def
- (-> #{clojure.lang.Compiler clojure.lang.Ref clojure.lang.Reflector
- clojure.lang.Namespace 'System/out 'System/in 'System/err
- clojure.lang.Var clojure.lang.RT}
- (blacklist-packages "java.lang.reflect"
+ [(blacklist-objects [clojure.lang.Compiler clojure.lang.Ref clojure.lang.Reflector
+ clojure.lang.Namespace clojure.lang.Var clojure.lang.RT])
+ (blacklist-packages (p "java.lang.reflect"
"java.security"
"java.util.concurrent"
- "java.awt")
- (blacklist-symbols
- 'alter-var-root 'intern 'eval 'catch
- 'load-string 'load-reader 'addMethod 'ns-resolve 'resolve 'find-var
- '*read-eval* 'ns-publics 'ns-unmap 'set! 'ns-map 'ns-interns 'the-ns
- 'push-thread-bindings 'pop-thread-bindings 'future-call 'agent 'send
- 'send-off 'pmap 'pcalls 'pvals 'in-ns 'System/out 'System/in 'System/err
- 'with-redefs)
- (blanket "clojail")))
+ "java.awt"))
+ (blacklist-symbols
+ '#{alter-var-root intern eval catch
+ load-string load-reader addMethod ns-resolve resolve find-var
+ *read-eval* ns-publics ns-unmap set! ns-map ns-interns the-ns
+ push-thread-bindings pop-thread-bindings future-call agent send
+ send-off pmap pcalls pvals in-ns System/out System/in System/err
+ with-redefs})
+ (blanket "clojail")])
(def ^{:doc "A somewhat secure tester. No promises."}
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.