# File src/library/utils/R/packages2.R # Part of the R package, https://www.R-project.org # # Copyright (C) 1995-2023 The R Core Team # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # https://www.R-project.org/Licenses/ if (.Platform$OS.type == "windows") .install.macbinary <- function(...) NULL # globalVariables isn't available, so use this to suppress the warning isBasePkg <- function(pkg) { priority <- tryCatch(packageDescription(pkg, fields = "Priority", encoding = NA), error = function(e) e, warning = function(e) e) identical(priority, "base") } getDependencies <- function(pkgs, dependencies = NA, available = NULL, lib = .libPaths()[1L], binary = FALSE, ..., av2 = NULL) ## ... is passed to installed.packages(). { if (is.null(dependencies)) return(unique(pkgs)) oneLib <- length(lib) == 1L dep2 <- NULL if(is.logical(dependencies) && is.na(dependencies)) dependencies <- c("Depends", "Imports", "LinkingTo") depends <- is.character(dependencies) || (is.logical(dependencies) && dependencies) if(depends && is.logical(dependencies)) { if(binary) { dependencies <- c("Depends", "Imports", "Suggests") dep2 <- c("Depends", "Imports") } else { dependencies <- c("Depends", "Imports", "LinkingTo", "Suggests") dep2 <- c("Depends", "Imports", "LinkingTo") } } if(depends && !oneLib) { warning("Do not know which element of 'lib' to install dependencies into\nskipping dependencies") depends <- FALSE } p0 <- unique(pkgs) miss <- !p0 %in% row.names(available) base <- vapply(p0, isBasePkg, FALSE) if (sum(base)) warning(sprintf(ngettext(sum(base), "package %s is a base package, and should not be updated", "packages %s are base packages, and should not be updated"), paste(sQuote(p0[base]), collapse = ", ")), domain = NA, call. = FALSE) m0 <- miss & !base msg2 <- NULL if(sum(m0) && !is.null(av2)) { keep <- rownames(av2) %in% p0[m0] ## there might be duplicate matches av2 <- av2[keep, , drop = FALSE] if(nrow(av2)) { ds <- av2[, "Depends"] ds[is.na(ds)] <- "" x <- lapply(strsplit(sub("^[[:space:]]*", "", ds), "[[:space:]]*,[[:space:]]*"), function(s) s[grepl("^R[[:space:]]*\\(", s)]) lens <- lengths(x) pos <- which(lens > 0L) av2 <- av2[pos,, drop = FALSE]; x <- x[pos] msg2 <- paste(sQuote(av2[, "Package"]), "version", av2[, "Version"], "is in the repositories but depends on", unlist(x)) } } if(sum(m0)) { msg <- paste0(if(binary) "as a binary package ", "for this version of R") msg3 <- c(paste0(ngettext(sum(m0), "A version of this package for your version of R might be available elsewhere,\nsee the ideas at\n", "Versions of these packages for your version of R might be available elsewhere,\nsee the ideas at\n"), ## refer to r-patched for released/patched versions if (grepl("Under development", R.version.string)) { "https://cran.r-project.org/doc/manuals/r-devel/R-admin.html#Installing-packages" } else { "https://cran.r-project.org/doc/manuals/r-patched/R-admin.html#Installing-packages" }) ) warning(sprintf(ngettext(sum(m0), "package %s is not available %s", "packages %s are not available %s"), paste(sQuote(p0[m0]), collapse = ", "), paste(c(msg, msg2, "", msg3), collapse = "\n")), domain = NA, call. = FALSE) if (sum(m0) == 1L && !is.na(w <- match(tolower(p0[m0]), tolower(row.names(available))))) { warning(sprintf("Perhaps you meant %s ?", sQuote(row.names(available)[w])), call. = FALSE, domain = NA) } flush.console() } p0 <- p0[!miss] if(depends && length(p0)) { # check for dependencies, recursively p1 <- p0 # this is ok, as 1 lib only ## INSTALL prepends 'lib' to the libpath ## Here we are slightly more conservative libpath <- .libPaths() if(!lib %in% libpath) libpath <- c(lib, libpath) installed <- installed.packages(lib.loc = libpath, fields = c("Package", "Version"), ...) not_avail <- character() repeat { deps <- apply(available[p1, dependencies, drop = FALSE], 1L, function(x) paste(x[!is.na(x)], collapse=", ")) res <- .clean_up_dependencies2(deps, installed, available) not_avail <- c(not_avail, res[[2L]]) deps <- unique(res[[1L]]) ## R should not get to here, but be safe deps <- deps[!deps %in% c("R", pkgs)] if(!length(deps)) break pkgs <- c(deps, pkgs) p1 <- deps if(!is.null(dep2)) { dependencies <- dep2; dep2 <- NULL } } if(length(not_avail)) { not_avail <- unique(not_avail) warning(sprintf(ngettext(length(not_avail), "dependency %s is not available", "dependencies %s are not available"), paste(sQuote(not_avail), collapse=", ")), domain = NA, call. = FALSE, immediate. = TRUE) flush.console() } pkgs <- unique(pkgs) pkgs <- pkgs[pkgs %in% row.names(available)] if(length(pkgs) > length(p0)) { added <- setdiff(pkgs, p0) message(sprintf(ngettext(length(added), "also installing the dependency %s", "also installing the dependencies %s"), paste(sQuote(added), collapse=", ")), "\n", domain = NA) flush.console() } p0 <- pkgs } p0 } install.packages <- function(pkgs, lib, repos = getOption("repos"), contriburl = contrib.url(repos, type), method, available = NULL, destdir = NULL, dependencies = NA, type = getOption("pkgType"), configure.args = getOption("configure.args"), configure.vars = getOption("configure.vars"), clean = FALSE, Ncpus = getOption("Ncpus", 1L), verbose = getOption("verbose"), libs_only = FALSE, INSTALL_opts, quiet = FALSE, keep_outputs = FALSE, ...) { if(!(is.character(type) && length(type) == 1L)) stop(gettextf("'%s' must be a character string", "type"), domain = NA) type2 <- .Platform$pkgType if (type == "binary") { if (type2 == "source") stop("type 'binary' is not supported on this platform") else type <- type2 if(type == "both" && (!missing(contriburl) || !is.null(available))) stop("specifying 'contriburl' or 'available' requires a single type, not type = \"both\"") } if (is.logical(clean) && clean) clean <- "--clean" if(is.logical(dependencies) && is.na(dependencies)) dependencies <- if(!missing(lib) && length(lib) > 1L) FALSE else c("Depends", "Imports", "LinkingTo") ## Compute the configuration arguments for a given package. ## If configure.args is an unnamed character vector, use that. ## If it is named, match the pkg name to the names of the character ## vector and if we get a match, use that element. ## Similarly, configure.args is a list(), match pkg to the names pkg ## and use that element, collapsing it into a single string. get_package_name <- function(pkg) { ## Since the pkg argument can be the name of a file rather than ## a regular package name, we have to clean that up. gsub("_[.](zip|tar[.]gz|tar[.]bzip2|tar[.]xz)", "", gsub(.standard_regexps()$valid_package_version, "", basename(pkg))) } getConfigureArgs <- function(pkg) { if(.Platform$OS.type == "windows") return(character()) if(length(pkgs) == 1L && length(configure.args) && length(names(configure.args)) == 0L) return(paste0("--configure-args=", shQuote(paste(configure.args, collapse = " ")))) pkg <- get_package_name(pkg) if (length(configure.args) && length(names(configure.args)) && pkg %in% names(configure.args)) config <- paste0("--configure-args=", shQuote(paste(configure.args[[ pkg ]], collapse = " "))) else config <- character() config } getConfigureVars <- function(pkg) { if(.Platform$OS.type == "windows") return(character()) if(length(pkgs) == 1L && length(configure.vars) && length(names(configure.vars)) == 0L) return(paste0("--configure-vars=", shQuote(paste(configure.vars, collapse = " ")))) pkg <- get_package_name(pkg) if (length(configure.vars) && length(names(configure.vars)) && pkg %in% names(configure.vars)) config <- paste0("--configure-vars=", shQuote(paste(configure.vars[[ pkg ]], collapse = " "))) else config <- character() config } get_install_opts <- function(pkg) { if(!length(INSTALL_opts)) character() else paste(INSTALL_opts[[get_package_name(pkg)]], collapse = " ") } if(missing(pkgs)) { if(!interactive()) stop("no packages were specified") ## if no packages were specified, use a menu if(.Platform$OS.type == "windows" || .Platform$GUI == "AQUA" || (capabilities("tcltk") && capabilities("X11") && suppressWarnings(tcltk::.TkUp)) ) { ## this is the condition for a graphical select.list() } else stop("no packages were specified") ## This will only offer the specified type. If type = "both" ## do not want 'available' set for "source". if(is.null(available)) { av <- available.packages(contriburl = contriburl, method = method, ...) if (missing(repos)) ## Evaluating contriburl may have changed repos, which may be used below repos <- getOption("repos") if(type != "both") available <- av } else av <- available if(NROW(av)) { ## avoid duplicate entries in menus, since the latest available ## will be picked up ## sort in the locale, as R <= 2.10.1 did so pkgs <- select.list(sort(unique(rownames(av))), multiple = TRUE, title = "Packages", graphics = TRUE) } } if (.Platform$OS.type == "windows" && length(pkgs)) { ## look for package in use. pkgnames <- get_package_name(pkgs) ## there is no guarantee we have got the package name right: ## foo.zip might contain package bar or Foo or FOO or .... ## but we can't tell without trying to unpack it. inuse <- search() inuse <- sub("^package:", "", inuse[grep("^package:", inuse)]) inuse <- pkgnames %in% inuse if(any(inuse)) { warning(sprintf(ngettext(sum(inuse), "package %s is in use and will not be installed", "packages %s are in use and will not be installed"), paste(sQuote(pkgnames[inuse]), collapse=", ")), call. = FALSE, domain = NA, immediate. = TRUE) pkgs <- pkgs[!inuse] } } if(!length(pkgs)) return(invisible()) if(missing(lib) || is.null(lib)) { lib <- .libPaths()[1L] if(!quiet && length(.libPaths()) > 1L) message(sprintf(ngettext(length(pkgs), "Installing package into %s\n(as %s is unspecified)", "Installing packages into %s\n(as %s is unspecified)"), sQuote(lib), sQuote("lib")), domain = NA) } ## check for writability by user ok <- dir.exists(lib) & (file.access(lib, 2) == 0L) if(length(lib) > 1 && any(!ok)) stop(sprintf(ngettext(sum(!ok), "'lib' element %s is not a writable directory", "'lib' elements %s are not writable directories"), paste(sQuote(lib[!ok]), collapse=", ")), domain = NA) if(length(lib) == 1L && .Platform$OS.type == "windows") { ## file.access is unreliable on Windows, especially >= Vista. ## the only known reliable way is to try it ok <- dir.exists(lib) # dir might not exist, PR#14311 if(ok) { fn <- file.path(lib, paste0("_test_dir_", Sys.getpid())) unlink(fn, recursive = TRUE) # precaution res <- try(dir.create(fn, showWarnings = FALSE)) if(inherits(res, "try-error") || !res) ok <- FALSE else unlink(fn, recursive = TRUE) } } if(length(lib) == 1L && !ok) { warning(gettextf("'lib = \"%s\"' is not writable", lib), domain = NA, immediate. = TRUE) userdir <- unlist(strsplit(Sys.getenv("R_LIBS_USER"), .Platform$path.sep))[1L] if(interactive()) { ans <- askYesNo(gettext("Would you like to use a personal library instead?"), default = FALSE) if(!isTRUE(ans)) stop("unable to install packages") lib <- userdir if(!file.exists(userdir)) { ans <- askYesNo(gettextf("Would you like to create a personal library\n%s\nto install packages into?", sQuote(userdir)), default = FALSE) if(!isTRUE(ans)) stop("unable to install packages") if(!dir.create(userdir, recursive = TRUE)) stop(gettextf("unable to create %s", sQuote(userdir)), domain = NA) .libPaths(c(userdir, .libPaths())) } } else stop("unable to install packages") } lib <- normalizePath(lib) ## check if we should infer repos = NULL if(length(pkgs) == 1L && missing(repos) && missing(contriburl)) { if((type == "source" && any(grepl("[.]tar[.](gz|bz2|xz)$", pkgs))) || (type %in% "win.binary" && endsWith(pkgs, ".zip")) || (startsWith(type, "mac.binary") && endsWith(pkgs, ".tgz"))) { repos <- NULL message("inferring 'repos = NULL' from 'pkgs'") } if (type == "both") { if (type2 %in% "win.binary" && endsWith(pkgs, ".zip")) { repos <- NULL type <- type2 message("inferring 'repos = NULL' from 'pkgs'") } else if (startsWith(type2, "mac.binary") && endsWith(pkgs, ".tgz")) { repos <- NULL type <- type2 message("inferring 'repos = NULL' from 'pkgs'") } else if (grepl("[.]tar[.](gz|bz2|xz)$", pkgs)) { repos <- NULL type <- "source" message("inferring 'repos = NULL' from 'pkgs'") } } } ## check if we should infer the type if (length(pkgs) == 1L && is.null(repos) && type == "both") { if ( (type2 %in% "win.binary" && endsWith(pkgs, ".zip")) ||(startsWith(type2, "mac.binary") && endsWith(pkgs, ".tgz"))) { type <- type2 } else if (grepl("[.]tar[.](gz|bz2|xz)$", pkgs)) { type <- "source" } } if(is.null(repos) && missing(contriburl)) { tmpd <- destdir nonlocalrepos <- any(web <- grepl("^(http|https|ftp)://", pkgs)) if(is.null(destdir) && nonlocalrepos) { tmpd <- file.path(tempdir(), "downloaded_packages") if (!file.exists(tmpd) && !dir.create(tmpd)) stop(gettextf("unable to create temporary directory %s", sQuote(tmpd)), domain = NA) } if(nonlocalrepos) { df <- function(p, destfile, method, ...) download.file(p, destfile, method, mode = "wb", ...) urls <- pkgs[web] for (p in unique(urls)) { this <- pkgs == p destfile <- file.path(tmpd, basename(p)) res <- try(df(p, destfile, method, ...)) if(!inherits(res, "try-error") && res == 0L) pkgs[this] <- destfile else { ## There will be enough notification from the try() pkgs[this] <- NA } } } } ## Look at type == "both" ## NB it is only safe to use binary packages with a macOS ## build that uses the same R foundation layout as CRAN since ## paths in DSOs are hard-coded. if (type == "both") { if (type2 == "source") stop("type == \"both\" can only be used on Windows or a CRAN build for macOS") if (!missing(contriburl) || !is.null(available)) type <- type2 } getDeps <- TRUE if (type == "both") { if(is.null(repos)) stop("type == \"both\" cannot be used with 'repos = NULL'") type <- "source" contriburl <- contrib.url(repos, "source") ## The line above may have changed the repos option, so ... if (missing(repos)) repos <- getOption("repos") available <- available.packages(contriburl = contriburl, method = method, fields = "NeedsCompilation", ...) pkgs <- getDependencies(pkgs, dependencies, available, lib, ...) getDeps <- FALSE ## Now see what we can get as binary packages. av2 <- available.packages(contriburl = contrib.url(repos, type2), method = method, ...) bins <- row.names(av2) bins <- pkgs[pkgs %in% bins] srcOnly <- pkgs[! pkgs %in% bins] binvers <- av2[bins, "Version"] ## In most cases, packages that need compilation have non-NA "Archs" ## in their binary version and "NeedsCompilation" with value "yes" ## in their source version. However, the fields are not always ## filled in correctly and some binary packages have executable code ## outside "libs" (so "Archs" is NA), also a later version of a ## package may need compilation but an older one not. To reduce the ## risk that the user will attempt to install a package from source ## but without having the necessary tools to build it, packages are ## treated as needing compilation whenever they have non-NA "Archs" ## in binary version or/and "NeedsCompilation"="yes" in source ## version. hasArchs <- !is.na(av2[bins, "Archs"]) needsCmp <- !(available[bins, "NeedsCompilation"] %in% "no") hasSrc <- hasArchs | needsCmp srcvers <- available[bins, "Version"] later <- as.numeric_version(binvers) < srcvers action <- getOption("install.packages.compile.from.source", "interactive") if(!nzchar(Sys.which(Sys.getenv("MAKE", "make")))) action <- "never" ## Combining sources and binaries is currently broken (#18396), so ## at least on macOS we want to avoid it as much as we can. If ## binaries exist for all desired packages (regardless of version), ## sources will be ignored. if (grepl("darwin", R.version$platform) && !length(srcOnly)) later[later] <- FALSE if(any(later)) { msg <- ngettext(sum(later), "There is a binary version available but the source version is later", "There are binary versions available but the source versions are later") cat("\n", paste(strwrap(msg, indent = 2, exdent = 2), collapse = "\n"), ":\n", sep = "") out <- data.frame(`binary` = binvers, `source` = srcvers, `needs_compilation` = hasSrc, row.names = bins, check.names = FALSE)[later, ] print(out) cat("\n") if(any(later & hasSrc)) { if(action == "interactive" && interactive()) { msg <- ngettext(sum(later & hasSrc), "Do you want to install from sources the package which needs compilation?", "Do you want to install from sources the packages which need compilation?") res <- askYesNo(msg) if (is.na(res)) stop("Cancelled by user") if(!isTRUE(res)) later <- later & !hasSrc } else if (action == "never") { cat(" Binaries will be installed\n") later <- later & !hasSrc } } } bins <- bins[!later] ## This is unsafe (see above), but if there is no binary, there is really no choice. ## If this fails, the user can still use type='source' to recover. if(length(srcOnly)) { s2 <- srcOnly[!( available[srcOnly, "NeedsCompilation"] %in% "no" )] if(length(s2)) { msg <- ngettext(length(s2), "Package which is only available in source form, and may need compilation of C/C++/Fortran", "Packages which are only available in source form, and may need compilation of C/C++/Fortran") msg <- c(paste0(msg, ": "), sQuote(s2)) msg <- strwrap(paste(msg, collapse = " "), exdent = 2) message(paste(msg, collapse = "\n"), domain = NA) if(action == "interactive" && interactive()) { res <- askYesNo("Do you want to attempt to install these from sources?") if (is.na(res)) stop("Cancelled by user") if(!isTRUE(res)) pkgs <- setdiff(pkgs, s2) } else if(action == "never") { cat(" These will not be installed\n") pkgs <- setdiff(pkgs, s2) } } } if(length(bins)) { if(type2 == "win.binary") .install.winbinary(pkgs = bins, lib = lib, contriburl = contrib.url(repos, type2), method = method, available = av2, destdir = destdir, dependencies = NULL, libs_only = libs_only, quiet = quiet, ...) else .install.macbinary(pkgs = bins, lib = lib, contriburl = contrib.url(repos, type2), method = method, available = av2, destdir = destdir, dependencies = NULL, quiet = quiet, ...) } pkgs <- setdiff(pkgs, bins) if(!length(pkgs)) return(invisible()) message(sprintf(ngettext(length(pkgs), "installing the source package %s", "installing the source packages %s"), paste(sQuote(pkgs), collapse=", ")), "\n", domain = NA) flush.console() ## end of "both" } else if (getOption("install.packages.check.source", "yes") %in% "yes" && (type %in% "win.binary" || startsWith(type, "mac.binary"))) { if (missing(contriburl) && is.null(available) && !is.null(repos)) { contriburl2 <- contrib.url(repos, "source") # The line above may have changed the repos option, so.. if (missing(repos)) repos <- getOption("repos") av1 <- tryCatch(suppressWarnings( available.packages(contriburl = contriburl2, method = method, ...)), error = function(e)e) if(inherits(av1, "error")) { message("source repository is unavailable to check versions") available <- available.packages(contriburl = contrib.url(repos, type), method = method, ...) } else { srcpkgs <- pkgs[pkgs %in% row.names(av1)] ## Now see what we can get as binary packages. available <- available.packages(contriburl = contrib.url(repos, type), method = method, ...) bins <- pkgs[pkgs %in% row.names(available)] ## so a package might only be available as source, ## or it might be later in source. ## FIXME: might only want to check on the same repository, na <- srcpkgs[!srcpkgs %in% bins] if (length(na)) { msg <- sprintf(ngettext(length(na), "package %s is available as a source package but not as a binary", "packages %s are available as source packages but not as binaries"), paste(sQuote(na), collapse = ", ")) cat("\n ", msg, "\n\n", sep = "") } binvers <- available[bins, "Version"] srcvers <- binvers OK <- bins %in% srcpkgs srcvers[OK] <- av1[bins[OK], "Version"] later <- as.numeric_version(binvers) < srcvers if(any(later)) { msg <- ngettext(sum(later), "There is a binary version available (and will be installed) but the source version is later", "There are binary versions available (and will be installed) but the source versions are later") cat("\n", paste(strwrap(msg, indent = 2, exdent = 2), collapse = "\n"), ":\n", sep = "") print(data.frame(`binary` = binvers, `source` = srcvers, row.names = bins, check.names = FALSE)[later, ]) cat("\n") } } } } if(.Platform$OS.type == "windows") { if(startsWith(type, "mac.binary")) stop("cannot install macOS binary packages on Windows") if(type %in% "win.binary") { ## include local .zip files .install.winbinary(pkgs = pkgs, lib = lib, contriburl = contriburl, method = method, available = available, destdir = destdir, dependencies = dependencies, libs_only = libs_only, quiet = quiet, ...) return(invisible()) } ## Avoid problems with spaces in pathnames. have_spaces <- grep(" ", pkgs) if(length(have_spaces)) { ## we want the short name for the directory, ## but not for a .tar.gz, and package names never contain spaces. p <- pkgs[have_spaces] dirs <- shortPathName(dirname(p)) pkgs[have_spaces] <- file.path(dirs, basename(p)) } ## Avoid problems with backslashes ## -- will mess up UNC names, but they don't work pkgs <- gsub("\\", "/", pkgs, fixed=TRUE) } else { if(startsWith(type, "mac.binary")) { if(!grepl("darwin", R.version$platform)) stop("cannot install macOS binary packages on this platform") .install.macbinary(pkgs = pkgs, lib = lib, contriburl = contriburl, method = method, available = available, destdir = destdir, dependencies = dependencies, quiet = quiet, ...) return(invisible()) } if(type %in% "win.binary") stop("cannot install Windows binary packages on this platform") if(!file.exists(file.path(R.home("bin"), "INSTALL"))) stop("This version of R is not set up to install source packages\nIf it was installed from an RPM, you may need the R-devel RPM") } cmd0 <- file.path(R.home("bin"), "R") args0 <- c("CMD", "INSTALL") output <- if(quiet) FALSE else "" env <- character() tlim <- Sys.getenv("_R_INSTALL_PACKAGES_ELAPSED_TIMEOUT_") tlim <- if(!nzchar(tlim)) 0 else tools:::get_timeout(tlim) outdir <- getwd() if(is.logical(keep_outputs)) { if(is.na(keep_outputs)) keep_outputs <- FALSE } else if(is.character(keep_outputs) && (length(keep_outputs) == 1L)) { if(!dir.exists(keep_outputs) && !dir.create(keep_outputs, recursive = TRUE)) stop(gettextf("unable to create %s", sQuote(keep_outputs)), domain = NA) outdir <- normalizePath(keep_outputs) keep_outputs <- TRUE } else stop(gettextf("invalid %s argument", sQuote("keep_outputs")), domain = NA) ## we need to ensure that R CMD INSTALL runs with the same ## library trees, i.e., .R_LIBS() as this session. ## FIXME: At least on Windows, either run sub-R directly (to avoid sh) ## or run the install in the current process. if(length(libpath <- .R_LIBS())) { ## ## For the foreseeable future, the 'env' argument to system2() ## on Windows is limited to calls to make and rterm (but not R ## CMD): hence need to set the R_LIBS env var here. if(.Platform$OS.type == "windows") { ## We don't have a way to set an environment variable for ## a single command, as we do not spawn a shell. oldrlibs <- Sys.getenv("R_LIBS") Sys.setenv(R_LIBS = libpath) on.exit(Sys.setenv(R_LIBS = oldrlibs)) } else env <- paste0("R_LIBS=", shQuote(libpath)) ## } if (is.character(clean)) args0 <- c(args0, clean) if (libs_only) args0 <- c(args0, "--libs-only") if (!missing(INSTALL_opts)) { if(!is.list(INSTALL_opts)) { args0 <- c(args0, paste(INSTALL_opts, collapse = " ")) INSTALL_opts <- list() } } else { INSTALL_opts <- list() } if(verbose) message(gettextf("system (cmd0): %s", paste(c(cmd0, args0), collapse = " ")), domain = NA) if(is.null(repos) && missing(contriburl)) { ## install from local source tarball(s) update <- cbind(path.expand(pkgs), lib) # for side-effect of recycling to same length for(i in seq_len(nrow(update))) { if (is.na(update[i, 1L])) next args <- c(args0, get_install_opts(update[i, 1L]), "-l", shQuote(update[i, 2L]), getConfigureArgs(update[i, 1L]), getConfigureVars(update[i, 1L]), shQuote(update[i, 1L])) status <- system2(cmd0, args, env = env, stdout = output, stderr = output, timeout = tlim) ## if this times out it will leave locks behind if(status > 0L) warning(gettextf("installation of package %s had non-zero exit status", sQuote(update[i, 1L])), domain = NA) else if(verbose) { cmd <- paste(c(cmd0, args), collapse = " ") message(sprintf("%d): succeeded '%s'", i, cmd), domain = NA) } } return(invisible()) } tmpd <- destdir nonlocalrepos <- !all(startsWith(contriburl, "file:")) if(is.null(destdir) && nonlocalrepos) { tmpd <- file.path(tempdir(), "downloaded_packages") if (!file.exists(tmpd) && !dir.create(tmpd)) stop(gettextf("unable to create temporary directory %s", sQuote(tmpd)), domain = NA) } ## from here on we deal with source packages in repos av2 <- NULL if(is.null(available)) { filters <- getOption("available_packages_filters") if(!is.null(filters)) { available <- available.packages(contriburl = contriburl, method = method, ...) } else { f <- setdiff(available_packages_filters_default, c("R_version", "duplicates")) av2 <- available.packages(contriburl = contriburl, filters = f, method = method, ...) f <- available_packages_filters_db[["R_version"]] f2 <- available_packages_filters_db[["duplicates"]] available <- f2(f(av2)) } } if(getDeps) ## true except for type = "both" above. pkgs <- getDependencies(pkgs, dependencies, available, lib, ..., av2 = av2) foundpkgs <- download.packages(pkgs, destdir = tmpd, available = available, contriburl = contriburl, method = method, type = "source", quiet = quiet, ...) ## at this point 'pkgs' may contain duplicates, ## the same pkg in different libs if(length(foundpkgs)) { if(verbose) message(gettextf("foundpkgs: %s", paste(foundpkgs, collapse=", ")), domain = NA) update <- unique(cbind(pkgs, lib)) colnames(update) <- c("Package", "LibPath") found <- pkgs %in% foundpkgs[, 1L] files <- foundpkgs[match(pkgs[found], foundpkgs[, 1L]), 2L] if(verbose) message(gettextf("files: %s", paste(files, collapse=", \n\t")), domain = NA) update <- cbind(update[found, , drop=FALSE], file = files) if(nrow(update) > 1L) { upkgs <- unique(pkgs <- update[, 1L]) DL <- .make_dependency_list(upkgs, available) p0 <- .find_install_order(upkgs, DL) ## can't use update[p0, ] due to possible multiple matches update <- update[sort.list(match(pkgs, p0)), ] } if (Ncpus > 1L && nrow(update) > 1L) { tlim_cmd <- character() if(tlim > 0) { if(.Platform$OS.type == "windows" && !nzchar(Sys.getenv("R_TIMEOUT")) && grepl("\\windows\\system32\\", tolower(Sys.which("timeout")), fixed=TRUE)) { warning("Windows default 'timeout' command is not usable for parallel installs") } else if(nzchar(timeout <- Sys.which(Sys.getenv("R_TIMEOUT", "timeout")))) { ## SIGINT works better and is used for system. tlim_cmd <- c(shQuote(timeout), "-s INT", tlim) } else warning("timeouts for parallel installs require the 'timeout' command") } ## if --no-lock or --lock was specified in INSTALL_opts ## that will override this. args0 <- c(args0, "--pkglock") tmpd2 <- file.path(tempdir(), "make_packages") if (!file.exists(tmpd2) && !dir.create(tmpd2)) stop(gettextf("unable to create temporary directory %s", sQuote(tmpd2)), domain = NA) mfile <- file.path(tmpd2, "Makefile") conn <- file(mfile, "wt") deps <- paste(paste0(update[, 1L], ".ts"), collapse=" ") deps <- strwrap(deps, width = 75, exdent = 2) deps <- paste(deps, collapse=" \\\n") cat("all: ", deps, "\n", sep = "", file = conn) aDL <- .make_dependency_list(upkgs, available, recursive = TRUE) for(i in seq_len(nrow(update))) { pkg <- update[i, 1L] fil <- update[i, 3L] args <- c(args0, get_install_opts(fil), "-l", shQuote(update[i, 2L]), getConfigureArgs(fil), getConfigureVars(fil), shQuote(fil), ">", paste0(pkg, ".out"), "2>&1") ## ## We currently only use env on Unix for R_LIBS. ## Windows we do Sys.setenv(R_LIBS = libpath), ## since system2() has limited support for 'env' ## Should we use env on Windows as well? ## If so, would we need ## cmd <- paste(c(shQuote(command), env, args), ## collapse = " ") ## on Windows? cmd <- paste(c("MAKEFLAGS=", tlim_cmd, shQuote(cmd0), args), collapse = " ") ## deps <- aDL[[pkg]] deps <- deps[deps %in% upkgs] ## very unlikely to be too long deps <- if(length(deps)) paste(paste0(deps, ".ts"), collapse = " ") else "" cat(paste0(pkg, ".ts: ", deps), paste("\t@echo begin installing package", sQuote(pkg)), paste0("\t@", cmd, " && touch ", pkg, ".ts"), paste0("\t@cat ", pkg, ".out"), "", sep = "\n", file = conn) } close(conn) cwd <- setwd(tmpd2) on.exit(setwd(cwd)) ## MAKE will be set by sourcing Renviron status <- system2(Sys.getenv("MAKE", "make"), c("-k -j", Ncpus), stdout = output, stderr = output, env = env) if(status > 0L) { ## Try to figure out which pkgs <- update[, 1L] tss <- sub("[.]ts$", "", dir(".", pattern = "[.]ts$")) failed <- pkgs[!pkgs %in% tss] for (pkg in failed) { ## targets with failed dependencies are not made (even with -k) if (file.exists(outfile <- paste0(pkg, ".out"))) system2("cat", outfile) ##else cat("skipped installing package ", pkg, "\n", sep = "") } n <- length(failed) if (n == 1L) warning(gettextf("installation of package %s failed", sQuote(failed)), domain = NA) else if (n > 1L) { msg <- paste(sQuote(failed), collapse = ", ") if(nchar(msg) < 40) warning(gettextf( "installation of %d packages failed: %s", n, msg), domain = NA) else warning(gettextf( "installation of %d packages failed:\n %s", n, msg), domain = NA) } } if(keep_outputs) { outfiles <- paste0(update[, 1L], ".out") # some could be missing file.copy(outfiles[file.exists(outfiles)], outdir, overwrite = TRUE) } ## Keep binary packages possibly created via --build file.copy(Sys.glob(paste0(update[, 1L], "*.zip")), cwd) file.copy(Sys.glob(paste0(update[, 1L], "*.tgz")), cwd) file.copy(Sys.glob(paste0(update[, 1L], "*.tar.gz")), cwd) setwd(cwd); on.exit() unlink(tmpd2, recursive = TRUE) } else { tmpd2 <- tempfile() if(!dir.create(tmpd2)) stop(gettextf("unable to create temporary directory %s", sQuote(tmpd2)), domain = NA) outfiles <- file.path(tmpd2, paste0(update[, 1L], ".out")) for(i in seq_len(nrow(update))) { outfile <- if(keep_outputs) outfiles[i] else output fil <- update[i, 3L] args <- c(args0, get_install_opts(fil), "-l", shQuote(update[i, 2L]), getConfigureArgs(fil), getConfigureVars(fil), shQuote(fil)) status <- system2(cmd0, args, env = env, stdout = outfile, stderr = outfile, timeout = tlim) ## if this times out it will leave locks behind if(!quiet && keep_outputs) writeLines(readLines(outfile)) if(status > 0L) warning(gettextf("installation of package %s had non-zero exit status", sQuote(update[i, 1L])), domain = NA) else if(verbose) { cmd <- paste(c(cmd0, args), collapse = " ") message(sprintf("%d): succeeded '%s'", i, cmd), domain = NA) } } if(keep_outputs) file.copy(outfiles, outdir, overwrite = TRUE) unlink(tmpd2, recursive = TRUE) } ## Using stderr is the wish of PR#16420 if(!quiet && nonlocalrepos && !is.null(tmpd) && is.null(destdir)) cat("\n", gettextf("The downloaded source packages are in\n\t%s", sQuote(normalizePath(tmpd, mustWork = FALSE))), "\n", sep = "", file = stderr()) ## update packages.html on Unix only if .Library was installed into libs_used <- unique(update[, 2L]) if(.Platform$OS.type == "unix" && .Library %in% libs_used) { message("Updating HTML index of packages in '.Library'") make.packages.html(.Library) } } else if(!is.null(tmpd) && is.null(destdir)) unlink(tmpd, TRUE) invisible() }##end install.packages ## treat variables as global in a package, for codetools & check globalVariables <- function(names, package, add = TRUE) registerNames(names, package, ".__global__", add) ## suppress foreign function checks, for check suppressForeignCheck <- function(names, package, add = TRUE) registerNames(names, package, ".__suppressForeign__", add) registerNames <- function(names, package, .listFile, add = TRUE) { .simplePackageName <- function(env) { get0(".packageName", envir = env, inherits = FALSE, ifnotfound = "(unknown package)") } if(missing(package)) { env <- topenv(parent.frame(2L)) # We cannot be called directly! package <- .simplePackageName(env) } else if(is.environment(package)) { env <- package package <- .simplePackageName(env) } else env <- asNamespace(package) current <- get0(.listFile, envir = env, inherits = FALSE, ifnotfound = character()) if(! missing(names)) { if(environmentIsLocked(env)) stop(gettextf("The namespace for package \"%s\" is locked; no changes in the global variables list may be made.", package)) current <- if(add) unique(c(current, names)) else names assign(.listFile, current, envir = env) } current } packageName <- function(env = parent.frame()) { if (!is.environment(env)) stop("'env' must be an environment") env <- topenv(env) get0(".packageName", envir = env, inherits = FALSE) %||% if(identical(env, .BaseNamespaceEnv)) "base" ## else NULL } ##' R's .libPaths() to be used in 'R CMD ...' or similar, ##' most easily by a previous Sys.setenv(R_LIBS = .R_LIBS()) ## not yet exported .R_LIBS <- function(libp = .libPaths()) { libp <- libp[! libp %in% .Library] if(length(libp)) paste(libp, collapse = .Platform$path.sep) else "" # character(0) would fail in Sys.setenv() }