Skip to content

Commit

Permalink
Merge pull request #105 from chainsawriot/os
Browse files Browse the repository at this point in the history 
System Requirements query reform
  • Loading branch information
@chainsawriot
chainsawriot authored Mar 3, 2023
2 parents 13f909d + 75bd468 commit 750f9c9
Show file tree
Hide file tree
Showing 8 changed files with 299 additions and 300 deletions.
47 changes: 0 additions & 47 deletions R/installation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,53 +81,6 @@
uid = ordered_uid)
}

.is_ppa_in_sysreqs <- function(rang, warn = TRUE) {
res <- isTRUE(any(grepl("add-apt-repository", rang$sysreqs)))
if (isTRUE(res) && isTRUE(warn)) {
warning("The command for getting system requirements is likely not going to work for the default Docker images. You might need to requery system requirements with another version of Ubuntu.", call. = FALSE)
}
return(res)
}

.group_apt_cmds <- function(cmds, fix_libgit2 = FALSE) {
debs <- vapply(strsplit(cmds, "-y "), function(x) x[2], character(1))
if (isTRUE(fix_libgit2) && "libgit2-dev" %in% debs) {
if ("libcurl4-openssl-dev" %in% debs) {
debs[debs == "libcurl4-openssl-dev"] <- "libcurl4-gnutls-dev"
}
}
cmd <- paste("apt-get install -y", paste(sort(debs), collapse = " "))
if ("default-jdk" %in% debs) {
cmd <- paste(cmd, "liblzma-dev libpcre3-dev libbz2-dev && R CMD javareconf")
}
return(cmd)
}

.group_sysreqs <- function(rang) {
must_do_cmd <- "apt-get update -qq && apt-get install -y libpcre3-dev zlib1g-dev pkg-config"
if (length(rang$sysreqs) == 0) {
must_do_cmd <- paste(must_do_cmd, "libcurl4-openssl-dev")
return(must_do_cmd)
}
if (isFALSE(.is_ppa_in_sysreqs(rang))) {
cmds <- rang$sysreqs
prefix <- ""
cmd <- .group_apt_cmds(cmds, fix_libgit2 = TRUE)
if (!grepl("libcurl4-gnutls-dev", cmd)) {
must_do_cmd <- paste(must_do_cmd, "libcurl4-openssl-dev")
}
} else {
cmds <- setdiff(rang$sysreqs, c("apt-get install -y software-properties-common", "apt-get update"))
ppa_lines <- c("apt-get install -y software-properties-common",
grep("^add-apt-repository", rang$sysreqs, value = TRUE),
"apt-get update")
cmds <- setdiff(rang$sysreqs, ppa_lines)
prefix <- paste0(paste0(ppa_lines, collapse = " && "), " && ")
cmd <- .group_apt_cmds(cmds, fix_libgit2 = FALSE)
}
paste0(must_do_cmd, " && ", prefix, cmd)
}

