Evaluate an arbitrary symbolic expression given as a string at some values

Question

I would like to let a user enter a string, for a formula for y as a function of x, e.g.

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

I would then like to evaluate this expression at some points, e.g. for values of x <- 1:0.1:100.

I know I can do:

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

However, this leaves my computer open to attacks if the user supplies fn which is not a formula

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

Are there any alternative ways of achieving what I want to do?

Answer 1

One of R's coolest features is that it can process its own language, so you can create a function white list and check expressions against it:

# 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)
}

We then define a whitelist of allowable functions. It is very important that you are extremely careful about what you allow in here. In particular, if you allow parse, eval, or any functions with possible unpleasant side effects (system, unlink, etc.) you open your system wide for attack.

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

And we test:

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

No waranties express or implied in this. There may be a way to hack this that I haven't thought of, so don't put this on a public facing server without extensive scrutiny, but I think this might just work.

Note that if someone can provide an expression that somehow hacks parse itself, then you can be compromised that way.

---

EDIT: Ben Bolker suggested a clever trick to try to hack this, but this function is robust to that:

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