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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
httpLibCurl <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
request <- list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path
)
handle <- createCurlHandle(
method = method,
timeout = timeout,
certificate = certificate
)
if (!is.null(contentFile)) {
if (is.null(contentType)) {
stop("You must specify a contentType for the specified file")
}
fileLength <- file.info(contentFile)$size
headers$`Content-Type` <- contentType
headers$`Content-Length` <- as.character(fileLength)
# open a connection to read the file, and ensure it's closed when we're done
contentCon <- file(contentFile, "rb")
defer(if (!is.null(contentCon)) close(contentCon))
progress <- is_interactive() && fileLength >= 10 * 1024^2
curl::handle_setopt(
handle,
noprogress = !progress,
upload = TRUE,
infilesize_large = fileLength,
readfunction = function(nbytes, ...) {
if (is.null(contentCon)) {
return(raw())
}
bin <- readBin(contentCon, "raw", nbytes)
if (length(bin) < nbytes) {
close(contentCon)
contentCon <<- NULL
}
bin
}
)
}
headers <- appendCookieHeaders(request, headers)
curl::handle_setheaders(handle, .list = headers)
# make the request
url <- buildHttpUrl(request)
start <- proc.time()
response <- curl::curl_fetch_memory(url, handle = handle)
time <- proc.time() - start
httpTrace(method, path, time)
# Process headers
headers <- curl::parse_headers_list(rawToChar(response$headers))
# Parse cookies from header; bear in mind that there may be multiple headers
cookieHeaders <- headers[names(headers) == "set-cookie"]
storeCookies(request, cookieHeaders)
# presume a plain text response unless specified otherwise
contentType <- headers[["content-type"]] %||% "text/plain"
contentValue <- rawToChar(response$content)
# emit JSON trace if requested
jsonTracingEnabled <- httpTraceJson() && contentType == "application/json"
if (jsonTracingEnabled) {
if (!is.null(contentFile)) {
cat(paste0("<< ", readLines(contentFile, warn = FALSE), "\n", collapse = ""))
}
lines <- strsplit(contentValue, "\n")[[1]]
cat(paste0(">> ", lines, "\n", collapse = ""))
}
list(
req = request,
status = response$status_code,
location = headers$location,
contentType = contentType,
content = contentValue
)
}
createCurlHandle <- function(method,
timeout = NULL,
certificate = NULL) {
# create curl handle
handle <- curl::new_handle()
# overlay user-supplied options
userOptions <- getOption("rsconnect.libcurl.options")
if (is.list(userOptions)) {
curl::handle_setopt(handle, .list = userOptions)
}
curl::handle_setopt(handle, customrequest = method)
curl::handle_setopt(handle, useragent = userAgent())
if (isTRUE(getOption("rsconnect.check.certificate", TRUE))) {
curl::handle_setopt(handle, ssl_verifypeer = TRUE)
# apply certificate information if present
if (!is.null(certificate)) {
curl::handle_setopt(handle, cainfo = certificate)
}
} else {
# don't verify peer (less secure but tolerant to self-signed cert issues)
curl::handle_setopt(handle, ssl_verifypeer = FALSE)
}
# use timeout if supplied
if (!is.null(timeout)) {
curl::handle_setopt(handle, timeout = timeout)
}
# verbose if requested
if (httpVerbose()) {
curl::handle_setopt(handle, verbose = TRUE)
}
# suppress curl's automatically handling of redirects, since we have to
# handle ourselves in httpRequest()/httpRequestWithBody() due to our
# specialised auth needs
curl::handle_setopt(handle, followlocation = FALSE)
handle
}
|