.write_rang_as_comment <- function(rang, con, path, verbose, lib,
cran_mirror, check_cran_mirror, bioc_mirror) {
if (isTRUE(any(grepl("^local::", .extract_pkgrefs(rang))))) {
Expand Down
8 changes: 3 additions & 5 deletions R/memo_misc.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,13 +57,11 @@ NULL
## internal data generation
## ---
### Supported OS Versions
## os <- names(remotes:::supported_os_versions())
## supported_os <- unlist(mapply(function(x, y) paste(x,"-", y, sep = ""), os, remotes:::supported_os_versions()))
## names(supported_os) <- NULL
### R version history
## supported_os <- c("trusty" = "ubuntu-14.04", "xenial" = "ubuntu-16.04", "bionic" = "ubuntu-18.04", "focal" = "ubuntu-20.04", "centos-6", "centos-7", "centos-8", "redhat-6", "redhat-7", "redhat-8")
## ### R version history
## cached_rver <- .rver()
## attr(cached_rver, "newest_date") <- anytime::anytime(tail(cached_rver, n = 1)$date, tz = "UTC", asUTC = TRUE)
### Bioconductor version history
## ### Bioconductor version history
## cached_biocver <- .biocver()
## attr(cached_biocver, "newest_date") <- max(cached_biocver$date)
## usethis::use_data(supported_os, cached_rver, cached_biocver, internal = TRUE, overwrite = TRUE)
Expand Down
202 changes: 0 additions & 202 deletions R/resolve.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -452,208 +452,6 @@ print.rang <- function(x, all_pkgs = FALSE, ...) {
return(res)
}

#' Query for System Requirements
#'
#' This function takes an S3 object returned from [resolve()] and (re)queries the System Requirements.
#' @inheritParams export_rang
#' @inheritParams resolve
#' @inherit resolve return
#' @export
#' @seealso [resolve()]
#' @examples
#' \donttest{
#' if (interactive()) {
#' graph <- resolve(pkgs = c("openNLP", "LDAvis", "topicmodels", "quanteda"),
#' snapshot_date = "2020-01-16", query_sysreqs = FALSE)
#' graph$sysreqs
#' graph2 <- query_sysreqs(graph, os = "ubuntu-20.04")
#' graph2$sysreqs
#' }
#' }
query_sysreqs <- function(rang, os = "ubuntu-20.04") {
rang$os <- os
rang$sysreqs <- .query_sysreqs(rang = rang, os = os)
return(rang)
}

.query_sysreqs <- function(rang, os = "ubuntu-20.04") {
pkgrefs <- .extract_pkgrefs(rang)
if (length(pkgrefs) == 0) {
warning("No packages to query for system requirements.", call. = FALSE)
return(NA)
}
tryCatch({
return(.query_sysreqs_smart(pkgrefs = pkgrefs, os = os))
}, error = function(e) {
return(.query_sysreqs_safe(pkgrefs = pkgrefs, os = os))
})
}

.query_sysreqs_smart <- function(pkgrefs, os = "ubuntu-20.04") {
output <- list()
grouped_handles <- .group_pkgrefs_by_source(pkgrefs)
if ("github" %in% names(grouped_handles)) {
output[["github"]] <- .query_sysreqs_github(grouped_handles[["github"]], os = os)
}
if ("cran" %in% names(grouped_handles)) {
output[["cran"]] <- .query_sysreqs_cran(grouped_handles[["cran"]], os = os)
}
if ("bioc" %in% names(grouped_handles)) {
output[["bioc"]] <- .query_sysreqs_bioc(grouped_handles[["bioc"]], os = os)
}
if ("local" %in% names(grouped_handles)) {
output[["local"]] <- .query_sysreqs_local(grouped_handles[["local"]], os = os)
}
unique(unlist(output))
}

.query_sysreqs_safe <- function(pkgrefs, os = "ubuntu-20.04") {
output <- c()
for (pkgref in pkgrefs) {
source <- .parse_pkgref(pkgref, FALSE)
switch(source,
"cran" = {
query_fun <- .query_sysreqs_cran
},
"github" = {
query_fun <- .query_sysreqs_github
},
"bioc" = {
query_fun <- .query_sysreqs_bioc
})
tryCatch({
result <- query_fun(handles = .parse_pkgref(pkgref), os = os)
output <- c(output, result)
}, error = function(e) {
warning(pkgref, " can't be queried for System requirements. Assumed to have no requirement.", call. = FALSE)
})
}
return(unique(output))
}

## this is vectorized; and for consistency
.query_sysreqs_cran <- function(handles, os) {
remotes::system_requirements(package = handles, os = os)
}

.query_sysreqs_github <- function(handles, os) {
res <- lapply(handles, .query_sysreqs_github_single, os = os)
unique(unlist(res))
}

.query_sysreqs_bioc <- function(handles, os) {
if (grepl("^ubuntu|^debian", os)) {
arch <- "DEB"
}
if (grepl("^centos|^fedora|^redhat", os)) {
arch <- "RPM"
}
pkgs <- .memo_search_bioc(bioc_version = "release")
raw_sys_reqs <- pkgs$SystemRequirements[pkgs$Package %in% handles]
singleline_sysreqs <- paste0(raw_sys_reqs[!is.na(raw_sys_reqs)], collapse = ", ")
singleline_sysreqs <- gsub("\\n", " ", singleline_sysreqs)
.query_singleline_sysreqs(singleline_sysreqs = singleline_sysreqs, arch = arch)
}

.query_sysreqs_local <- function(handles, os) {
if (grepl("^ubuntu|^debian", os)) {
arch <- "DEB"
}
if (grepl("^centos|^fedora|^redhat", os)) {
arch <- "RPM"
}
description_paths <- vapply(handles, .extract_local_description_path, FUN.VALUE = character(1))
raw_sys_reqs <- vapply(description_paths, FUN = function(x) read.dcf(x, fields = "SystemRequirements")[,1],
FUN.VALUE = character(1))
singleline_sysreqs <- paste0(raw_sys_reqs[!is.na(raw_sys_reqs)], collapse = ", ")
singleline_sysreqs <- gsub("\\n", " ", singleline_sysreqs)
.query_singleline_sysreqs(singleline_sysreqs = singleline_sysreqs, arch = arch)
}

.query_singleline_sysreqs <- function(singleline_sysreqs, arch = "DEB") {
baseurl <- "https://sysreqs.r-hub.io/map/"
url <- utils::URLencode(paste0(baseurl, singleline_sysreqs))
query_res <- httr::content(httr::GET(url))
checkable_cmds <- vapply(query_res, .extract_sys_package, character(1), arch = arch)
uncheckable_cmds <- .extract_uncheckable_sysreqs(singleline_sysreqs, arch = arch)
c(checkable_cmds[!is.na(checkable_cmds)], uncheckable_cmds)
}

## Not everything can be check from sysreqs DB, especially Bioc packages
## https://github.com/r-hub/sysreqsdb
.extract_uncheckable_sysreqs <- function(singleline_sysreqs, arch) {
uncheckable_sysreqs <- list(liblzma = c("DEB" = "liblzma-dev", "RPM" = "xz-devel"),
libbz2 = c("DEB" = "libbz2-dev", "RPM" = "libbz2-devel"))
cmds <- c()
prefix <- c("DEB" = "apt-get install -y", "RPM" = "yum install -y")
for (regex in names(uncheckable_sysreqs)) {
if (grepl(regex, singleline_sysreqs)) {
cmds <- c(cmds, paste(prefix[arch], uncheckable_sysreqs[[regex]][arch]))
}
}
return(cmds)
}

.extract_sys_package <- function(item, arch = "DEB") {
output <- item[[names(item)]]$platforms[[arch]]
if (isFALSE(is.list((output)))) {
sys_pkg <- output
} else {
sys_pkg <- output[["buildtime"]]
}
if (is.null(sys_pkg)) {
return(NA_character_)
}
if (arch == "DEB") {
return(paste0("apt-get install -y ", sys_pkg))
}
if (arch == "RPM") {
return(paste0("yum install -y ", sys_pkg))
}
}

.query_sysreqs_posit <- function(description_file, os, remove_description = TRUE) {
os_info <- strsplit(os, "-")[[1]]
DEFAULT_RSPM <- "https://packagemanager.rstudio.com"
DEFAULT_RSPM_REPO_ID <- "1"
curl <- Sys.which("curl")
rspm_repo_id <- Sys.getenv("RSPM_REPO_ID", DEFAULT_RSPM_REPO_ID)
rspm <- Sys.getenv("RSPM_ROOT", DEFAULT_RSPM)
rspm_repo_url <- sprintf("%s/__api__/repos/%s", rspm, rspm_repo_id)
res <- system2(
curl,
args = c(
"--silent",
"--data-binary",
shQuote(paste0("@", description_file)),
shQuote(sprintf("%s/sysreqs?distribution=%s&release=%s&suggests=false",
rspm_repo_url,
os_info[1],
os_info[2])
)
),
stdout = TRUE
)
res <- jsonlite::fromJSON(res,simplifyDataFrame = FALSE)
if (!is.null(res$error)) {
stop(res$error)
}
if (isTRUE(remove_description)) {
file.remove(description_file)
}
unique(unlist(c(res[["install_scripts"]],
lapply(res[["dependencies"]], `[[`, "install_scripts"))))
}

## get system requirements for github packages
.query_sysreqs_github_single <- function(handle, os) {
description_file <- tempfile()
## potential issue: not going back to snapshot time! but the same is true for the remotes approach?
repo_descr <- .gh(paste0("/repos/", handle, "/contents/DESCRIPTION"))
writeLines(readLines(repo_descr$download_url), con = description_file)
.query_sysreqs_posit(description_file = description_file, os = os, remove_description = TRUE)
}

.gh <- function(path,ref = NULL,...){
url <- httr::parse_url("https://api.github.com/")
url <- httr::modify_url(url, path = path)
Expand Down
Binary file modified R/sysdata.rda
View file
Binary file not shown.
Loading

0 comments on commit 750f9c9

Please sign in to comment.