第 1 章 httpuv

在httpuv的官网中,有这么一段描述：

Allows R code to listen for and interact with HTTP and WebSocket clients, so you can serve web traffic directly out of your R process. Implementation is based on libuv and http-parser.

This is a low-level library that provides little more than network I/O and implementations of the HTTP and WebSocket protocols. For an easy way to create web applications, try Shiny instead.

我们可以通过httpuv搭建一个访问R模型的web API,但可能这不是最好的。

本部分我们首先介绍官方提供的一些方法，然后解析官方提供的演示Demo,从而达到熟练使用httpuv的目的。

1.1 方法介绍

下面我们解析一下httpuv官方提供的一些调用方法，并演示一些调用方法对应的实例

1.使用URI编码/解码以与Web浏览器相同的方式对字符串进行编码/解码。

encodeURI(value)
encodeURIComponent(value)
decodeURI(value)
decodeURIComponent(value)

参数列表

  • value 用于编码和解码的字符向量，UTF-8字符编码
library(httpuv)
value <- "https://baidu.com/中国;?/"
encodeURI(value)
## [1] "https://baidu.com/%D6%D0%B9%FA;?/"
encodeURIComponent(value)
## [1] "https%3A%2F%2Fbaidu.com%2F%D6%D0%B9%FA%3B%3F%2F"
decodeURI(value)
## [1] "https://baidu.com/中国;?/"
decodeURIComponent(value)
## [1] "https://baidu.com/中国;?/"

注意： encodeURI 与 encodeURIComponent是不一样的因为前者不对特殊字符: ;,/?:@&=+$等进行encode

2.中断httpuv运行的环路

interrupt()
  1. 检查ip地址的类型是ipv4还是ipv6
ipFamily(ip)

参数列表

  • ip 一个代表IP地址的字符串

  • 返回值的意义：如果是IPv4返回4，如果是IPv6返回6，如果不是IP地址返回-1

ipFamily("127.0.0.1") # 4
## [1] 4
ipFamily("500.0.0.500") # -1
## [1] -1
ipFamily("500.0.0.500") # -1
## [1] -1
ipFamily("::") # 6
## [1] 6
ipFamily("::1") # 6
## [1] 6
ipFamily("fe80::1ff:fe23:4567:890a") # 6
## [1] 6

3.将原始向量转换为BASE64编码字符串

rawToBase64(x)

参数列表

  • x 原始向量
set.seed(100)
result <- rawToBase64(as.raw(runif(19, min=0, max=256)))
#stopifnot(identical(result, "TkGNDnd7z16LK5/hR2bDqzRbXA=="))
result
## [1] "TkGNDnd7z16LK5/hR2bDqzRbXA=="

4.运行一个server

runServer(host, port, app, interruptIntervalMs = NULL)

参数列表

  • host IPv4地址, 或是“0.0.0.0”监听所有的IP

  • port 端口号

  • app 一个定义应用的函数集合

  • interruptIntervalMs 该参数不提倡使用，1.3.5版本后废除

app <- list(call = function(req){
  list(status=200L,
       headers = list(
         'Content-Type' = 'text/html'
       ),
       body = "HelloWorld!")
})

runServer("0.0.0.0", 5000,app)

5.过程请求

处理HTTP请求和WebSocket消息。 如果R的调用堆栈上没有任何东西，如果R是 在命令提示符下闲置，不必调用此函数，因为请求将 自动处理。但是，如果R正在执行代码，则请求将不被处理。 要么调用栈是空的，要么调用这个函数(或者，调用run_now())。

service(timeoutMs = ifelse(interactive(), 100, 1000))

参数列表

  • timeoutMs 返回之前运行的毫秒数。

6.创建HTTP/WebSocket后台服务器（弃用）

startDaemonizedServer(host, port, app)

7.创建HTTP/WebSocket服务器

startServer(host, port, app)
startPipeServer(name, mask, app)

参数列表

  • host ip地址

  • port 端口号

  • app 一个定义应用的函数集


app <- list(
  call = function(req) {
    list(
      status = 200L,
      headers = list(
        'Content-Type' = 'text/html'
        ),
      body = "Hello world!"
    )
    }
  )
handle <- startServer("0.0.0.0", 5000,app)

# 此服务器的句柄，可以传递给StestServer以关闭服务器。
stopServer(handle)

8.停止所有应用

stopAllServers()

9.在UNIX环境中停止运行的后台服务器（弃用）

stopDaemonizedServer(handle)

10.停止一个服务

stopServer(handle)

1.2 例子演示

  1. json-server

# Connect to this using websockets on port 9454
# Client sends to server in the format of {"data":[1,2,3]}
# The websocket server returns the standard deviation of the sent array
library(jsonlite)
library(httpuv)

