Feature/root (#20)

* fix double slash

* code refactoring

* fix test

* fix messages

* install as root when possible

* no need to patch in root mode

* no need to set rpath in root mode

* add docs about Docker workflows

* bump version, update NEWS

* simplify workflow matrix

.github/workflows/build.yml

@@ -5,14 +5,14 @@ jobs:
   build:
     if: ${{ !contains(github.event.head_commit.message, '[ci skip]') }}
     runs-on: ubuntu-latest
-    name: ${{ matrix.config.image }}:${{ matrix.config.tag }}
+    name: ${{ matrix.image }}:${{ matrix.tag }}
     container:
-      image: ${{ matrix.config.repo }}${{ matrix.config.image }}:${{ matrix.config.tag }}
+      image: ${{ matrix.repo }}${{ matrix.image }}:${{ matrix.tag }}
 
     strategy:
       fail-fast: false
       matrix:
-        config:
+        include:
         - {image: 'centos', tag: 'centos7', repo: 'ghcr.io/enchufa2/r-'}
         - {image: 'centos', tag: 'stream8', repo: 'ghcr.io/enchufa2/r-'}
         - {image: 'centos', tag: 'stream9', repo: 'ghcr.io/enchufa2/r-'}
@@ -24,14 +24,14 @@ jobs:
 
     steps:
     - name: Install dependencies (Ubuntu)
-      if: ${{ matrix.config.image == 'ubuntu' }}
+      if: ${{ matrix.image == 'ubuntu' }}
       run: |
         apt update && apt install -y apt-file
 
     - name: Install dependencies (openSUSE)
-      if: ${{ matrix.config.image == 'leap' }}
+      if: ${{ matrix.image == 'leap' }}
       run: |
-        zypper addrepo https://download.opensuse.org/repositories/Education/${{ matrix.config.tag }}/Education.repo
+        zypper addrepo https://download.opensuse.org/repositories/Education/${{ matrix.tag }}/Education.repo
         zypper --no-gpg-checks install -y tar R-base # no binaries available :(
 
     - uses: actions/checkout@v3
@@ -50,5 +50,5 @@ jobs:
       if: ${{ failure() }}
       uses: actions/upload-artifact@master
       with:
-        name: r-${{ matrix.config.image }}-${{ matrix.config.tag }}-results
+        name: r-${{ matrix.image }}-${{ matrix.tag }}-results
         path: check

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rspm
 Type: Package
 Title: 'RStudio' Package Manager
-Version: 0.3.1
+Version: 0.4.0
 Authors@R: c(
     person("Iñaki", "Ucar", email="[email protected]",
       role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550")),

NEWS.md

@@ -1,3 +1,8 @@
+# rspm 0.4.0
+
+- Implement root mode to improve Docker workflows (#20 addressing #17).
+- Internal refactoring to improve extensibility (as part of #20).
+
 # rspm 0.3.1
 
 - Fix version detection in CentOS (#18 addressing #16).

R/integration.R

@@ -31,7 +31,7 @@
 enable <- function() {
   check_requirements()
   enable_repo()
-  expr <- quote(get("install_sysreqs", asNamespace("rspm"))())
+  expr <- quote(rspm::install_sysreqs())
   opt$utils <- !exists("install.packages")
   if (opt$utils) {
     trace(utils::install.packages, exit=expr, print=FALSE)
@@ -73,39 +73,9 @@ disable_repo <- function() {
   opt$repos <- NULL
 }
 
-os <- function() {
-  os <- utils::read.table("/etc/os-release", sep="=", col.names=c("var", "val"),
-                          stringsAsFactors=FALSE)
-  os <- stats::setNames(as.list(os$val), os$var)
-  code <- switch(
-    id <- strsplit(os$ID, "-")[[1]][1],
-    "ubuntu" = os$VERSION_CODENAME,
-    "centos" = , "rocky"  = , "almalinux" = , "ol" = , "rhel" =
-      paste0(if ((ver <- safe_version(os$VERSION_ID)$major) < 9)
-        "centos" else "rhel", ver),
-    "amzn"   = if (os$VERSION_ID == "2") "centos7" else
-      stop("OS not supported", call.=FALSE),
-    "sles"   = , "opensuse" =
-      paste0("opensuse", sub("\\.", "", os$VERSION_ID)),
-    stop("OS not supported", call.=FALSE)
-  )
-  list(id = id, code = code)
-}
-
 .onLoad <- function(libname, pkgname) {
   options(HTTPUserAgent = sprintf("R/%s R (%s)", getRversion(), paste(
     getRversion(), R.version["platform"], R.version["arch"], R.version["os"])))
 
-  if (is.na(path <- Sys.getenv("RSPM_USER_DIR", unset=NA)))
-    path <- user_dir()
-  opt$user_dir <- path
-  dir.create(user_dir(), showWarnings=FALSE, recursive=TRUE, mode="0755")
-
-  reg.finalizer(opt, onexit=TRUE, function(opt) {
-    path <- opt$user_dir
-    while (length(setdiff(dir(path, all.files=TRUE), c(".", ".."))) == 0) {
-      unlink(path, recursive=TRUE, force=TRUE)
-      path <- dirname(path)
-    }
-  })
+  user_dir_init()
 }

R/manager.R

@@ -17,15 +17,15 @@
 #' @name manager
 #' @export
 install_sysreqs <- function() {
-  cat("Inspecting installed packages...\n")
+  message("Inspecting installed packages...")
 
   # get missing libraries
   if (!length(libs <- ldd_missing()))
     return(invisible())
 
   # install sysreqs and update rpath
-  get(paste0(os()$id, "_install_sysreqs"), asNamespace("rspm"))(libs)
-  set_rpath()
+  os_install_sysreqs(libs)
+  if (!root()) set_rpath()
 }
 
 ldd_missing <- function(lib.loc = NULL) {
@@ -42,7 +42,7 @@ ldd_missing <- function(lib.loc = NULL) {
 set_rpath <- function(lib.loc = NULL) {
   lib.loc <- user_lib(lib.loc)
   patchelf <- check_requirements("patchelf")
-  cat("Configuring sysreqs...\n")
+  message("Configuring sysreqs...")
 
   slibs <- list.files(user_dir("usr"), "\\.so", full.names=TRUE, recursive=TRUE)
   slibs <- slibs[!is.na(file.info(slibs)$size)]

R/os.R

@@ -0,0 +1,30 @@
+os_requirements <- function() {
+  get(paste0(os()$id, "_requirements"))()
+}
+
+os_install <- function(pkgs) {
+  get(paste0(os()$id, "_install"))(pkgs)
+}
+
+os_install_sysreqs <- function(libs) {
+  get(paste0(os()$id, "_install_sysreqs"))(libs)
+}
+
+os <- function() {
+  os <- utils::read.table("/etc/os-release", sep="=", col.names=c("var", "val"),
+                          stringsAsFactors=FALSE)
+  os <- stats::setNames(as.list(os$val), os$var)
+  code <- switch(
+    id <- strsplit(os$ID, "-")[[1]][1],
+    "ubuntu" = os$VERSION_CODENAME,
+    "centos" = , "rocky"  = , "almalinux" = , "ol" = , "rhel" =
+      paste0(if ((ver <- safe_version(os$VERSION_ID)$major) < 9)
+        "centos" else "rhel", ver),
+    "amzn"   = if (os$VERSION_ID == "2") "centos7" else
+      stop("OS not supported", call.=FALSE),
+    "sles"   = , "opensuse" =
+      paste0("opensuse", sub("\\.", "", os$VERSION_ID)),
+    stop("OS not supported", call.=FALSE)
+  )
+  list(id = id, code = code)
+}

R/utils.R

@@ -2,16 +2,38 @@ p <- function(...) paste(..., collapse=" ")
 system <- function(...) base::system(p(...), intern=FALSE)
 system_ <- function(...) suppressWarnings(base::system(p(...), intern=TRUE))
 safe_version <- function(x) package_version(paste0(x, "-1"))
+root <- function() Sys.info()["effective_user"] == "root"
 
-user_dir <- function(path="") {
-  user_dir <- opt$user_dir
+user_dir_base <- NULL
+
+user_dir <- function(path) {
+  user_dir <- user_dir_base
   if (is.null(user_dir)) {
     tenv <- asNamespace("tools")
     if (exists("R_user_dir", tenv))
       R_user_dir <- get("R_user_dir", tenv)
     user_dir <- R_user_dir("rspm")
   }
-  file.path(user_dir, path)
+  if (!missing(path))
+    user_dir <- file.path(user_dir, path)
+  user_dir
+}
+
+user_dir_init <- function() {
+  if (!is.null(user_dir_base)) return()
+
+  if (is.na(path <- Sys.getenv("RSPM_USER_DIR", unset=NA)))
+    path <- user_dir()
+  user_dir_base <<- path
+  dir.create(user_dir(), showWarnings=FALSE, recursive=TRUE, mode="0755")
+
+  reg.finalizer(opt, onexit=TRUE, function(opt) {
+    path <- user_dir_base
+    while (length(setdiff(dir(path, all.files=TRUE), c(".", ".."))) == 0) {
+      unlink(path, recursive=TRUE, force=TRUE)
+      path <- dirname(path)
+    }
+  })
 }
 
 user_lib <- function(lib.loc = NULL) {
@@ -21,20 +43,19 @@ user_lib <- function(lib.loc = NULL) {
 }
 
 check_requirements <- function(cmd) {
-  preqs <- get(paste0(os()$id, "_requirements"), asNamespace("rspm"))
-  preqs <- Sys.which(preqs)
+  preqs <- Sys.which(os_requirements())
   if (length(x <- names(preqs)[preqs == ""]))
     stop("please, install the following required utilities: ", x, call.=FALSE)
 
-  reqs <- c("ldd", "patchelf")
+  reqs <- c("ldd", if (!root()) "patchelf")
   reqs <- Sys.which(reqs)
   idx <- reqs == ""
   names(reqs)[idx] <- file.path(user_dir("usr/bin"), names(reqs)[idx])
   reqs <- Sys.which(names(reqs))
 
   if (length(missing <- basename(names(reqs))[reqs == ""])) {
-    cat("Downloading and installing required utilities...\n")
-    get(paste0(os()$id, "_install"), asNamespace("rspm"))(missing)
+    message("Downloading and installing required utilities...")
+    os_install(missing)
     reqs <- Sys.which(names(reqs))
   }
 

R/zzz_centos_base.R

@@ -1,47 +1,25 @@
-rpm_version <- function() {
-  if (Sys.which("rpm") == "")
-    return(package_version("999.999"))
-  ver <- strsplit(system_("rpm --version"), " ")[[1]][3]
-  package_version(ver)
-}
-
-# disable this altogether, it seems to fail in docker environments
-if (rpm_version() >= "1000.0") {
-  centos_requirements <- c()
-  centos_install_rpm <- function() {
-    system("rpm -i --nodeps --noscripts --notriggers --nosignature --excludedocs",
-           "--root", user_dir(), "*.rpm")
-  }
-} else if (rpm_version() >= "4.12") {
-  centos_requirements <- c("cat", "tar")
-  centos_install_rpm <- function() {
-    for (file in list.files(pattern=".rpm$"))
-      system("cat", file, "| rpm2archive - | tar xfz - -C", user_dir())
-  }
-} else {
-  centos_requirements <- c("cpio")
-  centos_install_rpm <- function() {
-    for (file in list.files(pattern=".rpm$"))
-      system("rpm2cpio", file, "| (cd", user_dir(), "; cpio -dium --quiet)")
-  }
-}
+centos_requirements <- function() rpm_requirements()
 
 centos_install <- function(pkgs) {
+  if (root()) return(centos_install_root(pkgs))
+
   dir.create(temp <- tempfile("rspm_"))
   old <- setwd(temp)
-  on.exit(setwd(old))
-  system(centos_cmd(), p(pkgs))
-  centos_install_rpm()
+  on.exit({ setwd(old); unlink(temp, recursive=TRUE, force=TRUE) })
+
+  cmd <- if (Sys.which("dnf") != "")
+    "dnf download" else "yumdownloader"
+  system(p(cmd, "--resolve"), p(pkgs))
+  rpm_install()
 }
 
-centos_install_sysreqs <- function(libs) {
-  cat("Downloading and installing sysreqs...\n")
-  centos_install(paste0("*/", libs, collapse=" "))
+centos_install_root <- function(pkgs) {
+  cmd <- if (Sys.which("dnf") != "")
+    "dnf" else "yum"
+  system(cmd, "-y install", p(pkgs))
 }
 
-centos_cmd <- function() {
-  cmd <- "yumdownloader --resolve"
-  if (Sys.which("dnf") != "")
-    cmd <- "dnf download --resolve"
-  cmd
+centos_install_sysreqs <- function(libs) {
+  message("Downloading and installing sysreqs...")
+  os_install(paste0("*/", libs, collapse=" "))
 }

R/zzz_centos_like.R

@@ -1,17 +1,20 @@
-rhel_requirements <- centos_requirements
-amzn_requirements <- centos_requirements
-rocky_requirements <- centos_requirements
-almalinux_requirements <- centos_requirements
-ol_requirements <- centos_requirements
+centos_requirements ->
+  rhel_requirements ->
+  amzn_requirements ->
+  rocky_requirements ->
+  almalinux_requirements ->
+  ol_requirements
 
-rhel_install <- function(pkgs) centos_install(pkgs)
-amzn_install <- function(pkgs) centos_install(pkgs)
-rocky_install <- function(pkgs) centos_install(pkgs)
-almalinux_install <- function(pkgs) centos_install(pkgs)
-ol_install <- function(pkgs) centos_install(pkgs)
+centos_install ->
+  rhel_install ->
+  amzn_install ->
+  rocky_install ->
+  almalinux_install ->
+  ol_install
 
-rhel_install_sysreqs <- function(libs) centos_install_sysreqs(libs)
-amzn_install_sysreqs <- function(libs) centos_install_sysreqs(libs)
-rocky_install_sysreqs <- function(libs) centos_install_sysreqs(libs)
-almalinux_install_sysreqs <- function(libs) centos_install_sysreqs(libs)
-ol_install_sysreqs <- function(libs) centos_install_sysreqs(libs)
+centos_install_sysreqs ->
+  rhel_install_sysreqs ->
+  amzn_install_sysreqs ->
+  rocky_install_sysreqs ->
+  almalinux_install_sysreqs ->
+  ol_install_sysreqs

R/zzz_opensuse_base.R

@@ -1,12 +1,18 @@
-opensuse_requirements <- c()
+opensuse_requirements <- function() rpm_requirements()
 
 opensuse_install <- function(pkgs) {
+  if (root()) return(opensuse_install_root(pkgs))
+
   dir.create(temp <- tempfile("rspm_"))
   old <- setwd(temp)
-  on.exit(setwd(old))
+  on.exit({ setwd(old); unlink(temp, recursive=TRUE, force=TRUE) })
+
   system("zypper --pkg-cache-dir . install -dy", p(pkgs))
-  system("rpm -i --nodeps --noscripts --notriggers --nosignature --excludedocs",
-         "-r", user_dir(), p(list.files(recursive=TRUE)))
+  rpm_install()
+}
+
+opensuse_install_root <- function(pkgs) {
+  system("zypper install -y", p(pkgs))
 }
 
 opensuse_install_sysreqs <- function(libs) {
@@ -16,6 +22,6 @@ opensuse_install_sysreqs <- function(libs) {
   pkgs <- trimws(sapply(strsplit(pkgs, "\\|"), "[", 2))
 
   # download and unpack
-  cat("Downloading and installing sysreqs...\n")
-  opensuse_install(pkgs)
+  message("Downloading and installing sysreqs...")
+  os_install(pkgs)
 }

R/zzz_opensuse_like.R

@@ -1,5 +1,8 @@
-sles_requirements <- opensuse_requirements
+opensuse_requirements ->
+  sles_requirements
 
-sles_install <- function(pkgs) opensuse_install(pkgs)
+opensuse_install ->
+  sles_install
 
-sles_install_sysreqs <- function(libs) opensuse_install_sysreqs(libs)
+opensuse_install_sysreqs ->
+  sles_install_sysreqs