1# File src/library/utils/R/unix/mac.install.R 2# Part of the R package, https://www.R-project.org 3# 4# Copyright (C) 1995-2017 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 19 20if(!startsWith(R.version$os, "darwin")) { 21.install.macbinary <- 22 function(pkgs, lib, repos = getOption("repos"), 23 contriburl = contrib.url(repos, type="mac.binary"), 24 method, available = NULL, destdir = NULL, 25 dependencies = FALSE, 26 lock = getOption("install.lock", FALSE), quiet = FALSE, 27 ...) 28 {} 29} else { 30## edited from windows/.install.winbinary 31## 32.install.macbinary <- 33 function(pkgs, lib, repos = getOption("repos"), 34 contriburl = contrib.url(repos, type="mac.binary"), 35 method, available = NULL, destdir = NULL, 36 dependencies = FALSE, 37 lock = getOption("install.lock", FALSE), quiet = FALSE, 38 ...) 39{ 40 untar <- function(what, where) 41 { 42 ## FIXME: should this look for Sys.getenv('TAR')? 43 ## Leopard has GNU tar, SL has BSD tar. 44 xcode <- system(paste0("tar zxf \"", path.expand(what), "\" -C \"", 45 path.expand(where), "\""), intern=FALSE) 46 if (xcode) 47 warning(gettextf("'tar' returned non-zero exit code %d", xcode), 48 domain = NA, call. = FALSE) 49 } 50 51 unpackPkg <- function(pkg, pkgname, lib, lock = FALSE) 52 { 53 ## Create a temporary directory and unpack the zip to it 54 ## then get the real package & version name, copying the 55 ## dir over to the appropriate install dir. 56 tmpDir <- tempfile(, lib) 57 if (!dir.create(tmpDir)) 58 stop(gettextf("unable to create temporary directory %s", 59 sQuote(tmpDir)), 60 domain = NA, call. = FALSE) 61 cDir <- getwd() 62 on.exit(setwd(cDir), add = TRUE) 63 res <- untar(pkg, tmpDir) 64 setwd(tmpDir) 65 ## sanity check: people have tried to install source .tgz files 66 if (!file.exists(file <- file.path(pkgname, "Meta", "package.rds"))) 67 stop(gettextf("file %s is not a macOS binary package", sQuote(pkg)), 68 domain = NA, call. = FALSE) 69 desc <- readRDS(file)$DESCRIPTION 70 if (length(desc) < 1L) 71 stop(gettextf("file %s is not a macOS binary package", sQuote(pkg)), 72 domain = NA, call. = FALSE) 73 desc <- as.list(desc) 74 if (is.null(desc$Built)) 75 stop(gettextf("file %s is not a macOS binary package", sQuote(pkg)), 76 domain = NA, call. = FALSE) 77 78 res <- tools::checkMD5sums(pkgname, file.path(tmpDir, pkgname)) 79 if(!quiet && !is.na(res) && res) { 80 cat(gettextf("package %s successfully unpacked and MD5 sums checked\n", 81 sQuote(pkgname))) 82 flush.console() 83 } 84 85 instPath <- file.path(lib, pkgname) 86 if(identical(lock, "pkglock") || isTRUE(lock)) { 87 lockdir <- if(identical(lock, "pkglock")) 88 file.path(lib, paste0("00LOCK-", pkgname)) 89 else file.path(lib, "00LOCK") 90 if (file.exists(lockdir)) { 91 stop(gettextf("ERROR: failed to lock directory %s for modifying\nTry removing %s", 92 sQuote(lib), sQuote(lockdir)), domain = NA) 93 } 94 dir.create(lockdir, recursive = TRUE) 95 if (!dir.exists(lockdir)) 96 stop(gettextf("ERROR: failed to create lock directory %s", 97 sQuote(lockdir)), domain = NA) 98 ## Back up a previous version 99 if (file.exists(instPath)) { 100 file.copy(instPath, lockdir, recursive = TRUE) 101 on.exit({ 102 if (restorePrevious) { 103 try(unlink(instPath, recursive = TRUE)) 104 savedcopy <- file.path(lockdir, pkgname) 105 file.copy(savedcopy, lib, recursive = TRUE) 106 warning(gettextf("restored %s", sQuote(pkgname)), 107 domain = NA, call. = FALSE, immediate. = TRUE) 108 } 109 }, add=TRUE) 110 restorePrevious <- FALSE 111 } 112 on.exit(unlink(lockdir, recursive = TRUE), add=TRUE) 113 } 114 ## If the package is already installed, remove it. If it 115 ## isn't there, the unlink call will still return success. 116 ret <- unlink(instPath, recursive=TRUE) 117 if (ret == 0L) { 118 ## Move the new package to the install lib and 119 ## remove our temp dir 120 ret <- file.rename(file.path(tmpDir, pkgname), instPath) 121 if(!ret) { 122 warning(gettextf("unable to move temporary installation %s to %s", 123 sQuote(file.path(tmpDir, pkgname)), 124 sQuote(instPath)), 125 domain = NA, call. = FALSE) 126 restorePrevious <- TRUE # Might not be used 127 } 128 } else 129 stop(gettextf("cannot remove prior installation of package %s", 130 sQuote(pkgname)), call. = FALSE, domain = NA) 131 setwd(cDir) 132 unlink(tmpDir, recursive=TRUE) 133 } 134 135 if(!length(pkgs)) return(invisible()) 136 137 if(is.null(contriburl)) { 138 pkgnames <- basename(pkgs) 139 pkgnames <- sub("\\.tgz$", "", pkgnames) 140 pkgnames <- sub("\\.tar\\.gz$", "", pkgnames) 141 pkgnames <- sub("_.*$", "", pkgnames) 142 ## there is no guarantee we have got the package name right: 143 ## foo.zip might contain package bar or Foo or FOO or .... 144 ## but we can't tell without trying to unpack it. 145 for(i in seq_along(pkgs)) { 146 if(is.na(pkgs[i])) next 147 unpackPkg(pkgs[i], pkgnames[i], lib, lock = lock) 148 } 149 return(invisible()) 150 } 151 tmpd <- destdir 152 nonlocalcran <- length(grep("^file:", contriburl)) < length(contriburl) 153 if(is.null(destdir) && nonlocalcran) { 154 tmpd <- file.path(tempdir(), "downloaded_packages") 155 if (!file.exists(tmpd) && !dir.create(tmpd)) 156 stop(gettextf("unable to create temporary directory %s", 157 sQuote(tmpd)), 158 domain = NA) 159 } 160 161 if(is.null(available)) 162 available <- available.packages(contriburl = contriburl, 163 method = method, ...) 164 pkgs <- getDependencies(pkgs, dependencies, available, lib, binary = TRUE) 165 166 foundpkgs <- download.packages(pkgs, destdir = tmpd, available = available, 167 contriburl = contriburl, method = method, 168 type = "mac.binary", quiet = quiet, ...) 169 170 if(length(foundpkgs)) { 171 update <- unique(cbind(pkgs, lib)) 172 colnames(update) <- c("Package", "LibPath") 173 for(lib in unique(update[,"LibPath"])) { 174 oklib <- lib==update[,"LibPath"] 175 for(p in update[oklib, "Package"]) 176 { 177 okp <- p == foundpkgs[, 1L] 178 if(any(okp)) 179 unpackPkg(foundpkgs[okp, 2L], foundpkgs[okp, 1L], lib, 180 lock = lock) 181 } 182 } 183 if(!quiet && !is.null(tmpd) && is.null(destdir)) 184 cat("\n", gettextf("The downloaded binary packages are in\n\t%s", tmpd), 185 "\n", sep = "") 186 } else if(!is.null(tmpd) && is.null(destdir)) unlink(tmpd, recursive = TRUE) 187 188 invisible() 189} 190} 191