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