Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

evaling' #3

Merged
merged 4 commits into from

3 participants

@dcluna
Collaborator

I'm trying to merge some of erbot's code with this, to help with nicferrier's eval request. This should help with making fn calls to a different "namespace" and with infinite loops in the user code.

@joelmccracken

Thanks! I'll look at this when I get home this evening.

@joelmccracken

Cool. Not done yet, but since the project is in such shambles, it is totally worth merging in. Thanks!

@joelmccracken joelmccracken merged commit 807e72f into joelmccracken:master
@nicferrier
Collaborator

One thing, i know whitespace is annoying... but don't fix it. Fixing the whitespace results in what we have above which is very difficult to read; to see what you've changed I have to read a lot of spurious whitespace fix lines.

Please just leave it as is.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
Showing with 150 additions and 35 deletions.
  1. +105 −18 sandbox.el
  2. +45 −17 spec/sandbox-spec.el
View
123 sandbox.el
@@ -12,12 +12,12 @@
;; Package: erblisp
;; This file is NOT (yet) part of GNU Emacs.
-
+
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
-
+
;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
@@ -27,14 +27,14 @@
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-
+
;; this file is adapted from the code from erbot. see:
;; http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot
-;; eventually I hope to make it better, but for now
+;; eventually I hope to make it better, but for now
;; other projects can use the same sandboxing functionality
@@ -42,19 +42,17 @@
(defvar sandbox-prefix "emacs-sandbox-")
(defvar sandbox-allowed-words
'(nil
- t
+ t
;; Also consider:
&rest
&optional
)
- "You should add &rest and &optional to this list.
+ "You should add &rest and &optional to this list.
We WON'T do this by default since this could lead to exploits if you
-*happen* to have bound these keywords to weird stuff like
+*happen* to have bound these keywords to weird stuff like
\(setq &rest (shell-command \"rm -rf /\")) in your .emacs."
)
-
-
;; main entry point is sandbox
;; sandbox takes an expression and makes sure it is okay to evaluate
@@ -76,17 +74,18 @@ We WON'T do this by default since this could lead to exploits if you
((equal (format "%S" fir) "quote")
;; if quoted, it is fine...
expr)
- (t (cons
+ (t (cons
(if (or (equal 0 (string-match sandbox-prefix (format "%S" fir)))
(member fir sandbox-allowed-words))
fir
+ ;; todo: bind this to its original name
(intern (concat sandbox-prefix (format "%S" fir))))
(mapcar 'sandbox (cdr expr))))))))
;; final condition.. --> when the expr is an atom.. It should be a
;; a constant.. or an allowed atom.. allowed == prefixed with fs-
(t (cond
- ((and (symbolp expr)
+ ((and (symbolp expr)
(equal 0 (string-match sandbox-prefix (format "%s" expr))))
expr)
((equal expr t) expr)
@@ -99,7 +98,7 @@ We WON'T do this by default since this could lead to exploits if you
;; a number or string now..
;; this actually happens when they feed byte-compiled code to
;; the bot, like:
- ;;, (funcall #[nil "\300\207" [1] 1])
+ ;;, (funcall #[nil "\300\207" [1] 1])
((not (or (symbolp expr) (numberp expr) (stringp expr)))
(error "%s %s" "Should not reach here. Quantum Tunnelling! "
"What are you trying to feed me? Byte-compiled code? Vectors?" ))
@@ -107,31 +106,119 @@ We WON'T do this by default since this could lead to exploits if you
))
+;; integrating erbot's sandbox functions
+
+(defvar sandbox-while-ctr 0)
+(defvar sandbox-while-max 10000)
+
+(defmacro sandbox-while (cond &rest body)
+ `(let
+ ((sandbox-while-ctr 0))
+ (while
+ ,cond
+ ;; this should enable the with-timeout checks..
+ ;; (sleep-for 0.01)
+ (if (> sandbox-while-ctr sandbox-while-max)
+ (error "Max while iterations exceeded: %S"
+ sandbox-while-ctr))
+ (incf sandbox-while-ctr)
+ nil
+ ,@body)))
+
+
+(defun sandbox-constant-object-p (object)
+ "If the object is a symbol like nil or t, a symbol that cannot be
+redefunned, return true. "
+ (or (member object (list nil t))
+ (keywordp object)))
+
+(defun sandbox-readonly-check (sym)
+ (if (get sym 'readonly)
+ (error "The symbol %S can't be redefined or set! It is read-only!"
+ sym)))
+
+(defun sandbox-create-defun-overwrite (sexps body fcn)
+ (cons body
+ (remove
+ (first (member-if
+ (lambda (arg) (equal (second arg) fcn))
+ sexps))
+ sexps)))
+
+(defmacro sandbox-defun (fcn args &rest body)
+ ;; the given fcn icould be a number or string, in which
+ ;; case sandboxing won't touch it, so we need to override that case.
+ (let ((docp nil)
+ (sandbox-fcn (cond
+ ((or (numberp fcn) (stringp fcn)) fcn)
+ (t (intern (concat sandbox-prefix (symbol-name fcn)))))))
+ (unless
+ (and (listp body)
+ (> (length body) 0))
+ (error "Function body should have a length of 1 or more"))
+ (unless (and (symbolp sandbox-fcn) (not (sandbox-constant-object-p sandbox-fcn)))
+ (error "Defun symbols only! :P"))
+ ;; doc string exists, and is followed by more stuff..
+ (when (and (> (length body) 1)
+ (stringp (first body)))
+ (setq docp t))
+ (sandbox-readonly-check sandbox-fcn)
+ (let ((is-interactive-form (equal '(interactive) (first body))))
+ (if docp
+ (cons 'defun
+ (cons sandbox-fcn
+ (cons args
+ (cons
+ (first body)
+ (cons
+ `(sandbox--check-args ,@args)
+ (cons
+ '(sit-for 0)
+ (cdr body)))))))
+ (cons 'defun
+ (cons sandbox-fcn
+ (cons args
+ (cons
+ `(sandbox--check-args ,@args)
+ (cons
+ '(sit-for 0)
+ body)))))))))
+
+(defun sandbox-eval (form &optional prefix)
+ (unless (or (stringp prefix) (eq nil prefix))
+ (error "Prefix should be a string"))
+ (let ((sandbox-prefix (or prefix sandbox-prefix))
+ (sandbox-defun-symbol (intern (concat sandbox-prefix "defun")))
+ (sandbox-while-symbol (intern (concat sandbox-prefix "while"))))
+ (flet ((sandbox-defun-symbol (fcn args &rest body ) (sandbox-defun fcn args body))
+ (sandbox-while-symbol (cond &rest body) (sandbox-while cond body)))
+ (eval (sandbox form)))))
+
(defvar sandbox-max-list-length 100)
(defmacro sandbox--check-args (&rest args)
"All we do in this macro we remove some bindings for things like
&rest, etc, things that do not have values but got passed to us --
this occurs when a user attempts to use &rest in his function
-definitions -- see `sandbox-allowed-words'.
+definitions -- see `sandbox-allowed-words'.
All the arguments to this macro should have been in their evalled form
and hence constants already, so we do not bother protecting against
multiple evaluations here -- evaluating a constant causes no harm.
All we do in this macro we remove some bindings for things like &rest,
etc, things that are not defined, but passed on here in any case."
- `(sandbox--check-args-nascent
- ,@(remove-if
+ `(sandbox--check-args-nascent
+ ,@(remove-if
#'(lambda (arg) (and
- (symbolp arg)
- (not (boundp arg))))
+ (symbolp arg)
+ (not (boundp arg))))
args)))
(defun sandbox--check-args-nascent (&rest args)
- (if (or
+ (if (or
(not (numberp sandbox-max-list-length))
(sandbox--safe-length-args-p args 0 sandbox-max-list-length))
t
View
62 spec/sandbox-spec.el
@@ -3,15 +3,15 @@
(describe "sandbox"
(it "returns nil when passed the empty list"
(should (null (sandbox '()))))
-
+
(it "rewrites any function as a function with a prefix"
(should (equal (sandbox '(hi t))
'(emacs-sandbox-hi t))))
-
+
(it "allows t, nil, &rest, &optional..."
(should (equal (sandbox '(t nil &rest &optional))
'(t nil &rest &optional))))
-
+
(it "passes a quoted form along as quoted"
;; should this be a preference?
(should (equal (sandbox ''(hi t))
@@ -20,10 +20,10 @@
(describe "sandbox--check-args"
(it "is true for an empty list"
(should (equal t (sandbox--check-args nil))))
-
+
(it "is true for a list with a single symbol"
(should (equal t (sandbox--check-args '(wtf)))))
-
+
(it "is true for a list with multiple symbols"
(should (equal t (sandbox--check-args '(wtf omg)))))
@@ -43,22 +43,44 @@
(should (sandbox--safe-length-args-p '((2 3) 2 5 6 7 ) 0 4))
(should-not (sandbox--safe-length-args-p '((2 3) 2) 0 2))))
-
-
+(describe "sandbox-defun"
+ (it "makes functions in the sandboxed namespace"
+ (progn
+ (sandbox-defun testfn (one two) (+ one two))
+ (should (eq 3 (emacs-sandbox-testfn 1 2)))))
+ (it "handles functions with docstrings too"
+ (progn
+ (sandbox-defun testfn (one two) "test function" (+ one two))
+ (should (eq 3 (emacs-sandbox-testfn 1 2))))))
+
+
+(describe "sandbox-while"
+ (it "wont allow infinite looping"
+ (should-error
+ (let ((i 0))
+ (sandbox-while t (incf i))))))
+
+(describe "sandbox-eval"
+ (it "will eval defuns in a different namespace"
+ ;; todo: make a test scenario that will actually pass
+ (should (eq 3
+ (sandbox-eval
+ '(progn (defun testfn (one two) (+ one two))
+ (testfn 1 2)))))))
;; actual spec tests
(describe "sandbox"
(it "forbids the user from executing the bad stuff"
- (with-mock2
+ (with-mock2
(defmock a-sensitive-function ())
- (should-error
+ (should-error
(eval (sandbox '(a-sensitive-function)))
-
+
:type 'void-function)
(should (= 0 (el-spec:called-count 'a-sensitive-function)))))
-
+
(it "allows the user to execute the good stuff"
- (with-mock2
+ (with-mock2
(defmock emacs-sandbox-not-sensitive ())
(eval (sandbox '(not-sensitive)))
(should (= 1 (el-spec:called-count 'emacs-sandbox-not-sensitive))))))
@@ -66,10 +88,16 @@
(describe "an infinite loop condition"
(it "cant allow looping, i guess"
- (should-error
+ (should-error
(eval (sandbox '(while t
(throw 'omg-should-not-even-be-allowed-to-run!!!)))))
- :type 'void-function))
+ :type 'void-function)
+
+ (it "wont loop forever with sandbox-eval"
+ (should-error
+ (sandbox-eval (sandbox '(while t (setq what-doing "looping")))))))
+
+
(defun emacs-sandbox-message (val))
@@ -77,9 +105,9 @@
(describe "user trying to access an outside variable"
(it "doesnt work"
(let ((a-secret 'shhhhh))
- (should-error
+ (should-error
(eval (sandbox '(message a-secret)))
-
+
:type 'void-variable
)
@@ -88,5 +116,5 @@
;;;;;;;;;;;;;;;;
;; need two types of specs to advance:
-;; the first is examples of
+;; the first is examples of
;;
Something went wrong with that request. Please try again.