1# File src/library/utils/R/unix/download.file.R 2# Part of the R package, https://www.R-project.org 3# 4# Copyright (C) 1995-2020 The R Core Team 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# A copy of the GNU General Public License is available at 17# https://www.R-project.org/Licenses/ 18 19download.file <- 20 function(url, destfile, method, quiet = FALSE, mode = "w", 21 cacheOK = TRUE, extra = getOption("download.file.extra"), 22 headers = NULL, ...) 23{ 24 destfile # check supplied 25 method <- if (missing(method)) 26 getOption("download.file.method", default = "auto") 27 else 28 match.arg(method, c("auto", "internal", "libcurl", "wget", "curl", "lynx")) 29 30 if(method == "auto") { 31 if(length(url) != 1L || typeof(url) != "character") 32 stop("'url' must be a length-one character vector"); 33 ## As from 3.3.0 all Unix-alikes support libcurl. 34 method <- if(startsWith(url, "file:")) "internal" else "libcurl" 35 } 36 37 nh <- names(headers) 38 if(length(nh) != length(headers) || any(nh == "") || anyNA(headers) || anyNA(nh)) 39 stop("'headers' must have names and must not be NA") 40 41 switch(method, 42 "internal" = { 43 headers <- if(length(headers)) paste0(nh, ": ", headers, "\r\n", collapse = "") 44 status <- .External(C_download, url, destfile, quiet, mode, 45 cacheOK, headers) 46 ## needed for Mac GUI from download.packages etc 47 if(!quiet) flush.console() 48 }, 49 "libcurl" = { 50 headers <- if(length(headers)) paste0(nh, ": ", headers) 51 status <- .Internal(curlDownload(url, destfile, quiet, mode, 52 cacheOK, headers)) 53 if(!quiet) flush.console() 54 }, 55 "wget" = { 56 if(length(url) != 1L || typeof(url) != "character") 57 stop("'url' must be a length-one character vector"); 58 if(length(destfile) != 1L || typeof(destfile) != "character") 59 stop("'destfile' must be a length-one character vector"); 60 if(quiet) extra <- c(extra, "--quiet") 61 if(!cacheOK) extra <- c(extra, "--cache=off") 62 status <- system(paste("wget", 63 paste(extra, collapse = " "), 64 shQuote(url), 65 "-O", shQuote(path.expand(destfile)))) 66 if(status) stop("'wget' call had nonzero exit status") 67 }, 68 "curl" = { 69 if(length(url) != 1L || typeof(url) != "character") 70 stop("'url' must be a length-one character vector"); 71 if(length(destfile) != 1L || typeof(url) != "character") 72 stop("'destfile' must be a length-one character vector"); 73 if(quiet) extra <- c(extra, "-s -S") 74 if(!cacheOK) extra <- c(extra, paste("-H", shQuote("Pragma: no-cache"))) 75 status <- system(paste("curl", 76 paste(extra, collapse = " "), 77 shQuote(url), 78 " -o", shQuote(path.expand(destfile)))) 79 if(status) stop("'curl' call had nonzero exit status") 80 }, 81 "lynx" = 82 stop("method 'lynx' is defunct", domain = NA)) 83 84 if(status) warning("download had nonzero exit status") 85 86 invisible(status) 87} 88 89nsl <- function(hostname) .Call(C_nsl, hostname) 90