-
Notifications
You must be signed in to change notification settings - Fork 6
/
irods-demo.R
324 lines (293 loc) · 9.31 KB
/
irods-demo.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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
#' Run Docker iRODS Demonstration Service
#'
#' Run an iRODS demonstration server with `use_irods_demo()` as a Docker
#' container instance. The function `stop_irods_demo()` stops the containers.
#'
#' These functions are untested on Windows and macOS and require:
#' * `bash`
#' * `docker`
#'
#' @param user Character vector for user name (defaults to "rods" admin)
#' @param pass Character vector for password (defaults to "rods" admin password)
#' @param recreate Boolean to indicate whether to recreate (reboot) the iRODS
#' demo server (defaults to `FALSE`). Recreating will destroy all content on
#' the current instance.
#' @param verbose Verbosity (defaults to `TRUE`).
#' @references
#' https://github.com/irods/irods_demo
#'
#' @return Invisible
#' @export
#'
#' @examples
#'
#' if (interactive()) {
#'
#' # launch docker irods_demo containers (and possibly download images) with
#' # default credentials
#' use_irods_demo()
#'
#' # same but then with "alice" as user and "PASSword" as password
#' use_irods_demo("alice", "PASSword")
#'
#' # stop containers
#' stop_irods_demo()
#' }
#'
use_irods_demo <- function(user = character(), pass = character(),
recreate = FALSE, verbose = TRUE) {
# is Docker installed
if (!check_docker()) {
stop(
"Bash and Docker are required. \n",
"Install bash and docker to commence. Alternatively, sudo rights \n",
"are required for Docker: please check: \n",
"https://docs.docker.com/engine/install/linux-postinstall/",
call. = FALSE
)
}
# do irods_demo images exist on this machine?
resp_user <- TRUE
if (!check_irods_images()) {
message("\nThe iRODS demo Docker images are not available on this system. \n")
if (interactive()) {
resp_user <-
utils::askYesNo("Would you like it to be pull the iRODS demo Docker images?", default = FALSE)
}
}
# launch irods_demo
if (isTRUE(resp_user)) {
start_irods(verbose, recreate)
} else {
stop("The iRODS server could not be started!", call. = FALSE)
}
if (length(user) != 0 && length(pass) != 0) {
system2(
system.file(package = "rirods", "shell_scripts", "iadmin-docker-icommand.sh"),
Map(shQuote, c(user, pass)),
stdout = FALSE,
stderr = FALSE
)
} else {
user <- pass <- "rods"
}
# Sometimes it just does not want to start right. This will perform a dry run
# and restart the process again. This usually does the trick.
dry_run_irods(
user,
pass,
.irods_host,
paste0("/tempZone/home/", user),
verbose
)
message(
"\n",
"Do the following to connect with the iRODS demo server: \n",
"create_irods(\"", .irods_host, "\") \n",
"iauth(\"", user, "\", \"", pass, "\")"
)
invisible(NULL)
}
#' @rdname use_irods_demo
#'
#' @export
stop_irods_demo <- function(verbose = TRUE) {
system(
paste0("cd ", path_to_demo(), " ; docker compose down"),
ignore.stdout = !verbose,
ignore.stderr = !verbose
)
invisible(NULL)
}
#' Predicate for iRODS Demonstration Service State
#'
#' A predicate to check whether you are running iRODS docker demo containers.
#'
#' @param ... Currently not implemented.
#' @return Boolean whether or not connected to iRODS
#' @export
#'
#' @examples
#' is_irods_demo_running()
is_irods_demo_running <- function(...) {
# first check if Docker exist
if (!check_docker(FALSE)) {
return(FALSE)
}
# then check if images exist
if (!check_irods_images()) {
return(FALSE)
}
# check for client-icommand is not required (only needed for demo itself)
ref <- irods_containers_ref()
ref <- ref[ref != "irods-demo-irods-client-icommands-1"]
irods_containers_state <-
vapply(ref, is_irods_demo_running_, integer(1))
if (sum(irods_containers_state) == 0) TRUE else FALSE
}
# this seems not work on Windows
is_irods_demo_running_ <- function(x) {
system2(
system.file(package = "rirods", "shell_scripts", "docker-containers.sh"),
shQuote(x),
stderr = NULL
)
}
#' Remove Docker images from system
#' @keywords internal
#' @return Invisible
#' @noRd
remove_docker_images <- function() {
if (is_irods_demo_running()) {
stop("Docker containers are still running. Stop them with ",
"`stop_irods_demo()` and proceed", call. = FALSE)
}
invisible(Map(
function(x) {
system(paste("docker rmi", x), ignore.stderr = TRUE)
},
irods_images_ref("id")
))
}
start_irods <- function(verbose, recreate = TRUE) {
if (isTRUE(recreate)) {
cmd <- " ; docker compose up -d --force-recreate nginx-reverse-proxy irods-client-http-api irods-client-icommands"
} else {
cmd <- " ; docker compose up -d nginx-reverse-proxy irods-client-http-api irods-client-icommands"
}
system(
paste0("cd ", path_to_demo(), cmd),
ignore.stdout = !verbose,
ignore.stderr = !verbose
)
}
path_to_demo <- function() system.file("irods_demo", package = "rirods")
# perform dry run to see if iRODS can be used
dry_run_irods <- function(user, pass, host, lpath, verbose, user_input = FALSE) {
irods_server_status <- is_irods_server_operational(user, pass, host, lpath)
while (!irods_server_status) {
if (isFALSE(user_input)) {
message(
"\nThere seems to be a problem with the iRODS demo ",
"server. \nThe problem might be solved by rebooting the server. ",
"\nThis action will destroy all content on the server!\n"
)
user_input <- utils::askYesNo("Can I reboot the server?", default = FALSE)
}
if (isTRUE(user_input)) {
if (verbose) message("\nRecreating iRODS demo. This may take a while!\n")
start_irods(verbose, recreate = TRUE)
} else{
stop("The iRODS server could not be started!", call. = FALSE)
}
irods_server_status <- is_irods_server_operational(user, pass, host, lpath)
}
}
is_irods_server_operational <- function(user, pass, host, lpath) {
Sys.sleep(3) # requires some time to stand up
is_irods_server_running_correct() &&
is_http_server_running_correct(user, pass, host, lpath)
}
is_http_server_running_correct <- function(user, pass, host, lpath) {
system2(
system.file(package = "rirods", "shell_scripts", "dry-run-irods-curl.sh"),
Map(shQuote, c(user, pass, host, lpath)),
stdout = FALSE,
stderr = FALSE
) == 0
}
is_irods_server_running_correct <- function() {
system2(
system.file(package = "rirods", "shell_scripts", "dry-run-irods-icommands.sh"),
stdout = FALSE,
stderr = FALSE
) == 0
}
# look up table for irods_demo images
irods_images_ref <- function(filter_images = "name") {
if (filter_images == "id") {
dkr_format <- "{{.ID}}"
} else if (filter_images == "name") {
dkr_format <- "{{.Repository}}"
}
dkr_args <- c("irods-demo*", "irods/*", dkr_format)
dkr_args <- Map(shQuote, dkr_args)
cmd <- system.file(package = "rirods", "shell_scripts", "docker-images.sh")
# this does not work on all Windows OS
imgs <- try(system2(cmd, args = dkr_args, stdout = TRUE), silent = TRUE)
if (inherits(imgs, "try-error")) {
return(NULL)
} else {
return(imgs)
}
}
# are the images available on this system
check_irods_images <- function() {
if (length(irods_images_ref()) == 0) {
check_images_result <- FALSE
} else {
check_images_result <-
all(grepl(paste0(irods_images, collapse = "|"), irods_images_ref()))
}
check_images_result
}
# does Docker exist
check_docker <- function(verbose = TRUE) {
# check if Docker is installed and can be accessed without sudo rights
docker_version <- system("docker --version", ignore.stdout = !verbose,
ignore.stderr = !verbose)
!(Sys.which("bash") == "" || Sys.which("docker") == "" || docker_version == "")
}
irods_containers_ref <- function() {
irods_demo_yml <- system.file("irods_demo", "docker-compose.yml", package = "rirods")
irods_demo_file <- readLines(irods_demo_yml)
irods_images_ref <- grep("^\\s{4}[[:graph:]]*?:$", irods_demo_file)
irods_images <- irods_demo_file[irods_images_ref]
paste0("irods-demo-", trimws(gsub( ":$", "", irods_images)), "-1")
}
irods_images <- c(
"irods-demo-irods-catalog",
"irods-demo-irods-catalog-provider",
"irods-demo-irods-client-icommands",
"irods-demo-irods-client-rest-cpp",
"irods-demo-nginx-reverse-proxy",
"irods/irods_http_api"
)
#' Launch iRODS from Alternative Directory
#'
#' This function is useful during development as it prevents cluttering of the
#' package source files.
#'
#' @param host Hostname of the iRODS server. Defaults to
#' ""http://localhost:9001/irods-http-api/0.1.0".
#' @param dir The directory to use. Default is a temporary directory.
#' @param env Attach exit handlers to this environment. Defaults to the
#' parent frame (accessed through [parent.frame()]).
#'
#' @return Invisibly returns the original directory.
#' @keywords internal
#' @noRd
local_create_irods <- function(
host = NULL,
dir = tempdir(),
env = parent.frame()
) {
# default host
if (is.null(host)) {
if (Sys.getenv("DEV_KEY_IROD") != "") {
host <-
httr2::secret_decrypt(Sys.getenv("DEV_HOST_IRODS"), "DEV_KEY_IRODS")
} else {
host <- .irods_host
}
}
# to return to
old_dir <- getwd()
# change working directory
setwd(dir)
withr::defer(setwd(old_dir), envir = env)
# switch to new iRODS project
create_irods(host, overwrite = TRUE)
withr::defer(unlink(path_to_irods_conf()), envir = env)
invisible(dir)
}