~technomancy/fennel

First pass of restricted compiler environment. v1 PROPOSED

Phil Hagelberg: 1
 First pass of restricted compiler environment.

 13 files changed, 173 insertions(+), 82 deletions(-)
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~technomancy/fennel/patches/12115/mbox | git am -3
Learn more about email & git
View this thread in the archives

[PATCH] First pass of restricted compiler environment. Export this patch

This patch adds support for sandboxing the compiler as well as regular
execution. Previously there was no way to safely accept arbitrary
input since sandboxing would only apply to the compiled code, not to
macros and eval-compiler.

However, suddenly disallowing access to globals in compiler scope
would be a breaking change, so instead what we're doing is allowing
unsafe things thru but emitting a warning. In the future once we can
make a breaking change, (maybe for 1.0?) that warning will be changed
to an error.

The most awkward part about this change is that we have to allow
`require` because of a quirk in how we compile metadata; the compiled
code requires the fennel module and sets the docstring on the metadata
field of it. So we have to allow requiring the Fennel module. In the
default compiler-env we replace require with a new version which lets
thru the module as needed for docstrings and warns if you try to use
it for some other module.

The sandboxing can be disabled by launching Fennel with the
flag --no-compiler-sandbox or (if you're using the compiler API) by
passing in :compiler-env _G in the options table.

---
 .gitignore              |  1 +
 api.md                  |  5 ++++
 changelog.md            |  1 +
 reference.md            |  6 ++++
 src/fennel.fnl          |  1 +
 src/fennel/specials.fnl | 65 +++++++++++++++++++++++++++++++++--------
 src/fennel/utils.fnl    |  7 +++--
 src/launcher.fnl        |  5 +++-
 test/core.fnl           | 74 +++++++++--------------------------------------
 test/docstring.fnl      |  9 +++---
 test/init.lua           |  2 +-
 test/macro.fnl          | 77 +++++++++++++++++++++++++++++++++++++++++++++++++
 test/quoting.fnl        |  2 +-
 13 files changed, 173 insertions(+), 82 deletions(-)
 create mode 100644 test/macro.fnl

diff --git a/.gitignore b/.gitignore
index 7ba681e..b57406c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
/fennel
/fennel.lua
/downloads
/scratch.fnl

# Used to compile the Windows build
/lua-5.3.5/
diff --git a/api.md b/api.md
index 563159a..f50c826 100644
--- a/api.md
+++ b/api.md
@@ -22,6 +22,11 @@ usually accept these fields:
  literal or resolvable at compile time, falls back to `require` at runtime. Can be used to
  embed both fennel and Lua modules.
* `env`: an environment table in which to run the code; see the Lua manual.
* `compiler-env`: an environment table in which to run compiler-scoped code
  for macro definitions and `eval-compiler` calls. Internal Fennel functions
  such as `list`, `sym`, etc. will be exposed in addition to this table.
  Defaults to a table containing limited known-safe globals. Pass `_G` to 
  disable sandboxing.
* `unfriendly`: disable friendly compiler/parser error messages.

Note that only the `fennel` module is part of the public API. The
diff --git a/changelog.md b/changelog.md
index 271c03f..21445b3 100644
--- a/changelog.md
+++ b/changelog.md
@@ -2,6 +2,7 @@

## 0.5.1 / ???

* Sandbox compiler environment and emit a warning when it leaks.
* Fix a bug where repls would fail when provided with an overridden env.
* Expose `list?` and `sym?` in compiler API.
* Fix a bug where method calls would early-evaluate their receiver.
diff --git a/reference.md b/reference.md
index 1fd5e1e..0dd8b4b 100644
--- a/reference.md
+++ b/reference.md
@@ -998,6 +998,12 @@ This prints all the functions available in compiler scope.
Inside `eval-compiler`, `macros`, or `macro` blocks, as well as
`import-macros` modules, these functions are visible to your code.

As of 0.6.0 the compiler will warn you if you try to use globals outside a
certain predetermined safe list in a macro; this will turn into an error in a
future version of Fennel. You can disable this warning by providing the
command-line argument `--no-sandbox-compiler` or by passing `{:compiler-env
_G}` in the options table when invoking the compiler programmatically.

Note that lists are compile-time concepts that don't exist at runtime; they
are implemented as regular tables which have a special metatable to
distinguish them from regular tables defined with square or curly
diff --git a/src/fennel.fnl b/src/fennel.fnl
index 877c256..ba9b48d 100644
--- a/src/fennel.fnl
+++ b/src/fennel.fnl
@@ -107,6 +107,7 @@
      module-name "fennel.macros"
      _ (tset package.preload module-name #mod)
      env (specials.make-compiler-env nil compiler.scopes.compiler {})
      _ (set env.fennel mod)
      built-ins (eval builtin-macros {:env env
                                      :scope compiler.scopes.compiler
                                      :allowedGlobals false
diff --git a/src/fennel/specials.fnl b/src/fennel/specials.fnl
index ee36099..58b7731 100644
--- a/src/fennel/specials.fnl
+++ b/src/fennel/specials.fnl
@@ -812,6 +812,50 @@ Method name doesn't have to be known at compile-time; if it is, use
(doc-special "quote" ["x"]
            "Quasiquote the following form. Only works in macro/compiler scope.")

(local already-warned? {})

(local compile-env-warning
       (.. "WARNING: Attempting to %s %s in compile"
           " scope.\nIn future versions of Fennel this will not"
           " be allowed without the\n--no-compiler-sandbox flag"
           " or passing :compiler-env _G in options.\n"))

(fn compiler-env-warn [env key]
  "Warn once when allowing a global that the sandbox would normally block."
  (let [v (. _G key)]
    (when (and v io io.stderr (not (. already-warned? key)))
      (tset already-warned? key true)
      (error "NO")
      ;; Make this an error in a future release!
      (io.stderr:write (compile-env-warning:format "use global" key)))
    v))

(fn safe-metadata-require [name]
  "This is a stub replacement for require for use in macro contexts.
It provides just the minimum needed to allow metadata to function inside macros
but will not let any other modules thru without a warning."
  (let [module (require name)]
    ;; We can't use the module name to identify the fennel module; let's use
    ;; the presence of the metadata field instead.
    (if (or (not= :table (type module))
            (not= module.metadata compiler.metadata))
        (do (when (not (. already-warned? :require))
              (tset already-warned? :require true)
              ;; Make this an error in a future release!
              (io.stderr:write (compile-env-warning:format "require" name)))
            module)
        {:metadata compiler.metadata})))

;; Note that this is not yet the safe compiler env! Enforcing a compiler sandbox
;; is a breaking change, so we need to do it in a way that warns for several
;; releases before enforcing the sandbox.
(local safe-compiler-env
       (setmetatable {: table : math : string : pairs : ipairs : assert : error
                      : select : tostring : tonumber : pcall : xpcall : next
                      : print : type :bit _G.bit : setmetatable : getmetatable
                      :require safe-metadata-require}
                     {:__index compiler-env-warn}))

(fn make-compiler-env [ast scope parent]
  (setmetatable {:_AST ast ; state of compiler
                 :_CHUNK parent
@@ -820,12 +864,7 @@ Method name doesn't have to be known at compile-time; if it is, use
                 :_SPECIALS compiler.scopes.global.specials
                 :_VARARG (utils.varg)

                 ;; Useful for macros and meta programming. All of
                 ;; Fennel can be accessed via fennel.myfun, for example
                 ;; (fennel.eval "(print 1)").

                 :fennel utils.fennel-module
                 :unpack unpack
                 :unpack unpack ; compatibilty alias

                 ;; AST functions
                 :list utils.list
@@ -852,7 +891,9 @@ Method name doesn't have to be known at compile-time; if it is, use
                   (compiler.assert compiler.scopes.macro
                                    "must call from macro" ast)
                   (compiler.macroexpand form compiler.scopes.macro))}
                {:__index (or _ENV _G)}))
                {:__index (match utils.root.options
                            {: compiler-env} compiler-env
                            safe-compiler-env)}))

;; have search-module use package.config to process package.path (windows compat)
(local cfg (string.gmatch package.config "([^\n]+)"))
@@ -1010,11 +1051,11 @@ Consider using import-macros instead as it is more flexible.")
Lua output. The module must be a string literal and resolvable at compile time.")

(fn eval-compiler* [ast scope parent]
  (let [scope (compiler.make-scope compiler.scopes.compiler)
        luasrc (compiler.compile ast {:useMetadata utils.root.options.useMetadata
                                   :scope scope})
        loader (load-code luasrc (wrap-env (make-compiler-env ast scope parent)))]
    (loader)))
  (let [env (make-compiler-env ast scope parent)
        opts (utils.copy utils.root.options)]
    (set opts.scope (compiler.make-scope compiler.scopes.compiler))
    (set opts.allowedGlobals (macro-globals env (current-global-names)))
    ((load-code (compiler.compile ast opts) (wrap-env env)))))

