uft8 source file support

.Rbuildignore

@@ -1,3 +1,4 @@
+^appveyor\.yml$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 .travis.yml
@@ -9,4 +10,3 @@ docs
 scripts
 ^revdep$
 ^cran-comments\.md$
-^appveyor\.yml$

.travis.yml

@@ -1,20 +1,9 @@
 language: r
 cache: packages
-r_github_packages:
-  - jimhester/covr
+
+r_packages:
+  - covr
 after_success:
   - Rscript -e 'library(covr);codecov()'
-after_failure:
-  - ./travis-tool.sh dump_logs
-r_packages:
-  - testthat
-  - XML
-  - base64enc
-  - rmarkdown
-  - stringi
-  - jsonlite
-  - httpuv
-  - htmlwidgets
-  - PKI
-  - visNetwork
+
 warnings_are_errors: true

DESCRIPTION

@@ -7,6 +7,7 @@ Roxygen: list(markdown = TRUE)
 Authors@R: c(
   person(family="Trestle Technology, LLC", role="aut", email="cran@trestletech.com"),
   person("Jeff", "Allen", role="cre", email="cran@trestletech.com"),
+  person("Barret", "Schloerke", role="ctb", email="barret@rstudio.com"),
   person("Frans", "van Dunné", role="ctb", email="frans@ixpantia.com"),
   person("Sebastiaan", "Vandewoude", role="ctb", email="sebastiaanvandewoude@gmail.com"),
   person(family="SmartBear Software", role=c("ctb", "cph"), comment="swagger-ui"))
@@ -65,4 +66,5 @@ Collate:
     'serializer.R'
     'session-cookie.R'
     'swagger.R'
+    'utf8.R'
 RoxygenNote: 6.1.0

NEWS.md

