R 自定义环境中的作用域（函数）

我想在沙盒环境中使用一个特殊（虚拟）函数：

disable.system.call <- function(...) {
    mc <- match.call()
    if (grepl('system', deparse(mc[[2]])))
        stop('NONO')
    eval(mc, env = .GlobalEnv)        
}

这非常酷，因为没有

系统

内部的调用就像一个符咒，但过滤器可以工作：

> eval(parse(text = 'model.frame("1 ~ 1")'), envir = e)
  1
1 1
> eval(parse(text = 'model.frame(\'1 ~ system("ls -la")\')'), envir = e)
Error in model.frame("1 ~ system(\"ls -la\")") : NONO

它甚至使用了

lm

调用，该调用调用调用了

model.frame

，在其内部发现了一个类似字符串的公式：

> eval(parse(text = 'lm(\'1 ~ system("ls -la")\')'), envir = e)
Error in model.frame(formula = "1 ~ system(\"ls -la\")", drop.unused.levels = TRUE) : 
  NONO

我试着更进一步，将这个非常简单的函数（

disable.system.call

）分配给

as.formula

，它是从

model.frame

调用的。不幸的是，我没有走到这一步：

> e <- new.env()
> eval(parse(text = 'as.formula <- disable.system.call'), envir = e)
> eval(parse(text = 'as.formula("1 ~ 1")'), envir = e)
1 ~ 1
> eval(parse(text = 'as.formula(\'1 ~ system("ls -la")\')'), envir = e)
Error in as.formula("1 ~ system(\"ls -la\")") : NONO
> eval(parse(text = 'model.frame(\'1 ~ system("ls -la")\')'), envir = e)
  1 system("ls -la")
1 1                0
> eval(parse(text = 'lm(\'1 ~ system("ls -la")\')'), envir = e)

Call:
lm(formula = "1 ~ system(\"ls -la\")")

Coefficients:
     (Intercept)  system("ls -la")  
           1                NA  

---

>e eval（parse（text='as.formula如果您不希望人们能够使用
系统
，那么覆盖定义会更容易

assignInNamespace(
  "system", 
  function(...) stop("system calls are not allowed"), 
  getNamespace("base")
)

system("pwd")  #throws an error


我在疯狂地猜测您的用例，但是您是否允许用户将任意R代码传递给其他应用程序？在这种情况下，您可能希望编译您自己的R版本，删除危险的函数或用假人替换这些函数


调用函数时执行自定义代码的另一种可能性是
trace

trace(system, quote(stop("You have called system")))  #you may also want print = FALSE

虽然您怀疑情况并非如此，但正在调用的是
stats:：：model.frame.default
，而不是环境
e
中的自定义版本（这当然是您通常希望从打包函数中看到的行为。在第一个示例中看到的奇怪作用域是一种特殊情况，因为
lm（）
“非标准评估”的使用，这在我的答案底部进行了讨论）

如下所示，您可以使用
trace（）
查看在您的每个案例中调用的
As.formula（）
的版本：

disable.system.call <- function(...) {
    mc <- match.call()
    if (grepl('system', deparse(mc[[2]])))
        stop('NONO')
    eval(mc, env = .GlobalEnv)        
}
e <- new.env()
eval(parse(text = 'as.formula <- disable.system.call'), envir = e)


# (1) trace custom 'as.formula()' in environment e
trace(e$as.formula)


# Calling model.frame() **does not** call the the custom as.formula()
eval(parse(text = 'model.frame(\'1 ~ system("ls -la")\')'), envir = e)
#   1 system("ls -la")
# 1 1              127

# (2) trace stats:::as.formula()
trace(stats:::as.formula)

# Calling model.frame() **does** call stats:::as.formula()
eval(parse(text = 'model.frame(\'1 ~ system("ls -la")\')'), envir = e)
# trace: as.formula
#   1 system("ls -la")
# 1 1              127

谢谢，这个答案也很方便（+1）！事实上，我不想禁止所有
系统
调用，这只是一个简单的POC示例，但我确实想实现一个沙盒环境。请看：无论如何，
assignInNamespace
似乎很有希望，我需要一些时间在复活节后做一些实验，肯定会给出更详细的反馈。项目不错。哈你看过Live-R吗，它也有类似的功能？从没听说过Live-R，谢谢你让我注意到这一简洁的软件！我确实在做类似的事情，但有特殊的（预期的）受众。我们将看到：）无论如何，关于你的答案：as
？assignInNamespace
建议不要在软件包中使用此功能（如我所愿）并且不允许我启用/禁用沙盒环境，似乎我必须找到另一种方法来停用这些调用。如
grep
ing R sources for simular functions:）我想做的是在特殊环境中运行调用，除此之外，任何东西都是允许的（对于系统端调用）。谢谢，您的回答非常有用（+1）-尽管我已经查看了相关的R源（当然我意识到，
model.frame.default
被调用，因为没有其他方法-如果我是对的话），我只是以某种方式传递了
eval
调用
lm
的源代码。这当然让事情变得清楚了！我只需要找到一种简单的方法来强制函数使用我的特殊
as.formula
（如@RichieCotton的anwer），或向所有出现的
as.formula
等的grep R源代码。啊，也谢谢你的pdf！
disable.system.call <- function(...) {
    mc <- match.call()
    if (grepl('system', deparse(mc[[2]])))
        stop('NONO')
    eval(mc, env = .GlobalEnv)        
}
e <- new.env()
eval(parse(text = 'as.formula <- disable.system.call'), envir = e)


# (1) trace custom 'as.formula()' in environment e
trace(e$as.formula)


# Calling model.frame() **does not** call the the custom as.formula()
eval(parse(text = 'model.frame(\'1 ~ system("ls -la")\')'), envir = e)
#   1 system("ls -la")
# 1 1              127

# (2) trace stats:::as.formula()
trace(stats:::as.formula)

# Calling model.frame() **does** call stats:::as.formula()
eval(parse(text = 'model.frame(\'1 ~ system("ls -la")\')'), envir = e)
# trace: as.formula
#   1 system("ls -la")
# 1 1              127

mf <- match.call(expand.dots = FALSE)
...
mf[[1L]] <- as.name("model.frame")
mf <- eval(mf, parent.frame())