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
|
#' @importFrom utils compareVersion
download <- function(path, url, auth_token = NULL, basic_auth = NULL,
quiet = TRUE, auth_phrase = "access_token=") {
real_url <- url
if (!is.null(basic_auth)) {
str <- paste0("://", basic_auth$user, ":", basic_auth$password, "@")
real_url <- sub("://", str, url)
}
if (!is.null(auth_token)) {
sep <- if (grepl("?", url, fixed = TRUE)) "&" else "?"
tkn <- if (grepl("=$", auth_phrase)) auth_phrase else paste0(auth_phrase, "=")
real_url <- paste0(url, sep, tkn, auth_token)
}
if (compareVersion(get_r_version(), "3.2.0") == -1) {
curl_download(real_url, path, quiet)
} else {
base_download(real_url, path, quiet)
}
path
}
base_download <- function(url, path, quiet) {
suppressWarnings(
status <- utils::download.file(
url,
path,
method = download_method(),
quiet = quiet,
mode = "wb"
)
)
if (status != 0) stop("Cannot download file from ", url, call. = FALSE)
path
}
download_method <- function() {
# R versions newer than 3.3.0 have correct default methods
if (compareVersion(get_r_version(), "3.3") == -1) {
if (os_type() == "windows") {
"wininet"
} else if (isTRUE(unname(capabilities("libcurl")))) {
"libcurl"
} else {
"auto"
}
} else {
"auto"
}
}
curl_download <- function(url, path, quiet) {
if (!pkg_installed("curl")) {
stop("The 'curl' package is required if R is older than 3.2.0")
}
curl::curl_download(url, path, quiet = quiet, mode = "wb")
}
true_download_method <- function(x) {
if (identical(x, "auto")) {
auto_download_method()
} else {
x
}
}
auto_download_method <- function() {
if (isTRUE(capabilities("libcurl"))) {
"libcurl"
} else if (isTRUE(capabilities("http/ftp"))) {
"internal"
} else if (nzchar(Sys.which("wget"))) {
"wget"
} else if (nzchar(Sys.which("curl"))) {
"curl"
} else {
""
}
}
download_method_secure <- function() {
method <- true_download_method(download_method())
if (method %in% c("wininet", "libcurl", "wget", "curl")) {
# known good methods
TRUE
} else if (identical(method, "internal")) {
# if internal then see if were using windows internal with inet2
identical(Sys.info()[["sysname"]], "Windows") && utils::setInternet2(NA)
} else {
# method with unknown properties (e.g. "lynx") or unresolved auto
FALSE
}
}
|
