A minimal R application server

server.R

start.server <- function(host = "localhost", port = 8000, request.handler) {
  max.request.length <- 100 * 1024 * 1024  # 100 MB request size
  repeat {
    socket <- make.socket(host, port, server = TRUE)
    on.exit(close.socket(socket))
    request <- parse.request(read.socket(socket, maxlen = max.request.length))
    response <- request.handler(request)
    write.socket(socket, response)
    close.socket(socket)
  }
}

strbisect <- function (x, pattern, ...) {
  index <- regexpr(pattern, x, ...)
  match.length <- attr(index, "match.length")
  if (index > -1)
    c(
      substr(x, 1, index - 1), 
      substr(x, index + match.length, nchar(x))
    )
  else 
    c(x)
}

parse.request <- function(raw.request) {
  request.parts <- strbisect(raw.request, "\r\n\r\n")
  header.lines <- unlist(strsplit(request.parts[1], "\r\n"))
  body <- request.parts[2]

  # parse request line
  request.line <- unlist(strsplit(header.lines[1], " "))
  method <- request.line[1]
  resource <- request.line[2]
  protocol <- request.line[3]
  
  # parse headers
  headers <- Reduce(function(headers, header.line) {
    header.parts <- strbisect(header.line, ":\\s*")
    headers[header.parts[1]] <- header.parts[2]
    headers
  }, init = list(), header.lines[-1])

  list(
    method = method,
    resource = resource,
    protocol = protocol,
    headers = headers,
    body = body
  )
}

create.response <- function(status.code, headers, body) {
  http.version <- "HTTP/1.1"
  status.text <- switch(
    substr(status.code, 1, 1), 
    "1" = "Information", 
    "2" = "Success", 
    "3" = "Redirection", 
    "4" = "Client Error", 
    "5" = "Server Errror"
  )
  
  status.line <- paste(http.version, status.code, status.text)
  headers <- paste0(names(headers), ": ", headers, collapse = "\r\n")
  paste(status.line, headers, "", body, sep = "\r\n")
}

html.response <- function(html, headers = NULL) {
  create.response(
    200, 
    headers = c(
      list("Content-Type" = "text/html; charset=utf-8"),
      headers
    ), 
    body = html
  )  
}

# Example Usage:
# start.server("localhost", 8000, function(request) {
#   html.response("Hello World")
# })

usage.md

# HTML Response
start.server("localhost", 8000, function(request) {
  html.response("Hello World")
})

# Use jsonlite to create json responses
json.response <- function(body, headers = NULL) {
  create.response(
    200, 
    headers = c(
      list("Content-Type" = "application/json"),
      headers
    ), 
    body = jsonlite::toJSON(body, auto_unbox = TRUE)
  )
}

start.server("localhost", 8000, function(request) {
  json.response(request)
})