| ## These are tests that require libcurl functionality and a working |
| ## Internet connection. |
| |
| ## As from R 3.4.0 method = "libcurl" is the default on a Unix-alike |
| ## so this is in small part duplication -- but not on Windows. |
| |
| if(!capabilities("libcurl")) { |
| warning("no libcurl support") |
| q() |
| } |
| |
| ## check basic Internet access |
| if(.Platform$OS.type == "unix" && |
| is.null(nsl("cran.r-project.org"))) q() |
| |
| tf <- tempfile() |
| download.file("http://cran.r-project.org/", tf, method = "libcurl") |
| file.size(tf) |
| unlink(tf) |
| |
| |
| ## test url connections on http |
| str(readLines(zz <- url("http://cran.r-project.org/", method = "libcurl"))) |
| zz |
| stopifnot(identical(summary(zz)$class, "url-libcurl")) |
| close(zz) |
| |
| tf <- tempfile() |
| testDownloadFile404 <- tryCatch(suppressWarnings({ |
| download.file("http://httpbin.org/status/404", tf, method = "libcurl") |
| }), error=function(e) { |
| conditionMessage(e) == "cannot open URL 'http://httpbin.org/status/404'" |
| }) |
| stopifnot(testDownloadFile404, !file.exists(tf)) |
| |
| test404.1 <- tryCatch({ |
| open(zz <- url("http://httpbin.org/status/404", method = "libcurl")) |
| }, warning=function(w) { |
| grepl("404 Not Found", conditionMessage(w)) |
| }) |
| close(zz) |
| stopifnot(test404.1) |
| |
| ## via read.table (which closes the connection) |
| tail(read.table(url("http://www.stats.ox.ac.uk/pub/datasets/csb/ch11b.dat", |
| method = "libcurl"))) |
| |
| ## check option works |
| options(url.method = "libcurl") |
| zz <- url("http://www.stats.ox.ac.uk/pub/datasets/csb/ch11b.dat") |
| stopifnot(identical(summary(zz)$class, "url-libcurl")) |
| close(zz) |
| |
| test404.2 <- tryCatch({ |
| open(zz <- url("http://httpbin.org/status/404")) |
| }, warning = function(w) { |
| grepl("404 Not Found", conditionMessage(w)) |
| }) |
| close(zz) |
| stopifnot(test404.2) |
| |
| showConnections(all = TRUE) |
| |
| ## -------------------------------------------------------------- |
| ## Some platforms have problems with certificates, |
| ## so allow them to skip the https tests |
| junk <- tryCatch(curlGetHeaders("http://bugs.r-project.org"), |
| error = function(e) { |
| message("Check for working https failed:\n\t", |
| conditionMessage(e), |
| "skipping https tests\n") |
| q() |
| }) |
| |
| example(curlGetHeaders, run.donttest = TRUE) |
| |
| ## https URL |
| head(readLines(zz <- url("https://httpbin.org", method = "libcurl"), |
| warn = FALSE)) |
| close(zz) |
| |
| ## redirection (to a https:// URL) |
| head(readLines(zz <- url("http://bugs.r-project.org", method = "libcurl"), |
| warn = FALSE)) |
| close(zz) |
| |
| options(url.method = "libcurl") |
| head(readLines("https://httpbin.org", warn = FALSE)) |