···
221
221
in
222
222
{ store; tool_dir = tools }
223
223
224
224
+
(* Run a command *)
225
225
+
let exec (config : config) ~stdout fs proc
226
226
+
((H.Store ((module S), _) : entry H.t), (ctx : ctx)) (entry : entry) =
227
227
+
let build, env, (uid, gid) =
228
228
+
match entry.pre.build with
229
229
+
| Store.Build.Image img ->
230
230
+
let build, env, user = Store.fetch ctx.store img in
231
231
+
(build, env, Option.value ~default:(0, 0) user)
232
232
+
| Store.Build.Build cid -> (cid, entry.pre.env, entry.pre.user)
233
233
+
in
234
234
+
let command = entry.pre.args in
235
235
+
let hash_entry =
236
236
+
{ entry with pre = { entry.pre with build = Build build } }
237
237
+
in
238
238
+
(* Store things under History.pre, this makes it possible to rediscover
239
239
+
the hash for something purely from the arguments needed to execute something
240
240
+
rather than needing, for example, the time it took to execute! *)
241
241
+
let new_cid = Store.cid (Repr.to_string History.pre_t hash_entry.pre) in
242
242
+
let with_rootfs fn =
243
243
+
if entry.pre.mode = R then (Store.Run.with_build ctx.store build fn, [])
244
244
+
else Store.Run.with_clone ctx.store ~src:build new_cid fn
245
245
+
in
246
246
+
with_rootfs @@ function
247
247
+
| `Exists path ->
248
248
+
(* Copy the stdout log to stdout *)
249
249
+
let () =
250
250
+
Eio.Path.(with_open_in (fs / (path :> string) / "log")) @@ fun ic ->
251
251
+
Eio.Flow.copy ic stdout
252
252
+
in
253
253
+
let c = Eio.Path.(load (fs / (path :> string) / "hash")) in
254
254
+
Ok (`Reset c)
255
255
+
| `Build rootfs ->
256
256
+
let spawn sw log =
257
257
+
if config.no_runc then
258
258
+
let rootfs = Filename.concat rootfs "rootfs" in
259
259
+
let void =
260
260
+
Void.empty
261
261
+
|> Void.rootfs ~mode:entry.pre.mode rootfs
262
262
+
|> Void.cwd entry.pre.cwd
263
263
+
(* TODO: Support UIDs |> Void.uid 1000 *)
264
264
+
|> Void.exec ~env
265
265
+
[
266
266
+
config.shell;
267
267
+
"-c";
268
268
+
String.concat " " command ^ " && env > /tmp/shelter-env";
269
269
+
]
270
270
+
in
271
271
+
`Void (Void.spawn ~sw void |> Void.exit_status)
272
272
+
else
273
273
+
let tool_mount : Runc.Json_config.mount =
274
274
+
{
275
275
+
ty = `Bind;
276
276
+
src = ctx.tool_dir;
277
277
+
dst = "/shelter-tools";
278
278
+
readonly = true;
279
279
+
}
280
280
+
in
281
281
+
let config =
282
282
+
Runc.Json_config.
283
283
+
{
284
284
+
cwd = entry.pre.cwd;
285
285
+
argv =
286
286
+
[
287
287
+
config.shell;
288
288
+
"-c";
289
289
+
String.concat " " command ^ " && env > /tmp/shelter-env";
290
290
+
];
291
291
+
hostname = "";
292
292
+
network = [ "host" ];
293
293
+
user = (uid, gid);
294
294
+
env = entry.pre.env;
295
295
+
mounts = [ tool_mount ];
296
296
+
entrypoint = None;
297
297
+
}
298
298
+
in
299
299
+
let env =
300
300
+
object
301
301
+
method fs = fs
302
302
+
method proc = proc
303
303
+
method stdout = stdout
304
304
+
end
305
305
+
in
306
306
+
`Runc (Runc.spawn ~sw log env config rootfs)
307
307
+
in
308
308
+
Switch.run @@ fun sw ->
309
309
+
let log =
310
310
+
Eio.Path.open_out ~sw ~create:(`If_missing 0o644)
311
311
+
Eio.Path.(fs / rootfs / "log")
312
312
+
in
313
313
+
let res = spawn sw log in
314
314
+
let start = Mtime_clock.now () in
315
315
+
let res =
316
316
+
match res with
317
317
+
| `Runc r -> Eio.Process.await r
318
318
+
| `Void v -> Void.to_eio_status (Eio.Promise.await v)
319
319
+
in
320
320
+
let stop = Mtime_clock.now () in
321
321
+
let span = Mtime.span start stop in
322
322
+
let time = Mtime.Span.to_uint64_ns span in
323
323
+
(* Add command to history regardless of exit status *)
324
324
+
let _ : (unit, string) result =
325
325
+
LNoise.history_add (String.concat " " command)
326
326
+
in
327
327
+
if res = `Exited 0 then (
328
328
+
(* Extract env *)
329
329
+
let env_path =
330
330
+
Eio.Path.(fs / rootfs / "rootfs" / "tmp" / "shelter-env")
331
331
+
in
332
332
+
let env =
333
333
+
Eio.Path.(load env_path)
334
334
+
|> String.split_on_char '\n'
335
335
+
|> List.filter (fun s -> not (String.equal "" s))
336
336
+
in
337
337
+
Eio.Path.unlink env_path;
338
338
+
let cwd =
339
339
+
List.find_map
340
340
+
(fun v ->
341
341
+
match Astring.String.cut ~sep:"=" v with
342
342
+
| Some ("PWD", dir) -> Some dir
343
343
+
| _ -> None)
344
344
+
env
345
345
+
|> Option.value ~default:hash_entry.pre.cwd
346
346
+
in
347
347
+
if entry.pre.mode = RW then
348
348
+
Ok
349
349
+
(`Entry
350
350
+
( {
351
351
+
hash_entry with
352
352
+
History.pre =
353
353
+
{
354
354
+
hash_entry.pre with
355
355
+
build = Build new_cid;
356
356
+
env;
357
357
+
cwd;
358
358
+
user = (uid, gid);
359
359
+
};
360
360
+
},
361
361
+
rootfs ))
362
362
+
else
363
363
+
Ok
364
364
+
(`Entry
365
365
+
( {
366
366
+
pre = { hash_entry.pre with cwd; env; user = (uid, gid) };
367
367
+
post = { hash_entry.post with time };
368
368
+
},
369
369
+
rootfs )))
370
370
+
else Error (Eio.Process.Child_error res)
371
371
+
224
372
let run (config : config) ~stdout fs clock proc
225
373
(((H.Store ((module S), store) : entry H.t) as s), (ctx : ctx)) = function
226
374
| Set_mode mode ->
···
304
452
};
305
453
post = { diff = []; time = 0L };
306
454
})
307
307
-
s
308
308
-
@@ fun e -> e
309
309
-
in
310
310
-
let build, env, (uid, gid) =
311
311
-
match entry.pre.build with
312
312
-
| Store.Build.Image img ->
313
313
-
let build, env, user = Store.fetch ctx.store img in
314
314
-
(build, env, Option.value ~default:(0, 0) user)
315
315
-
| Store.Build.Build cid -> (cid, entry.pre.env, entry.pre.user)
316
316
-
in
317
317
-
let hash_entry =
318
318
-
{
319
319
-
entry with
320
320
-
pre = { entry.pre with build = Build build; args = command };
321
321
-
}
455
455
+
s Fun.id
322
456
in
323
323
-
(* Store things under History.pre, this makes it possible to rediscover
324
324
-
the hash for something purely from the arguments needed to execute something
325
325
-
rather than needing, for example, the time it took to execute! *)
326
326
-
let new_cid = Store.cid (Repr.to_string History.pre_t hash_entry.pre) in
327
327
-
let with_rootfs fn =
328
328
-
if entry.pre.mode = R then (Store.Run.with_build ctx.store build fn, [])
329
329
-
else Store.Run.with_clone ctx.store ~src:build new_cid fn
330
330
-
in
457
457
+
let entry = { entry with pre = { entry.pre with args = command } } in
331
458
try
332
332
-
let new_entry, diff =
333
333
-
with_rootfs @@ function
334
334
-
| `Exists path ->
335
335
-
(* Copy the stdout log to stdout *)
336
336
-
let () =
337
337
-
Eio.Path.(with_open_in (fs / (path :> string) / "log"))
338
338
-
@@ fun ic -> Eio.Flow.copy ic stdout
339
339
-
in
340
340
-
let repo = S.repo store in
341
341
-
let c =
342
342
-
Eio.Path.(load (fs / (path :> string) / "hash"))
343
343
-
|> S.Hash.unsafe_of_raw_string |> S.Commit.of_hash repo
344
344
-
in
345
345
-
Ok (`Reset c)
346
346
-
| `Build rootfs ->
347
347
-
let spawn sw log =
348
348
-
if config.no_runc then
349
349
-
let rootfs = Filename.concat rootfs "rootfs" in
350
350
-
let void =
351
351
-
Void.empty
352
352
-
|> Void.rootfs ~mode:entry.pre.mode rootfs
353
353
-
|> Void.cwd entry.pre.cwd
354
354
-
(* TODO: Support UIDs |> Void.uid 1000 *)
355
355
-
|> Void.exec ~env
356
356
-
[
357
357
-
config.shell;
358
358
-
"-c";
359
359
-
String.concat " " command
360
360
-
^ " && env > /tmp/shelter-env";
361
361
-
]
362
362
-
in
363
363
-
`Void (Void.spawn ~sw void |> Void.exit_status)
364
364
-
else
365
365
-
let tool_mount : Runc.Json_config.mount =
366
366
-
{
367
367
-
ty = `Bind;
368
368
-
src = ctx.tool_dir;
369
369
-
dst = "/shelter-tools";
370
370
-
readonly = true;
371
371
-
}
372
372
-
in
373
373
-
let config =
374
374
-
Runc.Json_config.
375
375
-
{
376
376
-
cwd = entry.pre.cwd;
377
377
-
argv =
378
378
-
[
379
379
-
config.shell;
380
380
-
"-c";
381
381
-
String.concat " " command
382
382
-
^ " && env > /tmp/shelter-env";
383
383
-
];
384
384
-
hostname = "";
385
385
-
network = [ "host" ];
386
386
-
user = (uid, gid);
387
387
-
env = entry.pre.env;
388
388
-
mounts = [ tool_mount ];
389
389
-
entrypoint = None;
390
390
-
}
391
391
-
in
392
392
-
let env =
393
393
-
object
394
394
-
method fs = fs
395
395
-
method proc = proc
396
396
-
method stdout = stdout
397
397
-
end
398
398
-
in
399
399
-
`Runc (Runc.spawn ~sw log env config rootfs)
400
400
-
in
401
401
-
Switch.run @@ fun sw ->
402
402
-
let log =
403
403
-
Eio.Path.open_out ~sw ~create:(`If_missing 0o644)
404
404
-
Eio.Path.(fs / rootfs / "log")
405
405
-
in
406
406
-
let res = spawn sw log in
407
407
-
let start = Mtime_clock.now () in
408
408
-
let res =
409
409
-
match res with
410
410
-
| `Runc r -> Eio.Process.await r
411
411
-
| `Void v -> Void.to_eio_status (Eio.Promise.await v)
412
412
-
in
413
413
-
let stop = Mtime_clock.now () in
414
414
-
let span = Mtime.span start stop in
415
415
-
let time = Mtime.Span.to_uint64_ns span in
416
416
-
(* Add command to history regardless of exit status *)
417
417
-
let _ : (unit, string) result =
418
418
-
LNoise.history_add (String.concat " " command)
419
419
-
in
420
420
-
if res = `Exited 0 then (
421
421
-
(* Extract env *)
422
422
-
let env_path =
423
423
-
Eio.Path.(fs / rootfs / "rootfs" / "tmp" / "shelter-env")
424
424
-
in
425
425
-
let env =
426
426
-
Eio.Path.(load env_path)
427
427
-
|> String.split_on_char '\n'
428
428
-
|> List.filter (fun s -> not (String.equal "" s))
429
429
-
in
430
430
-
Eio.Path.unlink env_path;
431
431
-
let cwd =
432
432
-
List.find_map
433
433
-
(fun v ->
434
434
-
match Astring.String.cut ~sep:"=" v with
435
435
-
| Some ("PWD", dir) -> Some dir
436
436
-
| _ -> None)
437
437
-
env
438
438
-
|> Option.value ~default:hash_entry.pre.cwd
439
439
-
in
440
440
-
if entry.pre.mode = RW then
441
441
-
Ok
442
442
-
(`Entry
443
443
-
( {
444
444
-
hash_entry with
445
445
-
History.pre =
446
446
-
{
447
447
-
hash_entry.pre with
448
448
-
build = Build new_cid;
449
449
-
env;
450
450
-
cwd;
451
451
-
user = (uid, gid);
452
452
-
};
453
453
-
},
454
454
-
rootfs ))
455
455
-
else
456
456
-
Ok
457
457
-
(`Entry
458
458
-
( {
459
459
-
pre =
460
460
-
{ hash_entry.pre with cwd; env; user = (uid, gid) };
461
461
-
post = { hash_entry.post with time };
462
462
-
},
463
463
-
rootfs )))
464
464
-
else Error (Eio.Process.Child_error res)
465
465
-
in
459
459
+
let new_entry, diff = exec config ~stdout fs proc (s, ctx) entry in
466
460
match new_entry with
467
461
| Error e -> Error e
468
468
-
| Ok (`Reset None) ->
469
469
-
Fmt.epr "Resetting to existing entry failed...\n%!";
470
470
-
Ok (s, ctx)
471
471
-
| Ok (`Reset (Some c)) ->
472
472
-
S.Head.set store c;
473
473
-
Ok (s, ctx)
462
462
+
| Ok (`Reset c) -> (
463
463
+
match
464
464
+
S.Hash.unsafe_of_raw_string c |> S.Commit.of_hash (S.repo store)
465
465
+
with
466
466
+
| None ->
467
467
+
Fmt.epr "Resetting to existing entry failed...\n%!";
468
468
+
Ok (s, ctx)
469
469
+
| Some c ->
470
470
+
S.Head.set store c;
471
471
+
Ok (s, ctx))
474
472
| Ok (`Entry (entry, path)) ->
475
473
(* Set diff *)
476
474
let entry = { entry with post = { entry.post with diff } } in