(fn SPECIALS.macros [ast scope parent]
  (compiler.assert (= (# ast) 2) "Expected one table argument" ast)
diff --git a/src/fennel/utils.fnl b/src/fennel/utils.fnl
index 4b1915a..1053d20 100644
--- a/src/fennel/utils.fnl
+++ b/src/fennel/utils.fnl
@@ -47,9 +47,9 @@ Optionally takes a target table to insert the mapped values into."
          (tset out korv v))))
    out))

(fn copy [from]
(fn copy [from to]
  "Returns a shallow copy of its table argument. Returns an empty table on nil."
  (let [to []]
  (let [to (or to [])]
    (each [k v (pairs (or from []))]
      (tset to k v))
    to))
@@ -219,7 +219,8 @@ When f returns a truthy value, recursively walks the children."
(fn valid-lua-identifier? [str]
  (and (str:match "^[%a_][%w_]*$") (not (. lua-keywords str))))

(local propagated-options [:allowedGlobals :indent :correlate :useMetadata :env])
(local propagated-options [:allowedGlobals :indent :correlate :useMetadata
                           :env :compiler-env])

(fn propagate-options [options subopts]
  "Certain options should always get propagated onwards when a function that
diff --git a/src/launcher.fnl b/src/launcher.fnl
index 80b2810..a96979e 100644
--- a/src/launcher.fnl
+++ b/src/launcher.fnl
@@ -28,6 +28,7 @@ Run fennel, a lisp programming language for the Lua runtime.
  --compile-binary FILE
      OUT LUA_LIB LUA_DIR : Compile FILE to standalone binary OUT (experimental)
  --compile-binary --help : Display further help for compiling binaries
  --no-sandbox-compiler   : Do not limit compiler environment to minimal sandbox

  --help (-h)             : Display this text
  --version (-v)          : Show version
@@ -106,7 +107,9 @@ Run fennel, a lisp programming language for the Lua runtime.
    "--metadata" (do (set options.useMetadata true)
                     (table.remove arg i))
    "--no-metadata" (do (set options.useMetadata false)
                        (table.remove arg i))))
                        (table.remove arg i))
    "--no-compiler-sandbox" (do (set options.compiler-env _G)
                                (table.remove arg i))))