# Server
app <- list(
  onWSOpen = function(ws) {
    ws$onMessage(function(binary, message) {
      # Decodes message from client
      message <- fromJSON(message)
      # Sends message to client
      ws$send(
        # JSON encode the message
        toJSON(
          # Returns standard deviation for message
          sd(message$data)
        )
      )
    })
  }
)
runServer("0.0.0.0", 9454, app, 250)

2.echo

library(httpuv)

app <- list(
  call = function(req) {
    wsUrl = paste(sep='',
                  '"',
                  "ws://",
                  ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST),
                  '"')
    
    list(
      status = 200L,
      headers = list(
        'Content-Type' = 'text/html'
      ),
      body = paste(
        sep = "\r\n",
        "<!DOCTYPE html>",
        "<html>",
        "<head>",
        '<style type="text/css">',
        'body { font-family: Helvetica; }',
        'pre { margin: 0 }',
        '</style>',
        "<script>",
        sprintf("var ws = new WebSocket(%s);", wsUrl),
        "ws.onmessage = function(msg) {",
        '  var msgDiv = document.createElement("pre");',
        '  msgDiv.innerHTML = msg.data.replace(/&/g, "&amp;").replace(/\\</g, "&lt;");',
        '  document.getElementById("output").appendChild(msgDiv);',
        "}",
        "function sendInput() {",
        "  var input = document.getElementById('input');",
        "  ws.send(input.value);",
        "  input.value = '';",
        "}",
        "</script>",
        "</head>",
        "<body>",
        '<h3>Send Message</h3>',
        '<form action="" onsubmit="sendInput(); return false">',
        '<input type="text" id="input"/>',
        '<h3>Received</h3>',
        '<div id="output"/>',
        '</form>',
        "</body>",
        "</html>"
      )
    )
  },
  onWSOpen = function(ws) {
    ws$onMessage(function(binary, message) {
      ws$send(message)
    })
  }
)

browseURL("http://localhost:9454/")
runServer("0.0.0.0", 9454, app, 250)

3.deamon-echo

library(httpuv)

.lastMessage <- NULL

app <- list(
  call = function(req) {
    wsUrl = paste(sep='',
                  '"',
                  "ws://",
                  ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST),
                  '"')
    
    list(
      status = 200L,
      headers = list(
        'Content-Type' = 'text/html'
      ),
      body = paste(
        sep = "\r\n",
        "<!DOCTYPE html>",
        "<html>",
        "<head>",
        '<style type="text/css">',
        'body { font-family: Helvetica; }',
        'pre { margin: 0 }',
        '</style>',
        "<script>",
        sprintf("var ws = new WebSocket(%s);", wsUrl),
        "ws.onmessage = function(msg) {",
        '  var msgDiv = document.createElement("pre");',
        '  msgDiv.innerHTML = msg.data.replace(/&/g, "&amp;").replace(/\\</g, "&lt;");',
        '  document.getElementById("output").appendChild(msgDiv);',
        "}",
        "function sendInput() {",
        "  var input = document.getElementById('input');",
        "  ws.send(input.value);",
        "  input.value = '';",
        "}",
        "</script>",
        "</head>",
        "<body>",
        '<h3>Send Message</h3>',
        '<form action="" onsubmit="sendInput(); return false">',
        '<input type="text" id="input"/>',
        '<h3>Received</h3>',
        '<div id="output"/>',
        '</form>',
        "</body>",
        "</html>"
      )
    )
  },
  onWSOpen = function(ws) {
    ws$onMessage(function(binary, message) {
      .lastMessage <<- message
      ws$send(message)
    })
  }
)

server <- startDaemonizedServer("0.0.0.0", 9454, app)

# check the value of .lastMessage after echoing to check it is being updated

# call this after done
#stopDaemonizedServer(server)

library(httpuv)
app = list(call = function(req){
  # 获取POST的参数
  postdata = req$rook.input$read_lines()
  qs = httr:::parse_query(gsub("^\\?", "", postdata))
  dat = jsonlite::fromJSON(qs$jsonDat)
  print(dat)
  # 计算返回结果
  r = 0.3 + 0.1 * dat$v1 - 0.2 * dat$v2 + 0.1 * dat$v3
  output = jsonlite::toJSON(list(message = 'suceess', result = r), auto_unbox = T)
  res = list(status = 200L, headers = list('Content-Type' = 'application/json'), body = output)
                                           return(res)
})
                                           # 启动服务
                                           server = startServer("0.0.0.0", 1124L, app = app)
                                           while(TRUE) {
                                           service()
                                           Sys.sleep(0.001)
                                           }
                                           # stopServer(server)


RCurl::postForm('127.0.0.1:1124',
style = 'post',
.params = list(jsonDat = '{"v1":1,"v2":2,"v3":3}')
)

httpuv是相对比较底层的包，熟练使用需要掌握前端知识，并且需要用到RCurl，httr相关爬虫包的一些知识去处理。本人不推荐这种方式进行模型的部署。