commit 2a8e8edb143b37ee68b2c500553dc98f6797f4f8 (HEAD -> refs/heads/main)
Author: Phil Hagelberg <phil@hagelb.org>
Date:   Fri Jun 11 17:48:14 2021 -0700

    Improve compiler sandbox.
    
    TODO: document what's going on

    Modified   src/fennel.fnl
diff --git a/src/fennel.fnl b/src/fennel.fnl
index 3162798..c03d6c6 100644
--- a/src/fennel.fnl
+++ b/src/fennel.fnl
@@ -25,14 +25,17 @@
 (local repl (require :fennel.repl))
 (local view (require :fennel.view))
 
-(fn eval-env [env]
+(fn eval-env [env opts]
   ;; This is ... not great. Should we expose make-compiler-env in the API?
   ;; Don't use this; it's subject to change in future versions!
   (if (= env :_COMPILER)
       (let [env (specials.make-compiler-env nil compiler.scopes.compiler {})
             mt (getmetatable env)]
-        ;; remove sandboxing; linting won't work with it
-        (set mt.__index _G)
+        ;; re-enable globals-checking; previous globals-checking below doesn't
+        ;; work on the compiler env because of the sandbox.
+        (when (= opts.allowedGlobals nil)
+          ;; TODO: get the actual sandboxed values only!!!
+          (set opts.allowedGlobals (specials.current-global-names env)))
         (specials.wrap-env env))
       (and env (specials.wrap-env env))))
 
@@ -40,11 +43,7 @@
   (let [opts (utils.copy options)]
     ;; eval and dofile are considered "live" entry points, so we can assume
     ;; that the globals available at compile time are a reasonable allowed list
-    ;; UNLESS there's a metatable on env, in which case we can't assume that
-    ;; pairs will return all the effective globals; for instance openresty
-    ;; sets up _G in such a way that all the globals are available thru
-    ;; the __index meta method, but as far as pairs is concerned it's empty.
-    (when (and (= opts.allowedGlobals nil) (not (getmetatable opts.env)))
+    (when (= opts.allowedGlobals nil)
       (set opts.allowedGlobals (specials.current-global-names opts.env)))
     ;; if the code doesn't have a filename attached, save the source in order
     ;; to provide targeted error messages.
@@ -56,7 +55,7 @@
 
 (fn eval [str options ...]
   (let [opts (eval-opts options str)
-        env (eval-env opts.env)
+        env (eval-env opts.env opts)
         lua-source (compiler.compile-string str opts)
         loader (specials.load-code lua-source env
                                    (if opts.filename
    Modified   src/fennel/specials.fnl
diff --git a/src/fennel/specials.fnl b/src/fennel/specials.fnl
index 5284a8f..228a1d8 100644
--- a/src/fennel/specials.fnl
+++ b/src/fennel/specials.fnl
@@ -36,7 +36,14 @@ will see its values updated as expected, regardless of mangling rules."
                             (values next (utils.kvmap env putenv) nil))}))
 
 (fn current-global-names [env]
-  (utils.kvmap (or env _G) compiler.global-unmangling))
+  ;; if there's a metatable on env, we need to make sure it's one that has a
+  ;; __pairs metamethod, otherwise we give up entirely on globals checking.
+  ;; newer lua versions know about __pairs natively but 5.1 and luajit don't.
+  (let [mt (match (getmetatable env)
+             {: __pairs} (collect [k v (__pairs env)] (values k v))
+             {} nil
+             nil (or env _G))]
+    (and mt (utils.kvmap mt compiler.global-unmangling))))
 
 (fn load-code [code environment filename]
   "Load Lua code with an environment in all recent Lua versions"
@@ -936,7 +943,7 @@ Only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
 (doc-special :quote [:x]
              "Quasiquote the following form. Only works in macro/compiler scope.")
 
-(local already-warned? {})
+(local already-warned? {:_G true})
 
 (local compile-env-warning (-> ["WARNING: Attempting to %s %s in compile scope."
                                 "In future versions of Fennel this will not be allowed without the"
@@ -991,48 +998,63 @@ Only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
                  :rawlen (rawget _G :rawlen)}
                 {:__index (if strict? nil compiler-env-warn)}))
 
+(fn sandbox-pairs [env]
+  (let [combined {}
+        {: __index} (getmetatable env)]
+    (when (= :table (type __index))
+      (each [k v (pairs __index)]
+        (tset combined k v)))
+    (each [k v (values next env nil)]
+      (tset combined k v))
+    (values next combined nil)))
+
 (fn make-compiler-env [ast scope parent strict?]
-  (setmetatable {:_AST ast
-                 :_CHUNK parent
-                 :_IS_COMPILER true
-                 :_SCOPE scope
-                 :_SPECIALS compiler.scopes.global.specials
-                 :_VARARG (utils.varg)
-                 : unpack
-                 :assert-compile compiler.assert
-                 ;; AST functions
-                 :list utils.list
-                 :list? utils.list?
-                 :multi-sym? utils.multi-sym?
-                 :sequence utils.sequence
-                 :sequence? utils.sequence?
-                 :sym utils.sym
-                 :sym? utils.sym?
-                 :table? utils.table?
-                 :varg? utils.varg?
-                 : view
-                 ;; scoping functions
-                 :gensym (fn [base]
-                           (utils.sym (compiler.gensym (or compiler.scopes.macro
-                                                           scope)
-                                                       base)))
-                 :get-scope (fn []
-                              compiler.scopes.macro)
-                 :in-scope? (fn [symbol]
-                              (compiler.assert compiler.scopes.macro
-                                               "must call from macro" ast)
-                              (. compiler.scopes.macro.manglings
-                                 (tostring symbol)))
-                 :macroexpand (fn [form]
-                                (compiler.assert compiler.scopes.macro
-                                                 "must call from macro" ast)
-                                (compiler.macroexpand form
-                                                      compiler.scopes.macro))}
-                {:__index (match utils.root.options
-                            {:compiler-env :strict} (safe-compiler-env true)
-                            {: compilerEnv} compilerEnv
-                            {: compiler-env} compiler-env
-                            _ (safe-compiler-env false))}))
+  (let [provided (match utils.root.options
+                   {:compiler-env :strict} (safe-compiler-env true)
+                   {: compilerEnv} compilerEnv
+                   {: compiler-env} compiler-env
+                   _ (safe-compiler-env strict?))
+        env {:_AST ast
+             :_CHUNK parent
+             :_IS_COMPILER true
+             :_SCOPE scope
+             :_SPECIALS compiler.scopes.global.specials
+             :_VARARG (utils.varg)
+             : unpack
+             :assert-compile compiler.assert
+             ;; AST functions
+             :list utils.list
+             :list? utils.list?
+             :multi-sym? utils.multi-sym?
+             :sequence utils.sequence
+             :sequence? utils.sequence?
+             :sym utils.sym
+             :sym? utils.sym?
+             :table? utils.table?
+             :varg? utils.varg?
+             : view
+             ;; scoping functions
+             :gensym (fn [base]
+                       (utils.sym (compiler.gensym (or compiler.scopes.macro
+                                                       scope)
+                                                   base)))
+             :get-scope (fn []
+                          compiler.scopes.macro)
+             :in-scope? (fn [symbol]
+                          (compiler.assert compiler.scopes.macro
+                                           "must call from macro" ast)
+                          (. compiler.scopes.macro.manglings
+                             (tostring symbol)))
+             :macroexpand (fn [form]
+                            (compiler.assert compiler.scopes.macro
+                                             "must call from macro" ast)
+                            (compiler.macroexpand form
+                                                  compiler.scopes.macro))}]
+    (set env._G env)
+    (setmetatable env
+                  {:__index provided
+                   :__newindex provided
+                   :__pairs sandbox-pairs})))
 
 ;; have search-module use package.config to process package.path (windows compat)
 (local cfg (string.gmatch package.config "([^\n]+)"))
    Modified   src/linter.fnl
diff --git a/src/linter.fnl b/src/linter.fnl
index aa6f098..5041b7b 100644
--- a/src/linter.fnl
+++ b/src/linter.fnl
@@ -31,7 +31,7 @@ Doesn't do any linting on its own; just saves the data for other linters."
 (fn check-module-fields [symbol scope]
   "When referring to a field in a local that's a module, make sure it exists."
   (let [[module-local field] (or (multi-sym? symbol) [])
-        module-name (-?> scope.symmeta (. (tostring f-local)) (. :required))
+        module-name (-?> scope.symmeta (. (tostring module-local)) (. :required))
         module (and module-name (require module-name))]
     (assert-compile (or (= module nil) (not= (. module field) nil))
                     (string.format "Missing field %s in module %s"
@@ -46,12 +46,12 @@ Doesn't do any linting on its own; just saves the data for other linters."
         [f-local field] (or (multi-sym? f) [])
         module-name (-?> scope.symmeta (. (tostring f-local)) (. :required))
         module (and module-name (require module-name))]
-    (when (and (arity-check? module) debug debug.getinfo
+    (when (and (arity-check? module) _G.debug _G.debug.getinfo
                (not (varg? last-arg)) (not (list? last-arg)))
       (assert-compile (= (type (. module field)) :function)
                       (string.format "Missing function %s in module %s"
                                      (or field :?) module-name) f)
-      (match (debug.getinfo (. module field))
+      (match (_G.debug.getinfo (. module field))
         {: nparams :what "Lua" :isvararg true}
         (assert-compile (<= nparams (# args))
                         (: "Called %s.%s with %s arguments, expected %s+"
    Modified   test/failures.fnl
diff --git a/test/failures.fnl b/test/failures.fnl
index fd99bcb..bdcbb26 100644
--- a/test/failures.fnl
+++ b/test/failures.fnl
@@ -82,6 +82,8 @@
   "\"\\!\"" (if (or (not= _VERSION "Lua 5.1") _G.jit) "Invalid string")
   ;; macros should shadow locals as values, not just when calling:
   "(let [t {:b 2}] (import-macros t :test.macros) t.b)" "tried to reference a macro"
+  ;; strict mode applies to macro modules too
+  "(import-macros t :test.bad.unknown-global)" "unknown global in strict mode"
 })
 
 (fn test-failures []

[back] 

Generated by Phil Hagelberg using scpaste at Fri Jun 11 17:48:22 2021. PDT. (original)