(when (not options.no_searcher)
  (let [opts []]
diff --git a/test/core.fnl b/test/core.fnl
index 5206018..9c107d1 100644
--- a/test/core.fnl
+++ b/test/core.fnl
@@ -219,64 +219,6 @@
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code {:correlate true}) expected code))))

(fn test-macros []
  (let [cases {"(-> (+ 85 21) (+ 1) (- 99))" 8
               "(-> 1234 (string.reverse) (string.upper))" "4321"
               "(-> 1234 string.reverse string.upper)" "4321"
               "(->> (+ 85 21) (+ 1) (- 99))" (- 8)
               "(-?> [:a :b] (table.concat \" \"))" "a b"
               "(-?> {:a {:b {:c :z}}} (. :a) (. :b) (. :c))" "z"
               "(-?> {:a {:b {:c :z}}} (. :a) (. :missing) (. :c))" nil
               "(-?>> \" \" (table.concat [:a :b]))" "a b"
               "(-?>> :w (. {:w :x}) (. {:x :missing}) (. {:y :z}))" nil
               "(-?>> :w (. {:w :x}) (. {:x :y}) (. {:y :z}))" "z"
               "(eval-compiler
             (tset _SPECIALS \"reverse-it\" (fn [ast scope parent opts]
               (tset ast 1 \"do\")
               (for [i 2 (math.ceil (/ (length ast) 2))]
                 (let [a (. ast i) b (. ast (- (length ast) (- i 2)))]
                   (tset ast (- (length ast) (- i 2)) a)
                   (tset ast i b)))
               (_SPECIALS.do ast scope parent opts))))
           (reverse-it 1 2 3 4 5 6)" 1
               "(eval-compiler (set tbl.nest ``nest))
          (tostring tbl.nest)" "(quote nest)"
               "(import-macros m :test.macros) (m.multigensym)" 519
               "(import-macros m :test.macros) (var x 1) (m.inc! x 2) (m.inc! x) x" 4
               "(import-macros test :test.macros {:inc INC} :test.macros)
          (INC (test.inc 5))" 7
               "(import-macros {:defn1 defn : ->1} :test.macros)
          (defn join [sep ...] (table.concat [...] sep))
          (join :: :num (->1 5 (* 2) (+ 8)))" "num:18"
               "(let [x [1]]
            (doto x (table.insert 2) (table.insert 3)) (table.concat x))" "123"
               "(macro five [] 5) (five)" 5
               "(macro greet [] :Hi!) (greet)" "Hi!"
               "(macro seq? [expr] (sequence? expr)) (seq? [65])" [65]
               "(macros {:m (fn [x] (set _G.sided x))}) (m 952) _G.sided" 952
               "(macros {:m (fn [y] `(let [xa# 1] (+ xa# ,y)))}) (m 4)" 5
               "(macros {:plus (fn [x y] `(+ ,x ,y))}) (plus 9 9)" 18
               "(macros {:when2 (fn [c val] `(when ,c ,val))})
          (when2 true :when2)" "when2"
               "(macros {:when3 (fn [c val] `(do (when ,c ,val)))})
          (when3 true :when3)" "when3"
               "(macros {:x (fn [] `(fn [...] (+ 1 1)))}) ((x))" 2
               "(macros {:yes (fn [] true) :no (fn [] false)}) [(yes) (no)]" [true false]
               "(require-macros \"test.macros\")
          (->1 9 (+ 2) (* 11))" 121
               "(require-macros \"test.macros\")
          (defn1 hui [x y] (global z (+ x y))) (hui 8 4) z" 12
               "(var (fh1 fh2) nil) [(with-open [f1 (io.tmpfile) f2 (io.tmpfile)]
          (set [fh1 fh2] [f1 f2]) (f1:write :asdf) (f1:seek :set 0) (f1:read :*a))
          (io.type fh1) (io.type fh2)]" ["asdf" "closed file" "closed file"]
               "(var fh nil) (local (ok msg) (pcall #(with-open [f (io.tmpfile)] (set fh f)
          (error :bork!)))) [(io.type fh) ok (msg:match :bork!)]" ["closed file" false "bork!"]
               "[(with-open [proc1 (io.popen \"echo hi\") proc2 (io.popen \"echo bye\")]
            (values (proc1:read) (proc2:read)))]" ["hi" "bye"]}]
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code {:correlate true}) expected code))
    (fennel.eval "(eval-compiler (set _SPECIALS.reverse-it nil))")))

