0

I'm building an R REST API where I can expose some R functions/models.

I started with this question: Suggestions needed for building R server REST API's that I can call from external app?

Added a little extra processing, and started using httpuv's daemonized server function.

And it's up and working. My concern is whether or not this is safe to do. How can I be sure that I'm responding correctly to improper requests and that there's no way for a person to accidentally/maliciously inject code.

Right now, they can call the api with http://IPADDRESS:PORT/FUNCTION?a=VALUE&b=VALUE

Is there a good way in the midst of all this text-parsing to validate my inputs?

(It's all on our internal network, so I'm not too concerned about the malicious side, but I'd really like to know the limitations here)

Is this a "Here there be dragons" situation?

CODE:

library(httpuv)
library(RCurl)
library(httr)
library(jsonlite)

Start with some functions:

#################################################################################
# API Functions
#################################################################################
APIoperations <-
  list(
    Add = function(a,b) a + b,
    Subtract = function(a,b) a - b,
    Multiply = function(a,b) a*b,
    Divide = function(a,b) a/b
  )

Do some validation:

#################################################################################
# Check if Operation is Supported
#################################################################################
validateOperation <- function(op) {
  if(op %in% names(APIoperations)) {
    op
  } else {
    # DO OTHER THINGS HERE
    # LOG, etc...
    'Unsupported'
  }
}

Format of an Error:

#################################################################################
# General Error Format
#################################################################################
returnError <- function(error = '',
                        status = 500L,
                        headers = list('Content-Type' = 'text/html'),
                        body = paste('\r\n<html><body>',error,'</body></html>')) {
  list(status = status,
       headers = headers,
       body = body)
}

And then my actual server Logic:

#################################################################################
#################################################################################
# Start Server Logic
#################################################################################
#################################################################################
app <-
  list(call =
         function(req) {
           #################################################################################
           # Grab and Parse Query
           # Only include acceptable characters

           query <- req$QUERY_STRING

           if(validateOperation(gsub('[[:punct:]]','',req$PATH_INFO)) == 'Unsupported') {
             return(list(status=501L,
                         headers=list('Content-Type' = 'text/html'),
                         body= "\r\n<html><body>Error 501<br>Unsupported Operation</body></html>"))
           }
           #################################################################################
           # Strip any punctuation in this case, other cases may need a specific parsing
           funcname <- gsub('[[:punct:]]','',req$PATH_INFO)

           #################################################################################
           # Requested Function
           reqfunc <- APIoperations[[funcname]]

           #################################################################################
           # Function Parameters
           vars <- names(formals(reqfunc))

           #################################################################################
           # Parse
           qs <- try(httr:::parse_query(gsub("^\\?", "", query)))

           #################################################################################
           # If missing vars return error
           if(!all(names(qs) %in% vars) | !all(vars %in% names(qs))) {
             errorFeed <- 'Missing Variables, or improper Code'
             returnError(errorFeed)
           }

           #################################################################################
           # Return Status 200 and type JSON
           status <- 200L
           headers <- list('Content-Type' = "application/json")


           if (!is.character(query) || identical(query, "")) {
             body <- "\r\n<html><body></body></html>"
           } else {
             body <- jsonlite::toJSON(x = list(result = do.call(reqfunc,lapply(qs,as.numeric))))
           }

           # Print Query String for testing purposes
           print(req$QUERY_STRING)


           ret <- list(status=status,
                       headers=headers,
                       body=body)

           return(ret)

         }

message("Starting server...")

Then I start the Server with:

server <- httpuv::startDaemonizedServer(<MYIPADDRESS>, <PORT>, app=app)

And stop it with:

httpuv::stopDaemonizedServer(server)
Community
  • 1
  • 1
Shape
  • 2,892
  • 19
  • 31
  • 1
    wow, there are packages that wrap a lot of this up for you. I've used `fastRWeb` to do this in the past and it's great. – cory Jul 26 '16 at 17:35
  • I'll take a look through their documentation, they may have the answers there. I'm curious if there is ever an issue with R functions and special characters, I don't know that a lot of R functions were built with security in mind. – Shape Jul 26 '16 at 17:49

0 Answers0