Don't wildcard allow-origin by default. (#144)

* Don't wildcard allow-origin by default.

This could be considered a vulnerability in how Plumber behaved previously. This, by default, allows cross-origin GET, HEAD, and POST requests using the standard headers from any origin. We've decided that this is something you should opt-in to, so we're removing this as the default.

* Support OPTIONS requests

Makes it feasible for you to build your own CORS handler.

* Note NEWS changes.

NEWS.md

@@ -1,6 +1,10 @@
 plumber 0.4.0
 --------------------------------------------------------------------------------
 * BREAKING: Listen on localhost instead of listening publicly by default.
+* BREAKING: We no longer set the `Access-Control-Allow-Origin` HTTP header to 
+  `*`. This was previously done for convenience but we've decided to prioritize
+  security here by removing this default. You can still add this header to any
+  route you want to be accessible from other origins.
 * BREAKING: Listen on a random port by default instead of always on 8000. This
   can be controlled using the `port` parameter in `run()`, or by setting the 
   `plumber.port` option.
@@ -28,6 +32,7 @@ plumber 0.4.0
   a function that returns the error handler function. The top-level function
   takes a single param named `debug` which is managed by the `debug` parameter
   in the `run()` method.
+* Added support for `OPTIONS` HTTP requests via the `@options` annotation.
 * Add support for `entrypoint.R` when `plumb()`ing a directory. If this file 
   exists, it is expected to return a Plumber router representing the API
   contained in this directory. If it doesn't exist, the bahvior is unaltered.

R/parse-block.R

@@ -21,7 +21,7 @@ parseBlock <- function(lineNum, file){
 
     line <- file[lineNum]
 
-    epMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@(get|put|post|use|delete|head)(\\s+(.*)$)?")
+    epMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@(get|put|post|use|delete|head|options)(\\s+(.*)$)?")
     if (!is.na(epMat[1,2])){
       p <- stri_trim_both(epMat[1,4])
 

R/plumber.R

@@ -3,7 +3,7 @@
 NULL
 
 # used to identify annotation flags.
-verbs <- c("GET", "PUT", "POST", "DELETE", "HEAD")
+verbs <- c("GET", "PUT", "POST", "DELETE", "HEAD", "OPTIONS")
 enumerateVerbs <- function(v){
   if (identical(v, "use")){
     return(verbs)

R/response.R

@@ -18,10 +18,6 @@ PlumberResponse <- R6Class(
       # httpuv doesn't like empty headers lists, and this is a useful field anyway...
       h$Date <- format(Sys.time(), "%a, %d %b %Y %X %Z", tz="GMT")
 
-      if (is.null(h$`Access-Control-Allow-Origin`)){
-        h$`Access-Control-Allow-Origin` <-  "*" # Be permissive with CORS
-      }
-
       # Due to https://github.com/rstudio/httpuv/issues/49, we need each
       # request to be on a separate TCP stream
       h$Connection = "close"

tests/testthat/files/verbs.R

@@ -34,3 +34,8 @@ function(){
 function() {
 
 }
+
+#* @options /options
+function(){
+
+}

tests/testthat/test-enumerate.R

@@ -1,7 +1,7 @@
 context("Verb enumeration")
 
 test_that("enumerate returns all on 'use'", {
-  expect_equal(enumerateVerbs("use"), c("GET", "PUT", "POST", "DELETE", "HEAD"))
+  expect_equal(enumerateVerbs("use"), c("GET", "PUT", "POST", "DELETE", "HEAD", "OPTIONS"))
 })
 
 test_that("regular verbs return themselves", {

tests/testthat/test-plumber.R

@@ -25,14 +25,15 @@ test_that("The file is sourced in the envir", {
 test_that("Verbs translate correctly", {
   r <- plumber$new("files/verbs.R")
   expect_equal(length(r$endpoints), 1)
-  expect_equal(length(r$endpoints[[1]]), 7)
-  expect_equal(r$endpoints[[1]][[1]]$verbs, c("GET", "PUT", "POST", "DELETE", "HEAD"))
+  expect_equal(length(r$endpoints[[1]]), 8)
+  expect_equal(r$endpoints[[1]][[1]]$verbs, c("GET", "PUT", "POST", "DELETE", "HEAD", "OPTIONS"))
   expect_equal(r$endpoints[[1]][[2]]$verbs, "GET")
   expect_equal(r$endpoints[[1]][[3]]$verbs, "PUT")
   expect_equal(r$endpoints[[1]][[4]]$verbs, "POST")
   expect_equal(r$endpoints[[1]][[5]]$verbs, "DELETE")
   expect_equal(r$endpoints[[1]][[6]]$verbs, c("POST", "GET"))
   expect_equal(r$endpoints[[1]][[7]]$verbs, "HEAD")
+  expect_equal(r$endpoints[[1]][[8]]$verbs, "OPTIONS")
 })
 
 test_that("Invalid file fails gracefully", {

tests/testthat/test-response.R

@@ -38,9 +38,3 @@ test_that("can set multiple same-named headers", {
   expect_true(another)
 })
 
-test_that("doesn't overwrite CORS", {
-  res <- PlumberResponse$new()
-  res$setHeader("Access-Control-Allow-Origin", "originhere")
-  head <- res$toResponse()$headers
-  expect_equal(head[["Access-Control-Allow-Origin"]], "originhere")
-})