1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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)
|