Initial importv0.1.0

1 files changed, 114 insertions, 0 deletions

diff --git a/tests/helper/server.R b/tests/helper/server.R
new file mode 100644
index 0000000..48f9a39
--- /dev/null
+++ b/tests/helper/server.R
@@ -0,0 +1,114 @@
+args <- commandArgs(trailingOnly = TRUE)
+routes <- readRDS(args[[1L]])
+logfile <- args[[2L]]
+readyfile <- args[[3L]]
+
+server <- NULL
+port <- NA_integer_
+for (candidate in sample(20000:60000, 500L)) {
+  server <- tryCatch(serverSocket(candidate), error = function(e) NULL)
+  if (!is.null(server)) {
+    port <- candidate
+    break
+  }
+}
+if (is.null(server)) {
+  stop("no free port for the fake server")
+}
+
+state <- new.env(parent = emptyenv())
+state$queues <- lapply(routes, function(route) route$responses)
+
+pick <- function(path) {
+  index <- NA_integer_
+  for (i in seq_along(routes)) {
+    if (identical(routes[[i]]$match, path)) {
+      index <- i
+      break
+    }
+  }
+  if (is.na(index)) {
+    for (i in seq_along(routes)) {
+      if (startsWith(path, routes[[i]]$match)) {
+        index <- i
+        break
+      }
+    }
+  }
+  if (is.na(index)) {
+    return(list(
+      status = 404L,
+      body = "{\"erro\":\"cep_nao_encontrado\"}",
+      headers = list()
+    ))
+  }
+  queue <- state$queues[[index]]
+  if (length(queue) > 1L) {
+    state$queues[[index]] <- queue[-1L]
+  }
+  queue[[1L]]
+}
+
+send <- function(connection, response) {
+  body <- charToRaw(enc2utf8(response$body))
+  head <- paste0("HTTP/1.1 ", response$status, " Response\r\n")
+  for (name in names(response$headers)) {
+    head <- paste0(head, name, ": ", response$headers[[name]], "\r\n")
+  }
+  head <- paste0(
+    head,
+    "Content-Type: text/plain; charset=utf-8\r\n",
+    "Content-Length: ", length(body), "\r\n",
+    "Connection: close\r\n\r\n"
+  )
+  try(
+    {
+      writeBin(c(charToRaw(head), body), connection)
+      flush(connection)
+    },
+    silent = TRUE
+  )
+}
+
+pending <- paste0(readyfile, ".tmp")
+writeLines(as.character(port), pending)
+file.rename(pending, readyfile)
+
+repeat {
+  if (!socketSelect(list(server), timeout = 60)) {
+    break
+  }
+  connection <- socketAccept(server, blocking = TRUE, open = "r+b",
+                             timeout = 10)
+  path <- NA_character_
+  repeat {
+    line <- readLines(connection, n = 1L, warn = FALSE)
+    if (length(line) == 0L) {
+      break
+    }
+    line <- sub("\r$", "", line)
+    if (!nzchar(line)) {
+      break
+    }
+    if (is.na(path)) {
+      path <- strsplit(line, " ", fixed = TRUE)[[1L]][2L]
+    }
+  }
+
+  stopping <- FALSE
+  if (!is.na(path)) {
+    cat(path, "\n", sep = "", file = logfile, append = TRUE)
+    if (identical(path, "/__shutdown__")) {
+      stopping <- TRUE
+      send(connection, list(status = 200L, body = "bye", headers = list()))
+    } else {
+      send(connection, pick(path))
+    }
+  }
+  try(close(connection), silent = TRUE)
+  if (stopping) {
+    break
+  }
+}
+
+close(server)