···
{ store; tool_dir = tools }
224
+
(* Run a command *)
225
+
let exec (config : config) ~stdout fs proc
226
+
((H.Store ((module S), _) : entry H.t), (ctx : ctx)) (entry : entry) =
227
+
let build, env, (uid, gid) =
228
+
match entry.pre.build with
229
+
| Store.Build.Image img ->
230
+
let build, env, user = Store.fetch ctx.store img in
231
+
(build, env, Option.value ~default:(0, 0) user)
232
+
| Store.Build.Build cid -> (cid, entry.pre.env, entry.pre.user)
234
+
let command = entry.pre.args in
236
+
{ entry with pre = { entry.pre with build = Build build } }
238
+
(* Store things under History.pre, this makes it possible to rediscover
239
+
the hash for something purely from the arguments needed to execute something
240
+
rather than needing, for example, the time it took to execute! *)
241
+
let new_cid = Store.cid (Repr.to_string History.pre_t hash_entry.pre) in
242
+
let with_rootfs fn =
243
+
if entry.pre.mode = R then (Store.Run.with_build ctx.store build fn, [])
244
+
else Store.Run.with_clone ctx.store ~src:build new_cid fn
246
+
with_rootfs @@ function
248
+
(* Copy the stdout log to stdout *)
250
+
Eio.Path.(with_open_in (fs / (path :> string) / "log")) @@ fun ic ->
251
+
Eio.Flow.copy ic stdout
253
+
let c = Eio.Path.(load (fs / (path :> string) / "hash")) in
257
+
if config.no_runc then
258
+
let rootfs = Filename.concat rootfs "rootfs" in
261
+
|> Void.rootfs ~mode:entry.pre.mode rootfs
262
+
|> Void.cwd entry.pre.cwd
263
+
(* TODO: Support UIDs |> Void.uid 1000 *)
268
+
String.concat " " command ^ " && env > /tmp/shelter-env";
271
+
`Void (Void.spawn ~sw void |> Void.exit_status)
273
+
let tool_mount : Runc.Json_config.mount =
276
+
src = ctx.tool_dir;
277
+
dst = "/shelter-tools";
284
+
cwd = entry.pre.cwd;
289
+
String.concat " " command ^ " && env > /tmp/shelter-env";
292
+
network = [ "host" ];
294
+
env = entry.pre.env;
295
+
mounts = [ tool_mount ];
303
+
method stdout = stdout
306
+
`Runc (Runc.spawn ~sw log env config rootfs)
308
+
Switch.run @@ fun sw ->
310
+
Eio.Path.open_out ~sw ~create:(`If_missing 0o644)
311
+
Eio.Path.(fs / rootfs / "log")
313
+
let res = spawn sw log in
314
+
let start = Mtime_clock.now () in
317
+
| `Runc r -> Eio.Process.await r
318
+
| `Void v -> Void.to_eio_status (Eio.Promise.await v)
320
+
let stop = Mtime_clock.now () in
321
+
let span = Mtime.span start stop in
322
+
let time = Mtime.Span.to_uint64_ns span in
323
+
(* Add command to history regardless of exit status *)
324
+
let _ : (unit, string) result =
325
+
LNoise.history_add (String.concat " " command)
327
+
if res = `Exited 0 then (
330
+
Eio.Path.(fs / rootfs / "rootfs" / "tmp" / "shelter-env")
333
+
Eio.Path.(load env_path)
334
+
|> String.split_on_char '\n'
335
+
|> List.filter (fun s -> not (String.equal "" s))
337
+
Eio.Path.unlink env_path;
341
+
match Astring.String.cut ~sep:"=" v with
342
+
| Some ("PWD", dir) -> Some dir
345
+
|> Option.value ~default:hash_entry.pre.cwd
347
+
if entry.pre.mode = RW then
354
+
hash_entry.pre with
355
+
build = Build new_cid;
366
+
pre = { hash_entry.pre with cwd; env; user = (uid, gid) };
367
+
post = { hash_entry.post with time };
370
+
else Error (Eio.Process.Child_error res)
let run (config : config) ~stdout fs clock proc
(((H.Store ((module S), store) : entry H.t) as s), (ctx : ctx)) = function
···
post = { diff = []; time = 0L };
310
-
let build, env, (uid, gid) =
311
-
match entry.pre.build with
312
-
| Store.Build.Image img ->
313
-
let build, env, user = Store.fetch ctx.store img in
314
-
(build, env, Option.value ~default:(0, 0) user)
315
-
| Store.Build.Build cid -> (cid, entry.pre.env, entry.pre.user)
320
-
pre = { entry.pre with build = Build build; args = command };
323
-
(* Store things under History.pre, this makes it possible to rediscover
324
-
the hash for something purely from the arguments needed to execute something
325
-
rather than needing, for example, the time it took to execute! *)
326
-
let new_cid = Store.cid (Repr.to_string History.pre_t hash_entry.pre) in
327
-
let with_rootfs fn =
328
-
if entry.pre.mode = R then (Store.Run.with_build ctx.store build fn, [])
329
-
else Store.Run.with_clone ctx.store ~src:build new_cid fn
457
+
let entry = { entry with pre = { entry.pre with args = command } } in
332
-
let new_entry, diff =
333
-
with_rootfs @@ function
335
-
(* Copy the stdout log to stdout *)
337
-
Eio.Path.(with_open_in (fs / (path :> string) / "log"))
338
-
@@ fun ic -> Eio.Flow.copy ic stdout
340
-
let repo = S.repo store in
342
-
Eio.Path.(load (fs / (path :> string) / "hash"))
343
-
|> S.Hash.unsafe_of_raw_string |> S.Commit.of_hash repo
348
-
if config.no_runc then
349
-
let rootfs = Filename.concat rootfs "rootfs" in
352
-
|> Void.rootfs ~mode:entry.pre.mode rootfs
353
-
|> Void.cwd entry.pre.cwd
354
-
(* TODO: Support UIDs |> Void.uid 1000 *)
359
-
String.concat " " command
360
-
^ " && env > /tmp/shelter-env";
363
-
`Void (Void.spawn ~sw void |> Void.exit_status)
365
-
let tool_mount : Runc.Json_config.mount =
368
-
src = ctx.tool_dir;
369
-
dst = "/shelter-tools";
376
-
cwd = entry.pre.cwd;
381
-
String.concat " " command
382
-
^ " && env > /tmp/shelter-env";
385
-
network = [ "host" ];
387
-
env = entry.pre.env;
388
-
mounts = [ tool_mount ];
396
-
method stdout = stdout
399
-
`Runc (Runc.spawn ~sw log env config rootfs)
401
-
Switch.run @@ fun sw ->
403
-
Eio.Path.open_out ~sw ~create:(`If_missing 0o644)
404
-
Eio.Path.(fs / rootfs / "log")
406
-
let res = spawn sw log in
407
-
let start = Mtime_clock.now () in
410
-
| `Runc r -> Eio.Process.await r
411
-
| `Void v -> Void.to_eio_status (Eio.Promise.await v)
413
-
let stop = Mtime_clock.now () in
414
-
let span = Mtime.span start stop in
415
-
let time = Mtime.Span.to_uint64_ns span in
416
-
(* Add command to history regardless of exit status *)
417
-
let _ : (unit, string) result =
418
-
LNoise.history_add (String.concat " " command)
420
-
if res = `Exited 0 then (
423
-
Eio.Path.(fs / rootfs / "rootfs" / "tmp" / "shelter-env")
426
-
Eio.Path.(load env_path)
427
-
|> String.split_on_char '\n'
428
-
|> List.filter (fun s -> not (String.equal "" s))
430
-
Eio.Path.unlink env_path;
434
-
match Astring.String.cut ~sep:"=" v with
435
-
| Some ("PWD", dir) -> Some dir
438
-
|> Option.value ~default:hash_entry.pre.cwd
440
-
if entry.pre.mode = RW then
447
-
hash_entry.pre with
448
-
build = Build new_cid;
460
-
{ hash_entry.pre with cwd; env; user = (uid, gid) };
461
-
post = { hash_entry.post with time };
464
-
else Error (Eio.Process.Child_error res)
459
+
let new_entry, diff = exec config ~stdout fs proc (s, ctx) entry in
468
-
| Ok (`Reset None) ->
469
-
Fmt.epr "Resetting to existing entry failed...\n%!";
471
-
| Ok (`Reset (Some c)) ->
472
-
S.Head.set store c;
462
+
| Ok (`Reset c) -> (
464
+
S.Hash.unsafe_of_raw_string c |> S.Commit.of_hash (S.repo store)
467
+
Fmt.epr "Resetting to existing entry failed...\n%!";
470
+
S.Head.set store c;
| Ok (`Entry (entry, path)) ->
let entry = { entry with post = { entry.post with diff } } in
anil.recoil.org