This repository has been archived by the owner on Jun 17, 2022. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 1
/
identities.R
91 lines (88 loc) · 2.95 KB
/
identities.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
#' @name modules_list
#' @title List all installed outsider modules
#' @description Return the R package names of all installed outsider modules
#' @return Logical
#' @family ids
#' @export
modules_list <- function() {
pkgs <- installed_pkgs()
pkgnms <- unname(pkgs[, 'Package'])
libpaths <- unname(pkgs[, 'LibPath'])
yamls <- file.path(libpaths, pkgnms, 'om.yml')
pkgnms[file.exists(yamls)]
}
installed_pkgs <- function(...) {
utils::installed.packages(...)
}
#' @name meta_get
#' @title Get outsider module details
#' @description Return a named list of all metadata associated with a module
#' @param pkgnm Package name of module
#' @return Named list
#' @family ids
#' @export
meta_get <- function(pkgnm) {
yml_flpth <- system.file('om.yml', package = pkgnm)
if (!file.exists(yml_flpth)) {
msg <- paste0('No ', char('om.yml'), ' for ', char(pkgnm))
stop(msg, call. = FALSE)
}
res <- yaml::read_yaml(file = yml_flpth)
names(res) <- tolower(names(res))
# . are not allowed in image names
res[['image']] <- gsub(pattern = '\\.+', replacement = '_', x = pkgnm)
# container_base is based off image
res[['container']] <- res[['image']]
if (!is.null(res[['docker']]) && nchar(res[['docker']]) > 1) {
res[['image']] <- paste0(res[['docker']], '/', res[['image']])
}
res[['package']] <- pkgnm
services <- c('github', 'gitlab', 'bitbucket')
if (!'url' %in% names(res) & any(services %in% names(res))) {
service <- services[services %in% names(res)][[1]]
url <- switch(service, github = 'https://github.com/',
gitlab = 'https://gitlab.com/',
bitbucket = 'https://bitbucket.org/')
res[['url']] <- paste0(url, res[["package"]])
}
res
}
#' @name docker_ids_get
#' @title Get docker names for a module
#' @description Return the image and container names for a module. Will attempt
#' to build/pull image if missing.
#' @param pkgnm Package name of module
#' @return Logical
#' @family ids
docker_ids_get <- function(pkgnm) {
meta <- meta_get(pkgnm = pkgnm)
nps <- docker_ps_count()
imgs <- docker_img_ls()
img <- meta[['image']]
pull <- imgs[['repository']] == img
if (!any(pull)) {
# image is missing, false install
msg <- paste0('No Docker image found for ', char(pkgnm),
' -- attempting to pull/build image with tag ',
char('latest'))
message(msg)
success <- image_install(pkgnm = pkgnm, tag = 'latest', pull = TRUE)
if (!success) {
stop('Failed to build/pull image.', call. = FALSE)
}
imgs <- docker_img_ls()
pull <- imgs[['repository']] == img
}
if ('tag' %in% colnames(imgs)) {
tag <- imgs[pull, 'tag'][[1]]
tag <- tag[[1]]
} else {
# Sometimes there is no tag column (?)
# Most of the time it should be 'latest'
tag <- 'latest'
msg <- paste0('No tags detected, using ', char(tag))
warning(msg)
}
cntnr <- paste0(meta[['container']], '_', nps)
c('img' = img, 'cntnr' = cntnr, 'tag' = tag)
}