在某些值处评估以字符串形式给出的任意符号表达式

Question

我想让用户输入一个字符串,y作为x例如的函数的公式

fn <- "x^2 + exp(3*x)"

然后我想在某些点评估这个表达式,例如对于.的值x <- 1:0.1:100.

我知道我能做到:

x <- 1:0.1:100
y <- eval(parse(text = fn))

但是,如果用户提供fn的不是公式,这会使我的计算机受到攻击

fn <- 'x; print("Your computer is compromised")'

有没有其他方法可以实现我想要做的事情？

Answer 1

R最酷的功能之一是它可以处理自己的语言,因此您可以创建一个函数白名单并检查表达式:

# Function to check if an expression is safe
is_safe_call <- function(text, allowed.funs) {
  # Recursive function to evaluate each element in the user expression
  safe_fun <- function(call, allowed.funs) {
    if(is.call(call)) {
      call.l <- as.list(call)
      if(!is.name(call.l[[1L]]) || !as.character(call.l[[1L]]) %in% allowed.funs)
        stop(as.character(call.l[[1L]]), " is not an allowed function")
      lapply(tail(call.l, -1L), safe_fun, allowed.funs)
    }
    TRUE
  }
  # parse and call recursive function
  expr <- parse(text=text)
  if(length(expr) > 1L) stop("Only single R expressions allowed")
  safe_fun(expr[[1L]], allowed.funs)
}

然后我们定义允许功能的白名单.非常重要的是,您要非常小心这里允许的内容.特别是,如果你允许parse,eval或有可能令人不快的副作用(任何功能system,unlink等等),你睁大你的系统的攻击.

allowed.funs <- c("+", "exp", "*", "^", "-", "sqrt")

我们测试:

is_safe_call("x^2 + exp(3*x)", allowed.funs)
## [1] TRUE
is_safe_call("x^2 - sqrt(3*x)", allowed.funs)
## [1] TRUE
is_safe_call("unlink('~', recursive=TRUE)", allowed.funs)
## Error in safe_fun(parse(text = text)[[1L]], allowed.funs) : 
##   unlink is not an allowed function
is_safe_call("x + sqrt(unlink('~', recursive=TRUE))", allowed.funs)
## Error in FUN(X[[i]], ...) : unlink is not an allowed function
is_safe_call('x; print("Your computer is compromised")')
## Error in is_safe_call("x; print(\"Your computer is compromised\")") : 
##   Only single R expressions allowed

此处不存在任何明示或暗示的担保.可能有一种方法可以解决这个我没有想过的问题,所以不要在没有经过仔细审查的情况下将其放在面向公众的服务器上,但我认为这可能会起作用.

请注意,如果某人可以提供某种方式破解parse自己的表达,那么您可能会以这种方式受到攻击.

编辑:本·博尔克提出了一个聪明的技巧,试图破解这个,但这个功能是强大的:

is_safe_call("exp <- function(...) system(\"echo do bad stuff\")", allowed.funs)
## Error in safe_fun(expr[[1L]], allowed.funs) :
##  <- is not an allowed function
allowed.funs <- c("+", "exp", "*", "^", "-", "sqrt", "<-")
is_safe_call("exp <- function(...) system(\"echo do bad stuff\")", allowed.funs)
## Error in FUN(X[[i]], ...) : function is not an allowed function
allowed.funs <- c("+", "exp", "*", "^", "-", "sqrt", "<-", "function")  
is_safe_call("exp <- function(...) system(\"echo do bad stuff\")", allowed.funs)
## Error in FUN(X[[i]], ...) : system is not an allowed function