@@ -2,11 +2,18 @@ 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)).
+* The source files used in plumber **must use** the UTF-8 encoding if they contain
+non-ASCII characters (@shrektan, [#312](https://github.com/trestletech/plumber/pull/312),
+  [#328](https://github.com/trestletech/plumber/pull/328)).
 * 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.
+  order to craft arbitrary cookies. ([#325](https://github.com/trestletech/plumber/pull/325))
+* BUGFIX: Plumber files are now only evaluated once.  Prior plumber behavior sourced endpoint
+  functions twice and non-endpoint code blocks once.
+  ([#328](https://github.com/trestletech/plumber/pull/328/commits/cde0d3d2543a654fd0c5799b670767ccb0e22e35))
+
 
 plumber 0.4.6
 --------------------------------------------------------------------------------

R/parse-block.R

@@ -215,10 +215,10 @@ parseBlock <- function(lineNum, file){
   )
 }
 
-#' Activate a "block" of code found in a plumber API file.
+#' Evaluate and activate a "block" of code found in a plumber API file.
 #' @include images.R
 #' @noRd
-activateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mount) {
+evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mount) {
   lineNum <- srcref[1] - 1
 
   block <- parseBlock(lineNum, file)
@@ -227,6 +227,7 @@ activateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mou
     stopOnLine(lineNum, file[lineNum], "A single function can only be a filter, an API endpoint, or an asset (@filter AND @get, @post, @assets, etc.)")
   }
 
+  # ALL if statements possibilities must eventually call eval(expr, envir)
   if (!is.null(block$paths)){
     lapply(block$paths, function(p){
       ep <- PlumberEndpoint$new(p$verb, p$path, expr, envir, block$serializer, srcref, block$params, block$comments, block$responses, block$tags)
@@ -253,6 +254,7 @@ activateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mou
   } else if (!is.null(block$filter)){
     filter <- PlumberFilter$new(block$filter, expr, envir, block$serializer, srcref)
     addFilter(filter)
+
   } else if (!is.null(block$assets)){
     path <- block$assets$path
 
@@ -263,5 +265,9 @@ activateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mou
 
     stat <- PlumberStatic$new(block$assets$dir, expr)
     mount(path, stat)
+
+  } else {
+
+    eval(expr, envir)
   }
 }

R/plumber.R

@@ -50,10 +50,10 @@ plumb <- function(file, dir="."){
     on.exit(setwd(old))
 
     # Expect that entrypoint will provide us with the router
-    x <- source(entrypoint)
+    #   Do not 'poison' the global env. Using a local environment
+    #   sourceUTF8 returns the (visible) value object. No need to call source()$value()
+    pr <- sourceUTF8(entrypoint, environment())
 
-    # source returns a list with value and visible elements, we want the (visible) value object.
-    pr <- x$value
     if (!inherits(pr, "plumber")){
       stop("entrypoint.R must return a runnable Plumber router.")
     }
@@ -177,17 +177,15 @@ plumber <- R6Class(
       private$notFoundHandler <- default404Handler
 
       if (!is.null(file)){
-        private$lines <- readLines(file)
-        private$parsed <- parse(file, keep.source=TRUE)
-
-        source(file, local=private$envir, echo=FALSE, keep.source=TRUE)
+        private$lines <- readUTF8(file)
+        private$parsed <- parseUTF8(file)
 
         for (i in 1:length(private$parsed)){
           e <- private$parsed[i]
 
           srcref <- attr(e, "srcref")[[1]][c(1,3)]
 
-          activateBlock(srcref, private$lines, e, private$envir, private$addEndpointInternal,
+          evaluateBlock(srcref, private$lines, e, private$envir, private$addEndpointInternal,
                         private$addFilterInternal, self$mount)
         }
 

R/utf8.R

@@ -0,0 +1,81 @@
+# Shiny has been tried and tested on different encodings
+# adoption from https://github.com/rstudio/shiny/blob/6ede0194c6e52d18be3ec13514defd8e0f22a3c1/R/utils.R#L1459-L1532
+
+isWindows <- function() .Platform$OS.type == 'windows'
+
+# assume file is encoded in UTF-8, but warn against BOM
+checkEncoding <- function(file) {
+  # skip *nix because its locale is normally UTF-8 based (e.g. en_US.UTF-8), and
+  # *nix users have to make a conscious effort to save a file with an encoding
+  # that is not UTF-8; if they choose to do so, we cannot do much about it
+  # except sitting back and seeing them punished after they choose to escape a
+  # world of consistency (falling back to getOption('encoding') will not help
+  # because native.enc is also normally UTF-8 based on *nix)
+  if (!isWindows()) return('UTF-8')
+  size <- file.info(file)[, 'size']
+  if (is.na(size)) stop('Cannot access the file ', file)
+  # BOM is 3 bytes, so if the file contains BOM, it must be at least 3 bytes
+  if (size < 3L) return('UTF-8')
+
+  # check if there is a BOM character: this is also skipped on *nix, because R
+  # on *nix simply ignores this meaningless character if present, but it hurts
+  # on Windows
+  if (identical(charToRaw(readChar(file, 3L, TRUE)), charToRaw('\UFEFF'))) {
+    warning('You should not include the Byte Order Mark (BOM) in ', file, '. ',
+            'Please re-save it in UTF-8 without BOM. See ',
+            'http://shiny.rstudio.com/articles/unicode.html for more info.')
+    return('UTF-8-BOM')
+  }
+  x <- readChar(file, size, useBytes = TRUE)
+  if (is.na(iconv(x, 'UTF-8', 'UTF-8'))) {
+    warning('The input file ', file, ' does not seem to be encoded in UTF8')
+  }
+  'UTF-8'
+}
+
+# read a file using UTF-8 and (on Windows) convert to native encoding if possible
+readUTF8 <- function(file) {
+  enc <- checkEncoding(file)
+  file <- base::file(file, encoding = enc)
+  on.exit(close(file), add = TRUE)
+  x <- enc2utf8(readLines(file, warn = FALSE))
+  tryNativeEncoding(x)
+}
+
+# if the UTF-8 string can be represented in the native encoding, use native encoding
+tryNativeEncoding <- function(string) {
+  if (!isWindows()) return(string)
+  string2 <- enc2native(string)
+  if (identical(enc2utf8(string2), string)) string2 else string
+}
+
+# similarly, try to source() a file with UTF-8
+sourceUTF8 <- function(file, envir = globalenv()) {
+  exprs <- parseUTF8(file)
+
+  eval(exprs, envir)
+}
+
+
+parseUTF8 <- function(file) {
+  lines <- readUTF8(file)
+  enc <- if (any(Encoding(lines) == 'UTF-8')) 'UTF-8' else 'unknown'
+  src <- srcfilecopy(file, lines, isFile = TRUE)  # source reference info
+
+  # oddly, parse(file) does not work when file contains multibyte chars that
+  # **can** be encoded natively on Windows (might be a bug in base R); we
+  # rewrite the source code in a natively encoded temp file and parse it in this
+  # case (the source reference is still pointed to the original file, though)
+  if (isWindows() && enc == 'unknown') {
+    file <- tempfile(); on.exit(unlink(file), add = TRUE)
+    writeLines(lines, file)
+  }
+
+  # keep the source locations within the file while parsing
+  exprs <- try(parse(file, keep.source = TRUE, srcfile = src, encoding = enc))
+  if (inherits(exprs, "try-error")) {
+    stop("Error sourcing ", file)
+  }
+
+  exprs
+}

README.md

@@ -1,7 +1,6 @@
 # plumber
 
 [![Build Status](https://travis-ci.org/trestletech/plumber.svg?branch=master)](https://travis-ci.org/trestletech/plumber)
-[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/trestletech/plumber?branch=master&svg=true)](https://ci.appveyor.com/project/trestletech/plumber)
 [![](https://www.r-pkg.org/badges/version/plumber)](https://www.r-pkg.org/pkg/plumber)
 [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/plumber?color=brightgreen)](https://www.r-pkg.org/pkg/plumber)
 [![codecov](https://codecov.io/gh/trestletech/plumber/branch/master/graph/badge.svg)](https://codecov.io/gh/trestletech/plumber)

appveyor.yml

@@ -2,48 +2,19 @@
 
 # Download script file from GitHub
 init:
-  - ps: |
+  ps: |
         $ErrorActionPreference = "Stop"
         Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
         Import-Module '..\appveyor-tool.ps1'
 
 install:
-  - ps: Bootstrap
+  ps: Bootstrap
 
 cache:
   - C:\RLibrary
 
 # Adapt as necessary starting from here
 
-configuration:
-  - English
-  - Chinese
-
-matrix:
-  fast_finish: true     # set this flag to immediately finish build once one of the jobs fails.
-  allow_failures:
-    - configuration: English
-
-for:
-  -
-    matrix:
-      only:
-        - configuration: Chinese
-    init:
-      # START / Set windows locale to Chinese (Simplified, PRC)
-      # change locale on appveyor - https://github.com/appveyor/ci/issues/846
-      # place in install, not init - https://github.com/appveyor/ci/issues/2456
-      - ps: Set-WinSystemLocale zh-CN
-      - ps: Start-Sleep -s 5
-      - ps: Restart-Computer
-      - ps: Start-Sleep -s 5
-      # END / Set windows locale to Chinese (Simplified, PRC)
-      - ps: |
-            $ErrorActionPreference = "Stop"
-            Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
-            Import-Module '..\appveyor-tool.ps1'
-
-
 build_script:
   - travis-tool.sh install_deps
 

tests/testthat/files/multibytes.R

@@ -0,0 +1,4 @@
+#* @get /echo
+function() {
+  "中文消息"
+}

tests/testthat/test-content-type.R

@@ -16,7 +16,7 @@ test_that("contentType works in files", {
 
   res <- PlumberResponse$new()
 
-  r <- plumber$new("files/content-type.R")
+  r <- plumber$new(test_path("files/content-type.R"))
   val <- r$serve(make_req("GET", "/"), res)
   expect_equal(val$headers$`Content-Type`, "text/plain")
 })

tests/testthat/test-deprecated.R

@@ -25,9 +25,8 @@ test_that("addGlobalProcessor continues to work", {
 
 test_that("addAssets continues to work", {
   pr <- plumber$new()
-  expect_warning(pr$addAssets("./files/static", "/public"))
+  expect_warning(pr$addAssets(test_path("./files/static"), "/public"))
   res <- PlumberResponse$new()
   val <- pr$route(make_req("GET", "/public/test.txt"), res)
   expect_true(inherits(val, "PlumberResponse"))
 })
-

tests/testthat/test-filters.R

@@ -1,40 +1,40 @@
 context("filters")
 
 test_that("Filters work", {
-  r <- plumber$new("files/filters.R")
+  r <- plumber$new(test_path("files/filters.R"))
   expect_equal(length(r$filters), 4+2) #4 for post, query string, cookie, and shared secret filters
 
   expect_equal(r$filters[[5]]$name, "something")
   expect_equal(r$filters[[6]]$name, "nospace")
 })
 
 test_that("Filters can update req$args", {
-  r <- plumber$new("files/filters.R")
+  r <- plumber$new(test_path("files/filters.R"))
 
   req <- make_req("GET", "/")
   res <- PlumberResponse$new()
   expect_equal(r$serve(req, res)$body, jsonlite::toJSON(23))
 })
 
 test_that("Redundant filters fail", {
-  expect_error(plumber$new("files/filter-redundant.R"), regexp="Multiple @filters")
+  expect_error(plumber$new(test_path("files/filter-redundant.R")), regexp="Multiple @filters")
 })
 
 test_that("Empty filters fail", {
-  expect_error(plumber$new("files/filter-empty.R"), regexp="No @filter name specified")
+  expect_error(plumber$new(test_path("files/filter-empty.R")), regexp="No @filter name specified")
 })
 
 test_that("Filter and path fails", {
-  expect_error(plumber$new("files/filterpath.R"), regexp="can only be")
+  expect_error(plumber$new(test_path("files/filterpath.R")), regexp="can only be")
 })
 
 test_that("Filter and assets fails", {
-  expect_error(plumber$new("files/filterasset.R"), regexp="can only be")
+  expect_error(plumber$new(test_path("files/filterasset.R")), regexp="can only be")
 })
 
 test_that("Terminal filters indeed terminate", {
   res <- PlumberResponse$new()
-  r <- plumber$new("files/terminal-filter.R")
+  r <- plumber$new(test_path("files/terminal-filter.R"))
   expect_equal(r$route(make_req("GET", "/"), res), 1)
 })
 

tests/testthat/test-image.R

@@ -1,7 +1,7 @@
 context("Images")
 
 test_that("Images are properly rendered", {
-  r <- plumber$new("files/image.R")
+  r <- plumber$new(test_path("files/image.R"))
 
   resp <- r$serve(make_req("GET", "/png"), PlumberResponse$new())
   expect_equal(resp$status, 200)

tests/testthat/test-include.R

@@ -1,7 +1,7 @@
 context("Includes")
 
 test_that("Includes work", {
-  r <- plumber$new("files/includes.R")
+  r <- plumber$new(test_path("files/includes.R"))
 
   # When running, we setwd to the file's dir. Simulate that here.
   cwd <- getwd()

tests/testthat/test-injection.R

@@ -1,7 +1,7 @@
 context("Injection")
 
 test_that("Injected arguments on req$args get passed on.", {
-  r <- plumber$new("files/filter-inject.R")
+  r <- plumber$new(test_path("files/filter-inject.R"))
 
   res <- PlumberResponse$new()
   expect_equal(r$serve(make_req("GET", "/"), res)$body, jsonlite::toJSON(13))