#  File src/library/utils/R/packages2.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2018 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"),
                       error = function(e) e, warning = function(e) e)
  identical(priority, "base")
}

getDependencies <-
    function(pkgs, dependencies = NA, available = NULL, lib = .libPaths()[1L],
             binary = FALSE, ...)
{
    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)
    if(sum(miss)) {
        msg <- paste0(if(binary) "as a binary package ", "for ",
                      sub(" *\\(.*","", R.version.string))
	warning(sprintf(ngettext(sum(miss),
				 "package %s is not available (%s)",
				 "packages %s are not available (%s)"),
			paste(sQuote(p0[miss]), collapse = ", "), msg),
                domain = NA, call. = FALSE)
        base <- vapply(p0[miss], 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[miss][base]), collapse = ", ")),
                  domain = NA, call. = FALSE)
        if (sum(miss) == 1L &&
            !is.na(w <- match(tolower(p0[miss]),
                              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) { # 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,
             ...)
{
    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(!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"
        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]

        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)
    } 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")
    }

    ## we need to ensure that R CMD INSTALL runs with the same
    ## library trees as this session.
    ## FIXME: At least on Windows, either run sub-R directly (to avoid sh)
    ## or run the install in the current process.
    libpath <- .libPaths()
    libpath <- libpath[! libpath %in% .Library]
    if(length(libpath))
        libpath <- paste(libpath, collapse = .Platform$path.sep)

    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(is.na(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)

    if(length(libpath)) {
        ## <NOTE>
        ## 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))
        ## </NOTE>
    }

    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)
    }

    if(is.null(available))
        available <- available.packages(contriburl = contriburl,
                                        method = method, ...)
    if(getDeps)
        pkgs <- getDependencies(pkgs, dependencies, available, lib, ...)

    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(nzchar(timeout <- Sys.which("timeout"))) {
                    ## SIGINT works better and is used for system.
                    tlim_cmd <- c(shQuote(timeout), "--signal=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]
                args <- c(args0,
                          get_install_opts(update[i, 3L]),
                          "-l", shQuote(update[i, 2L]),
                          getConfigureArgs(update[i, 3L]),
                          getConfigureVars(update[i, 3L]),
                          shQuote(update[i, 3L]),
                          ">", paste0(pkg, ".out"),
                          "2>&1")
                ## <NOTE>
                ## 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 = " ")
                ## </NOTE>
                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) system(paste0("cat ", pkg, ".out"))
                warning(gettextf("installation of one or more packages failed,\n  probably %s",
                                 paste(sQuote(failed), collapse = ", ")),
                        domain = NA)
            }
            if(keep_outputs)
                file.copy(paste0(update[, 1L], ".out"), outdir)
            setwd(cwd); on.exit()
            unlink(tmpd2, recursive = TRUE)
        } else {
            outfiles <- paste0(update[, 1L], ".out")
            for(i in seq_len(nrow(update))) {
                outfile <- if(keep_outputs) outfiles[i] else output
                args <- c(args0,
                          get_install_opts(update[i, 3L]),
                          "-l", shQuote(update[i, 2L]),
                          getConfigureArgs(update[i, 3L]),
                          getConfigureVars(update[i, 3L]),
                          update[i, 3L])
                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 && (outdir != getwd())) {
                file.copy(outfiles, outdir)
                file.remove(outfiles)
            }
        }
        ## 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()
}

## 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) {
        if(exists(".packageName", envir = env, inherits = FALSE))
           get(".packageName", envir = env)
        else
            "(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)
    if(exists(.listFile, envir = env, inherits = FALSE))
        current <- get(.listFile, envir = env)
    else
        current <- 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))
        if(add)
            current <- unique(c(current, names))
        else
            current <- 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)
    if (!is.null(pn <- get0(".packageName", envir = env, inherits = FALSE)))
	pn
    else if (identical(env, .BaseNamespaceEnv))
	"base"
    ## else NULL
}