Merge branch 'master' into appveyor

* master:
  Protect from unsafe JSON parsing behavior. (rstudio#325)
  use `inherits(obj, "xxx")` and `expect_s3_class(obj, "xxx")` rather than "xxx" %in% class(obj) (rstudio#313)
  Multiline POST body collapsed (rstudio#297)
  Install plumber from CRAN in top level Docker file (rstudio#292)

DESCRIPTION

@@ -52,6 +52,7 @@ Collate:
     'digital-ocean.R'
     'find-port.R'
     'includes.R'
+    'json.R'
     'new-rstudio-project.R'
     'paths.R'
     'plumber-static.R'

Dockerfile

@@ -6,9 +6,9 @@ RUN apt-get update -qq && apt-get install -y \
   libssl-dev \
   libcurl4-gnutls-dev
 
-RUN R -e 'install.packages(c("devtools"))'
-
-RUN R -e 'devtools::install_github("trestletech/plumber")'
+## RUN R -e 'install.packages(c("devtools"))'
+## RUN R -e 'devtools::install_github("trestletech/plumber")'
+RUN install2.r plumber
 
 EXPOSE 8000
 ENTRYPOINT ["R", "-e", "pr <- plumber::plumb(commandArgs()[4]); pr$run(host='0.0.0.0', port=8000)"]

NAMESPACE

@@ -29,7 +29,6 @@ importFrom(grDevices,dev.off)
 importFrom(grDevices,jpeg)
 importFrom(grDevices,png)
 importFrom(httpuv,runServer)
-importFrom(jsonlite,fromJSON)
 importFrom(stats,runif)
 importFrom(utils,URLdecode)
 importFrom(utils,URLencode)

NEWS.md

@@ -1,7 +1,12 @@
 plumber 0.4.7
 --------------------------------------------------------------------------------
 * Add support for swagger for mounted routers (@bradleyhd, [#274](https://github.com/trestletech/plumber/issues/274)).
-
+* BUGFIX: A multiline POST body is now collapsed to a single line ([#270](https://github.com/trestletech/plumber/issues/270)).
+* SECURITY: Wrap `jsonlite::fromJSON` to ensure that `jsonlite` never reads
+  input as a remote address (such as a file path or URL) and attempts to parse
+  that. The only known way to exploit this behavior in plumber unless an
+  API were using encrypted cookies and an attacker knew the encryption key in
+  order to craft arbitrary cookies.
 
 plumber 0.4.6
 --------------------------------------------------------------------------------

R/digital-ocean.R

@@ -168,7 +168,6 @@ install_new_r <- function(droplet){
 #' @param force If `FALSE`, will abort if it believes that the given domain name
 #'   is not yet pointing at the appropriate IP address for this droplet. If
 #'   `TRUE`, will ignore this check and attempt to proceed regardless.
-#' @importFrom jsonlite fromJSON
 #' @export
 do_configure_https <- function(droplet, domain, email, termsOfService=FALSE, force=FALSE){
   checkAnalogSea()
@@ -191,7 +190,7 @@ do_configure_https <- function(droplet, domain, email, termsOfService=FALSE, for
     # from the droplet to get a real-time response.
     metadata <- droplet_capture(droplet, "curl http://169.254.169.254/metadata/v1.json")
 
-    parsed <- jsonlite::fromJSON(metadata)
+    parsed <- safeFromJSON(metadata)
     floating <- unlist(lapply(parsed$floating_ip, function(ipv){ ipv$ip_address }))
     ephemeral <- unlist(parsed$interfaces$public)["ipv4.ip_address"]
 

R/json.R

@@ -0,0 +1,7 @@
+safeFromJSON <- function(txt, ...){
+  if (!jsonlite::validate(txt)){
+    stop("Argument 'txt' is not a valid JSON string.")
+  }
+
+  jsonlite::fromJSON(txt, ...)
+}

R/plumber.R

@@ -54,7 +54,7 @@ plumb <- function(file, dir="."){
 
     # source returns a list with value and visible elements, we want the (visible) value object.
     pr <- x$value
-    if (!("plumber" %in% class(pr))){
+    if (!inherits(pr, "plumber")){
       stop("entrypoint.R must return a runnable Plumber router.")
     }
 
@@ -349,11 +349,11 @@ plumber <- R6Class(
               printNode(node[[i]], name, childPref, isLast = i == length(node))
             }
           }
-        } else if ("plumber" %in% class(node)){
+        } else if (inherits(node, "plumber")){
           cat(prefix, "\u251c\u2500\u2500/", name, "\n", sep="") # "+--"
           # It's a router, let it print itself
           print(node, prefix=childPref, topLevel=FALSE)
-        } else if ("PlumberEndpoint" %in% class(node)){
+        } else if (inherits(node, "PlumberEndpoint")){
           printEndpoints(prefix, name, node, isLast)
         } else {
           cat("??")

R/post-body.R

@@ -1,7 +1,7 @@
 postBodyFilter <- function(req){
   handled <- req$.internal$postBodyHandled
   if (is.null(handled) || handled != TRUE){
-    body <- req$rook.input$read_lines()
+    body <- paste0(req$rook.input$read_lines(), collapse = "\n")
     charset <- getCharacterSet(req$HTTP_CONTENT_TYPE)
     args <- parseBody(body, charset)
     req$postBody <- body
@@ -26,8 +26,7 @@ parseBody <- function(body, charset = "UTF-8"){
 
   # Is it JSON data?
   if (stri_startswith_fixed(body, "{")) {
-    # Handle JSON with jsonlite
-    ret <- jsonlite::fromJSON(body)
+    ret <- safeFromJSON(body)
   } else {
     # If not handle it as a query string
       ret <- parseQS(body)

R/session-cookie.R

@@ -36,7 +36,7 @@ sessionCookie <- function(key, name="plumber", ...){
             session <- PKI::PKI.decrypt(session, key, "aes256")
             session <- rawToChar(session)
 
-            session <- jsonlite::fromJSON(session)
+            session <- safeFromJSON(session)
           }, error=function(e){
             warning("Error processing session cookie. Perhaps your secret changed?")
             session <<- NULL

tests/testthat/test-json.R

@@ -0,0 +1,13 @@
+context("JSON")
+
+test_that("safeFromJSON is safe", {
+  # Valid JSON works
+  a <- safeFromJSON('{"key": "value"}')
+  expect_equal(a, list(key="value"))
+
+  # File paths fail
+  expect_error(safeFromJSON("/etc/passwd"), "not a valid JSON string")
+
+  # Remote URLs fail
+  expect_error(safeFromJSON("http://server.org/data.json"), "not a valid JSON string")
+})

tests/testthat/test-plumber.R

@@ -133,8 +133,8 @@ test_that("routes can be constructed correctly", {
   pr$mount("/static", stat)
 
   expect_length(pr$routes, 3)
-  expect_true("plumberstatic" %in% class(pr$routes[["static"]]))
-  expect_true("plumber" %in% class(pr$routes[["mysubpath"]]))
+  expect_s3_class(pr$routes[["static"]], "plumberstatic")
+  expect_s3_class(pr$routes[["mysubpath"]], "plumber")
 
   # 2 endpoints at the same location (different verbs)
   expect_length(pr$routes$nested$path$here, 2)
@@ -154,8 +154,8 @@ test_that("mounts can be read correctly", {
   pr$mount("/static", stat)
 
   expect_length(pr$routes, 3)
-  expect_true("plumberstatic" %in% class(pr$mounts[["/static/"]]))
-  expect_true("plumber" %in% class(pr$mounts[["/mysubpath/"]]))
+  expect_s3_class(pr$mounts[["/static/"]], "plumberstatic")
+  expect_s3_class(pr$mounts[["/mysubpath/"]], "plumber")
 })
 
 test_that("prints correctly", {
@@ -275,7 +275,7 @@ test_that("preroute hook gets the right data", {
   rqst <- make_req("GET", "/")
 
   pr$registerHook("preroute", function(data, req, res){
-    expect_true("PlumberResponse" %in% class(res))
+    expect_s3_class(res, "PlumberResponse")
     expect_equal(rqst, req)
     expect_true(is.environment(data))
   })
@@ -287,7 +287,7 @@ test_that("postroute hook gets the right data and can modify", {
   pr$handle("GET", "/abc", function(){ 123 })
 
   pr$registerHook("postroute", function(data, req, res, value){
-    expect_true("PlumberResponse" %in% class(res))
+    expect_s3_class(res, "PlumberResponse")
     expect_equal(req$PATH_INFO, "/abc")
     expect_true(is.environment(data))
     expect_equal(value, 123)
@@ -302,7 +302,7 @@ test_that("preserialize hook gets the right data and can modify", {
   pr$handle("GET", "/abc", function(){ 123 })
 
   pr$registerHook("preserialize", function(data, req, res, value){
-    expect_true("PlumberResponse" %in% class(res))
+    expect_s3_class(res, "PlumberResponse")
     expect_equal(req$PATH_INFO, "/abc")
     expect_true(is.environment(data))
     expect_equal(value, 123)
@@ -317,7 +317,7 @@ test_that("postserialize hook gets the right data and can modify", {
   pr$handle("GET", "/abc", function(){ 123 })
 
   pr$registerHook("postserialize", function(data, req, res, value){
-    expect_true("PlumberResponse" %in% class(res))
+    expect_s3_class(res, "PlumberResponse")
     expect_equal(req$PATH_INFO, "/abc")
     expect_true(is.environment(data))
     expect_equal(as.character(value$body), "[123]")