(fn test-hashfn []
  (let [cases {"(#$.foo {:foo :bar})" "bar"
               "(#$2.foo.bar.baz nil {:foo {:bar {:baz :quux}}})" "quux"
@@ -300,6 +242,17 @@
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code {:correlate true}) expected code))))

(fn test-with-open []
  (let [cases {"(var (fh1 fh2) nil) [(with-open [f1 (io.tmpfile) f2 (io.tmpfile)]
          (set [fh1 fh2] [f1 f2]) (f1:write :asdf) (f1:seek :set 0) (f1:read :*a))
          (io.type fh1) (io.type fh2)]" ["asdf" "closed file" "closed file"]
               "(var fh nil) (local (ok msg) (pcall #(with-open [f (io.tmpfile)] (set fh f)
          (error :bork!)))) [(io.type fh) ok (msg:match :bork!)]" ["closed file" false "bork!"]
               "[(with-open [proc1 (io.popen \"echo hi\") proc2 (io.popen \"echo bye\")]
            (values (proc1:read) (proc2:read)))]" ["hi" "bye"]}]
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code) expected code))))

(fn test-match []
  (let [cases {"(let [_ :bar] (match :foo _ :should-match :foo :no))" "should-match"
               "(let [k :k] (match [5 :k] :b :no [n k] n))" 5
@@ -361,7 +314,8 @@
                _G.out"
               "(a {} [1 2])"}]
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code {:correlate true}) expected code))
      (l.assertEquals (fennel.eval code {:correlate true :compiler-env _G})
                      expected code))
    (let [mt (setmetatable [] {:__fennelview (fn [] "META")})]
      (l.assertEquals ((require "fennelview") mt) "META"))))

