Merge pull request #3 from s-expressionists/vm-reorg

Vm reorg

README.md

@@ -102,13 +102,93 @@ The `maclina/vm-cross` subsystem allows Maclina to be used for compiling and run
 ;;; And of course, the host *READTABLE* and + are unaffected.
 ```
 
+## Sandboxing
+
+A more complete CL experience requires a richer environment. The [Extrinsicl](https://github.com/s-expressionists/Extrinsicl) project can be used to construct such an environment, but more generally you can just fill a Clostrum environment. Extrinsicl can additionally be configured to provide functions like `eval` through Maclina.
+
+For real sandboxing of untrusted code, you will need a "safe" environment lacking any undesirable operators. What is undesirable depends on your application, but might include, for instance, file I/O. If your environment is well constructed, you don't need to worry about functions that carry out evaluation or introspection in themselves, because they will only operate with respect to your safe environment.
+
+Another danger of untrusted code is it not halting, which can be a denial of service attack. The cross VM has a `with-timeout` macro that can be used to abort evaluation after executing some number of VM instructions. This covers all evaluations within the cross VM, including indirectly as from calls to VM functions. Note that computations outside of the VM are not tracked, so for example there will be no abort if the untrusted code calls a non-VM function that does not halt.
+
+Here is an example of a basic sandbox:
+
+```lisp
+(ql:quickload '(:clostrum-basic :extrinsicl :extrinsicl/maclina :maclina))
+
+;;; Set up Maclina.
+(setf maclina.machine:*client* (make-instance 'maclina.vm-cross:client))
+(maclina.vm-cross:initialize-vm 20000)
+
+;;; Create the (empty) environment.
+(defvar *rte* (make-instance 'clostrum-basic:run-time-environment))
+(defvar *env* (make-instance 'clostrum-basic:compilation-environment
+                :parent *rte*))
+
+;;; Install most of CL.
+(extrinsicl:install-cl maclina.machine:*client* *rte*)
+(extrinsicl.maclina:install-eval maclina.machine:*client* *rte*)
+
+;;; Uninstall filesystem access.
+(loop for f in '(open directory probe-file ensure-directories-exist truename
+                 file-author file-write-date rename-file delete-file)
+      do (clostrum:fmakunbound maclina.machine:*client* *rte* f))
+
+;;; Also add a trap.
+(setf (clostrum:fdefinition maclina.machine:*client* *rte* 'o)
+      (lambda (&rest args) (apply #'open args)))
+
+;;; Try it out.
+(maclina.compile:eval '(+ 2 7) *env*) ;=> 9
+(defparameter *fib*
+  (maclina.compile:compile
+   '(lambda (n)
+      (loop for a = 0 for b = 1
+            repeat n
+            do (psetf a b b (+ a b))
+            finally (return a)))
+   *rte*))
+(funcall *fib* 37) ;=> big number
+
+;;; But we can't access the filesystem.
+(maclina.compile:eval '(open "/tmp/hello.txt") *env*)
+;=> error: UNDEFINED-FUNCTION OPEN
+
+;;; Tricky stuff is available but doesn't help escape.
+(maclina.compile:eval '(eval 'pi) *env*) ;=> pi
+(maclina.compile:eval `(funcall ,*fib* 37) *env*) ;=> big number
+(maclina.compile:eval '(find-symbol "OPEN") *env*) ;=> OPEN
+(maclina.compile:eval '(eval (list (find-symbol "OPEN") "/tmp/hello.txt")) *env*)
+;=> error: UNDEFINED-FUNCTION OPEN
+
+;;; Whoops, we forgot WITH-OPEN-FILE. But that's okay.
+(maclina.compile:eval '(with-open-file (s "/tmp/hello.txt")) *env*)
+;=> error: UNDEFINED-FUNCTION OPEN
+
+;;; But the VM can't intercept a function call within a host function.
+(maclina.compile:eval '(o "/tmp/hello.txt") *env*) ;=> actually opens
+
+;;; DoS denied.
+(maclina.vm-cross:with-timeout (1000000)
+  (maclina.compile:eval '(loop) *env*))
+;=> error: TIMEOUT
+
+;;; Watch out for more exotic DoS outside of the VM, though.
+(maclina.vm-cross:with-timeout (100000)
+  (maclina.compile:compile '(lambda () (progn . #1=(nil . #1#))) *env*))
+; => compiler hangs
+(maclina.vm-cross:with-timeout (100000)
+  (maclina.compile:eval '(typep 17 '#1=(not #1#)) *env*))
+; => hang or stack overflow
+```
+
 # Subsystems
 
 Maclina defines a variety of subsystems that can be loaded independently. It's set up this way so that you can, for example, load one of the VM definitions and run bytecode compiled elsewhere, without needing to load any of the compiler's multitudinous dependencies.
 
 * `maclina/base` is the base system. Everything depends on `maclina/base`. `maclina/base` defines various shared conditions, the MOP magic that lets bytecode functions be run in a host Lisp,the names of instructions, and the disassembler.
 * `maclina/compile` turns Lisp forms into bytecode. You need it in order to compile or evaluate forms. But this alone won't let you run bytecode; you'll need one of the VM systems for that. And Lisp compilation frequently involves evaluation, so you'll probably need to load a VM before you can compile much of anything.
 * `maclina/compile-file` implements the file compiler. It depends on the compiler in `maclina/compile` to do that.
+* `maclina/vm-shared` is an internal system containing some code shared by the VM implementations.
 * `maclina/vm-native` is the "native" implementation of the VM, which is to say that it operates entirely in the host Lisp's normal global environment. This is simple but a bit inflexible.
 * `maclina/vm-cross` is an implementation of the VM that operates relative to a Clostrum environment. This is what you want to do anything first-class-environment-related.
 * `maclina/load` loads FASL files created by `maclina/compile-file`. `maclina/load` and one of the VMs is sufficient to load and run FASLs.

maclina.asd

@@ -70,20 +70,28 @@
   :depends-on (:maclina/base :ieee-floats)
   :components ((:file "loadltv")))
 
+(asdf:defsystem #:maclina/vm-shared
+  :description "Code shared by VM implementations."
+  :author ("Charles Zhang" "Bike <aeshtaer@gmail.com>")
+  :maintainer "Bike <aeshtaer@gmail.com"
+  :depends-on (:maclina/base)
+  :components ((:file "vm-shared")))
+
 (asdf:defsystem #:maclina/vm-native
   :description "Maclina VM implementation using host environment."
   :author ("Charles Zhang"
            "Bike <aeshtaer@gmail.com>")
   :maintainer "Bike <aeshtaer@gmail.com>"
-  :depends-on (:maclina/base :trucler) ; trucler only needed for client class - remove?
+  ;; trucler only needed for client class - remove?
+  :depends-on (:maclina/vm-shared :trucler)
   :components ((:file "vm-native")))
 
 (asdf:defsystem #:maclina/vm-cross
   :description "Maclina VM implementation using Clostrum environment."
   :author ("Charles Zhang"
            "Bike <aeshtaer@gmail.com>")
   :maintainer "Bike <aeshtaer@gmail.com>"
-  :depends-on (:maclina/base :clostrum :clostrum-trucler)
+  :depends-on (:maclina/vm-shared :clostrum :clostrum-trucler)
   :components ((:file "vm-cross")))
 
 (asdf:defsystem #:maclina/test
@@ -108,6 +116,7 @@
                                (:file "externalize")))
                  (:file "cleanliness" :depends-on ("suites" "rt" "packages"))
                  (:file "cooperation" :depends-on ("suites" "rt" "packages"))
+                 (:file "timeout" :depends-on ("suites" "rt" "packages"))
                  (:file "long" :depends-on ("suites" "rt" "packages"))
                  (:module "compiler-conditions"
                   :depends-on ("suites" "rt" "packages")

test/timeout.lisp

@@ -0,0 +1,25 @@
+(in-package #:maclina.test)
+
+;;;; Tests of the timeout mechanism.
+
+(5am:def-suite timeout :in maclina-cross)
+(5am:in-suite timeout)
+
+(5am:test timeout
+  (let ((spinner
+          (ceval '#'(lambda (i)
+                      (block nil
+                        (tagbody
+                         loop
+                           (if (= 0 i) (return))
+                           (setq i (- i 1))
+                           (go loop)))))))
+    (5am:finishes (maclina.vm-cross:with-timeout (1000000)
+                    ;; It is unlikely that any future revisions will be
+                    ;; dumb enough that a loop iteration takes 100k instructions.
+                    (funcall spinner 10)))
+    (5am:signals maclina.vm-cross:timeout
+      (maclina.vm-cross:with-timeout (10)
+        (funcall spinner 1000)))
+    ;; make sure that without a timeout, we can run as long as we want.
+    (5am:finishes (funcall spinner 1000))))