@@ -377,7 +331,7 @@
 : test-hashfn
 : test-if
 : test-loops
 : test-macros
 : test-with-open
 : test-match
 : test-method_calls
 : test-parsing}
diff --git a/test/docstring.fnl b/test/docstring.fnl
index 4cfafc8..9053a2f 100644
--- a/test/docstring.fnl
+++ b/test/docstring.fnl
@@ -1,5 +1,6 @@
(local l (require :test.luaunit))
(local fennel (require :fennel))
(local specials (require :fennel.specials))

(local doc-env (setmetatable {:print #$ :fennel fennel}
                             {:__index _G}))
@@ -26,10 +27,10 @@
    (l.assertEquals (eval code) expected msg)))

(fn test-no-undocumented []
  (let [undocumented-ok {:lua true :set-forcibly! true :include true "#" true}]
    (fennel.eval "(eval-compiler (set fennel._SPECIALS _SPECIALS))")
    (each [name (pairs fennel._SPECIALS)]
      (when (not (. undocumented-ok name))
  (let [undocumented-ok? {:lua true "#" true :set-forcibly! true}
        {: _SPECIALS} (specials.make-compiler-env)]
    (each [name (pairs _SPECIALS)]
      (when (not (. undocumented-ok? name))
        (let [docstring (eval (: "(doc %s)" :format name))]
          (l.assertNil (docstring:find "undocumented")
                       (.. "Missing docstring for " name)))))))
diff --git a/test/init.lua b/test/init.lua
index fcf0637..a37bdca 100644
--- a/test/init.lua
+++ b/test/init.lua
@@ -25,7 +25,7 @@ end

if(#arg == 0) then
   testall({'core', 'mangling', 'quoting', 'misc', 'docstring', 'fennelview',
            'failures', 'repl', 'cli',})
            'failures', 'repl', 'cli', 'macro'})
else
   testall(arg)
end
diff --git a/test/macro.fnl b/test/macro.fnl
new file mode 100644
index 0000000..f29680e
--- /dev/null
+++ b/test/macro.fnl
@@ -0,0 +1,77 @@
(local l (require :test.luaunit))
(local fennel (require :fennel))

(fn test-arrows []
  (let [cases {"(-> (+ 85 21) (+ 1) (- 99))" 8
               "(-> 1234 (string.reverse) (string.upper))" "4321"
               "(-> 1234 string.reverse string.upper)" "4321"
               "(->> (+ 85 21) (+ 1) (- 99))" (- 8)
               "(-?> [:a :b] (table.concat \" \"))" "a b"
               "(-?> {:a {:b {:c :z}}} (. :a) (. :b) (. :c))" "z"
               "(-?> {:a {:b {:c :z}}} (. :a) (. :missing) (. :c))" nil
               "(-?>> \" \" (table.concat [:a :b]))" "a b"
               "(-?>> :w (. {:w :x}) (. {:x :missing}) (. {:y :z}))" nil
               "(-?>> :w (. {:w :x}) (. {:x :y}) (. {:y :z}))" "z"}]
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code) expected code))))

(fn test-eval-compiler []
  (let [reverse "(eval-compiler
                   (tset _SPECIALS \"reverse-it\" (fn [ast scope parent opts]
                     (tset ast 1 \"do\")
                     (for [i 2 (math.ceil (/ (length ast) 2))]
                       (let [a (. ast i) b (. ast (- (length ast) (- i 2)))]
                         (tset ast (- (length ast) (- i 2)) a)
                         (tset ast i b)))
                     (_SPECIALS.do ast scope parent opts))))
                 (reverse-it 1 2 3 4 5 6)"
        nest-quote "(eval-compiler (set tbl.nest ``nest)) (tostring tbl.nest)"
        env (setmetatable {:tbl {}} {:__index _G})]
    (l.assertEquals (fennel.eval reverse) 1)
    (l.assertEquals (fennel.eval nest-quote {:compiler-env env :env env})
                    "(quote nest)")
    (fennel.eval "(eval-compiler (set _SPECIALS.reverse-it nil))")))

(fn test-import-macros []
  (let [multigensym "(import-macros m :test.macros) (m.multigensym)"
        inc "(import-macros m :test.macros) (var x 1) (m.inc! x 2) (m.inc! x) x"
        inc2 "(import-macros test :test.macros {:inc INC} :test.macros)
              (INC (test.inc 5))"
        rename "(import-macros {:defn1 defn : ->1} :test.macros)
                (defn join [sep ...] (table.concat [...] sep))
                (join :: :num (->1 5 (* 2) (+ 8)))"]
    (l.assertEquals (fennel.eval multigensym) 519)
    (l.assertEquals (fennel.eval inc) 4)
    (l.assertEquals (fennel.eval inc2) 7)
    (l.assertEquals (fennel.eval rename) "num:18")))

(fn test-require-macros []
  (let [arrow "(require-macros \"test.macros\") (->1 9 (+ 2) (* 11))"
        defn1 "(require-macros \"test.macros\")
               (defn1 hui [x y] (global z (+ x y))) (hui 8 4) z"]
    (l.assertEquals (fennel.eval arrow) 121)
    (l.assertEquals (fennel.eval defn1) 12)))

(fn test-inline-macros []
  (let [cases {"(macro five [] 5) (five)" 5
               "(macro greet [] :Hi!) (greet)" "Hi!"
               "(macro seq? [expr] (sequence? expr)) (seq? [65])" [65]
               "(macros {:m (fn [y] `(let [xa# 1] (+ xa# ,y)))}) (m 4)" 5
               "(macros {:plus (fn [x y] `(+ ,x ,y))}) (plus 9 9)" 18
               "(macros {:when2 (fn [c val] `(when ,c ,val))})
                (when2 true :when2)" "when2"
               "(macros {:when3 (fn [c val] `(do (when ,c ,val)))})
                (when3 true :when3)" "when3"
               "(macros {:x (fn [] `(fn [...] (+ 1 1)))}) ((x))" 2
               "(macros {:yes (fn [] true) :no (fn [] false)}) [(yes) (no)]"
               [true false]}
        g-using "(macros {:m (fn [x] (set _G.sided x))}) (m 952) _G.sided"]
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code) expected code))
    (l.assertEquals (fennel.eval g-using {:compiler-env _G}) 952)))

{: test-arrows
 : test-import-macros
 : test-require-macros
 : test-eval-compiler
 : test-inline-macros}
diff --git a/test/quoting.fnl b/test/quoting.fnl
index 1a88a0d..d73b33a 100644
--- a/test/quoting.fnl
+++ b/test/quoting.fnl
@@ -3,7 +3,7 @@
(local fennelview (require :fennelview))

(fn c [code]
  (fennel.compileString code {:allowedGlobals false}))
  (fennel.compileString code {:allowedGlobals false :compiler-env _G}))

(fn v [code]
  (fennelview ((fennel.loadCode (c code) _G)) {:one-line true}))
-- 
2.11.0