+9 -3

src/bin/main.ml

··· 15 15 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path; 16 16 path 17 17 18 18 + module Eventloop = struct 19 19 + let run fn = 20 20 + Eio_posix.run @@ fun env -> 21 21 + Lwt_eio.with_event_loop ~clock:env#clock @@ fun _token -> fn env 22 22 + end 23 23 + 18 24 (* Command Line *) 19 25 open Cmdliner 20 26 ··· 27 33 28 34 let main = 29 35 let run config cmd_file = 30 30 - Eio_posix.run @@ fun env -> 36 36 + Eventloop.run @@ fun env -> 31 37 let cmd_file = Option.map (Eio.Path.( / ) env#fs) cmd_file in 32 38 let dir = state_dir env#fs "shelter" in 33 39 let stdout = (env#stdout :> Eio.Flow.sink_ty Eio.Flow.sink) in ··· 47 53 48 54 let passthrough = 49 55 let run config cmd_file = 50 50 - Eio_posix.run @@ fun env -> 56 56 + Eventloop.run @@ fun env -> 51 57 let cmd_file = Option.map (Eio.Path.( / ) env#fs) cmd_file in 52 58 let dir = state_dir env#fs "passthrough" in 53 59 let stdout = (env#stdout :> Eio.Flow.sink_ty Eio.Flow.sink) in ··· 59 65 60 66 let extract_commands = 61 67 let run cmd_file = 62 62 - Eio_posix.run @@ fun env -> 68 68 + Eventloop.run @@ fun env -> 63 69 let cmd_file = Eio.Path.( / ) env#fs (Option.get cmd_file) in 64 70 Shelter.Script.to_commands cmd_file |> List.iter (Fmt.pr "%s\n") 65 71 in

+10 -1

src/lib/dune

··· 1 1 (library 2 2 (name shelter) 3 3 (public_name shelter) 4 4 - (libraries cmdliner irmin-fs.unix eio.unix eio linenoise void repr morbig)) 4 4 + (libraries 5 5 + cmdliner 6 6 + irmin-fs.unix 7 7 + irmin-git.unix 8 8 + eio.unix 9 9 + eio 10 10 + linenoise 11 11 + void 12 12 + repr 13 13 + morbig))

+8 -1

src/lib/engine.ml

··· 17 17 (** A context that is not persisted, but is passed through each loop of the 18 18 shell *) 19 19 20 20 + type error 21 21 + (** Shell specific errors *) 22 22 + 23 23 + val pp_error : error Fmt.t 24 24 + 20 25 val init : 21 26 _ Eio.Path.t -> 22 27 Eio_unix.Process.mgr_ty Eio_unix.Process.mgr -> ··· 33 38 Eio_unix.Process.mgr_ty Eio_unix.Process.mgr -> 34 39 entry History.t * ctx -> 35 40 action -> 36 36 - (entry History.t * ctx, Eio.Process.error) result 41 41 + ( entry History.t * ctx, 42 42 + [ `Process of Eio.Process.error | `Shell of error ] ) 43 43 + result 37 44 (** [run history action] runs the action in [history]. Return a new [history] 38 45 that can be persisted *) 39 46

+6 -2

src/lib/passthrough/shelter_passthrough.ml

··· 1 1 open Eio 2 2 3 3 + type error = string 4 4 + 5 5 + let pp_error = Fmt.string 6 6 + 3 7 type config = unit 4 8 5 9 let config_term = Cmdliner.Term.const () ··· 56 60 S.set_exn ~info store (key ()) command; 57 61 let _ : (unit, string) result = LNoise.history_add command in 58 62 Ok (full_store, ())) 59 59 - else Error (Eio.Process.Child_error res) 60 60 - with Eio.Exn.Io (Eio.Process.E e, _) -> Error e 63 63 + else Shelter.process_error (Eio.Process.Child_error res) 64 64 + with Eio.Exn.Io (Eio.Process.E e, _) -> Shelter.process_error e

+16 -7

src/lib/shelter.ml

··· 2 2 module Engine = Engine 3 3 module Script = Script 4 4 5 5 + let process_error e = Error (`Process e) 6 6 + let shell_error e = Error (`Shell e) 7 7 + 5 8 module Make (H : History.S) (Engine : Engine.S with type entry = H.t) = struct 6 6 - module Store = Irmin_fs_unix.KV.Make (H) 9 9 + module Store = Irmin_git_unix.FS.KV (H) 7 10 8 11 let run config ~stdout fs clock proc store = 9 12 let store = History.Store ((module Store), store) in ··· 15 18 | Some input -> ( 16 19 let action = Engine.action_of_command input in 17 20 match Engine.run config ~stdout fs clock proc (store, ctx) action with 18 18 - | Error (Eio.Process.Child_error exit_code) -> 21 21 + | Error (`Process (Eio.Process.Child_error exit_code)) -> 19 22 Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code; 20 23 loop store ctx exit_code 21 21 - | Error (Eio.Process.Executable_not_found m) -> 22 22 - Fmt.epr "cshell: excutable not found %s\n%!" m; 24 24 + | Error (`Process (Eio.Process.Executable_not_found m)) -> 25 25 + Fmt.epr "shelter: excutable not found %s\n%!" m; 23 26 loop store ctx (`Exited 127) 27 27 + | Error (`Shell e) -> 28 28 + Fmt.epr "shelter: %a\n%!" Engine.pp_error e; 29 29 + loop store ctx (`Exited 255) 24 30 | Ok (store, ctx) -> loop store ctx (`Exited 0)) 25 31 in 26 32 loop store initial_ctx (`Exited 0) ··· 45 51 match 46 52 Engine.run config ~stdout fs clock proc (store, ctx) action 47 53 with 48 48 - | Error (Eio.Process.Child_error exit_code) -> 54 54 + | Error (`Process (Eio.Process.Child_error exit_code)) -> 49 55 Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code; 50 56 (store, ctx, exit_code) 51 51 - | Error (Eio.Process.Executable_not_found m) -> 52 52 - Fmt.epr "cshell: excutable not found %s\n%!" m; 57 57 + | Error (`Process (Eio.Process.Executable_not_found m)) -> 58 58 + Fmt.epr "shelter: excutable not found %s\n%!" m; 53 59 (store, ctx, `Exited 127) 60 60 + | Error (`Shell e) -> 61 61 + Fmt.epr "shelter: %a\n%!" Engine.pp_error e; 62 62 + (store, ctx, `Exited 255) 54 63 | Ok (store, ctx) -> (store, ctx, `Exited 0) 55 64 in 56 65 let _store, _ctx, exit_code =

+106 -38

src/lib/shelter/shelter_main.ml

··· 2 2 module Store = Store 3 3 module H = Shelter.History 4 4 5 5 + type error = string 6 6 + 7 7 + let pp_error = Fmt.string 8 8 + 5 9 module History = struct 6 10 type mode = Void.mode 7 11 ··· 221 225 in 222 226 { store; tool_dir = tools } 223 227 224 224 - (* Run a command *) 228 228 + (* Run a command: 229 229 + 230 230 + - TODO: pretty confusing that we `entry` to build from and also as the 231 231 + thing we are building (e.g. the build field and the args field... *) 225 232 let exec (config : config) ~stdout fs proc 226 233 ((H.Store ((module S), _) : entry H.t), (ctx : ctx)) (entry : entry) = 227 234 let build, env, (uid, gid) = ··· 236 243 { entry with pre = { entry.pre with build = Build build } } 237 244 in 238 245 (* 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 246 246 + the hash for something purely from the arguments needed to execute something 247 247 + rather than needing, for example, the time it took to execute! 248 248 + 249 249 + Also, combine it with previous build step. *) 250 250 + let new_cid = 251 251 + Store.cid (Cid.to_string build ^ Repr.to_string History.pre_t hash_entry.pre) 252 252 + in 242 253 let with_rootfs fn = 243 254 if entry.pre.mode = R then (Store.Run.with_build ctx.store build fn, []) 244 255 else Store.Run.with_clone ctx.store ~src:build new_cid fn ··· 255 266 | `Build rootfs -> 256 267 let spawn sw log = 257 268 if config.no_runc then 269 269 + (* Experiment Void Process *) 258 270 let rootfs = Filename.concat rootfs "rootfs" in 259 271 let void = 260 272 Void.empty ··· 367 379 post = { hash_entry.post with time }; 368 380 }, 369 381 rootfs ))) 370 370 - else Error (Eio.Process.Child_error res) 382 382 + else Shelter.process_error (Eio.Process.Child_error res) 383 383 + 384 384 + let complete_exec ((H.Store ((module S), store) as s : entry H.t), ctx) clock fs 385 385 + new_entry diff = 386 386 + match new_entry with 387 387 + | Error e -> Error e 388 388 + | Ok (`Reset c) -> ( 389 389 + match 390 390 + S.Hash.unsafe_of_raw_string c |> S.Commit.of_hash (S.repo store) 391 391 + with 392 392 + | None -> 393 393 + Fmt.epr "Resetting to existing entry failed...\n%!"; 394 394 + Ok (s, ctx) 395 395 + | Some c -> 396 396 + S.Head.set store c; 397 397 + Ok (s, ctx)) 398 398 + | Ok (`Entry (entry, path)) -> 399 399 + (* Set diff *) 400 400 + let entry = History.{ entry with post = { entry.post with diff } } in 401 401 + (* Commit if RW *) 402 402 + if entry.pre.mode = RW then ( 403 403 + commit 404 404 + ~message:("exec " ^ String.concat " " entry.pre.args) 405 405 + clock s entry; 406 406 + (* Save the commit hash for easy restoring later *) 407 407 + let hash = S.Head.get store |> S.Commit.hash |> S.Hash.to_raw_string in 408 408 + Eio.Path.save ~create:(`If_missing 0o644) 409 409 + Eio.Path.(fs / path / "hash") 410 410 + hash); 411 411 + Ok (s, ctx) 412 412 + 413 413 + let replay config (H.Store ((module S), s) as store : entry H.t) ctx fs clock 414 414 + proc stdout existing_branch = 415 415 + let seshes = sessions store in 416 416 + if not (List.exists (String.equal existing_branch) seshes) then ( 417 417 + Fmt.epr "%s does not exist!" existing_branch; 418 418 + Ok (store, ctx)) 419 419 + else 420 420 + let repo = S.repo s in 421 421 + let onto = S.of_branch repo existing_branch in 422 422 + match S.lcas ~n:1 s onto with 423 423 + | Error lcas_error -> 424 424 + Fmt.epr "Replay LCAS: %a" (Repr.pp S.lca_error_t) lcas_error; 425 425 + Ok (store, ctx) 426 426 + | Ok [ lcas ] -> ( 427 427 + let all_commits = history store in 428 428 + let lcas_hash = S.Commit.hash lcas |> S.Hash.to_raw_string in 429 429 + let rec collect = function 430 430 + | [] -> [] 431 431 + | (x, _) :: _ when String.equal lcas_hash x -> [] 432 432 + | v :: vs -> v :: collect vs 433 433 + in 434 434 + let commits_to_apply = collect all_commits in 435 435 + match commits_to_apply with 436 436 + | [] -> Shelter.shell_error "" 437 437 + | (h, first) :: rest -> 438 438 + let _, last_other = 439 439 + history (H.Store ((module S), onto)) |> List.hd 440 440 + in 441 441 + let new_first = 442 442 + { 443 443 + first with 444 444 + pre = { first.pre with build = last_other.pre.build }; 445 445 + } 446 446 + in 447 447 + let commits_to_apply = (h, new_first) :: rest in 448 448 + (* Now we reset our head to point to the other store's head 449 449 + and replay our commits onto it *) 450 450 + let other_head = S.Head.get onto in 451 451 + S.Head.set s other_head; 452 452 + let res = 453 453 + List.fold_left 454 454 + (fun last (_, (entry : entry)) -> 455 455 + match last with 456 456 + | Error _ as e -> e 457 457 + | Ok (new_store, new_ctx) -> 458 458 + let new_entry, diff = 459 459 + exec config ~stdout fs proc (new_store, new_ctx) entry 460 460 + in 461 461 + complete_exec (new_store, new_ctx) clock fs new_entry diff) 462 462 + (Ok (H.Store ((module S), s), ctx)) 463 463 + commits_to_apply 464 464 + in 465 465 + res) 466 466 + | _ -> assert false (* Because n = 1 *) 371 467 372 468 let run (config : config) ~stdout fs clock proc 373 469 (((H.Store ((module S), store) : entry H.t) as s), (ctx : ctx)) = function ··· 391 487 Ok (s, ctx) 392 488 | Ok store -> Ok (store, ctx))) 393 489 | Unknown args -> 394 394 - Fmt.epr "%a: %s\n%!" (text `Red) "Unknown Shelter Action" 395 395 - (String.concat " " args); 396 396 - Ok (s, ctx) 490 490 + Fmt.epr "%a" (text `Red) "Unknown Shelter Action\n"; 491 491 + Shelter.shell_error (String.concat " " args) 397 492 | Info `Current -> 398 493 let sessions = sessions s in 399 494 let sesh = Option.value ~default:"main" (snd (which_branch s)) in ··· 430 525 Ok (s, ctx) 431 526 | Exec [] -> Ok (s, ctx) 432 527 | Undo -> Ok (reset_hard s, ctx) 433 433 - | Replay _ -> Ok (s, ctx) 528 528 + | Replay branch -> replay config s ctx fs clock proc stdout branch 434 529 | Info `History -> 435 530 display_history s; 436 531 Ok (s, ctx) ··· 457 552 let entry = { entry with pre = { entry.pre with args = command } } in 458 553 try 459 554 let new_entry, diff = exec config ~stdout fs proc (s, ctx) entry in 460 460 - match new_entry with 461 461 - | Error e -> Error e 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)) 472 472 - | Ok (`Entry (entry, path)) -> 473 473 - (* Set diff *) 474 474 - let entry = { entry with post = { entry.post with diff } } in 475 475 - (* Commit if RW *) 476 476 - if entry.pre.mode = RW then ( 477 477 - commit 478 478 - ~message:("exec " ^ String.concat " " command) 479 479 - clock s entry; 480 480 - (* Save the commit hash for easy restoring later *) 481 481 - let hash = 482 482 - S.Head.get store |> S.Commit.hash |> S.Hash.to_raw_string 483 483 - in 484 484 - Eio.Path.save ~create:(`If_missing 0o644) 485 485 - Eio.Path.(fs / path / "hash") 486 486 - hash); 487 487 - Ok (s, ctx) 488 488 - with Eio.Exn.Io (Eio.Process.E e, _) -> Error e) 555 555 + complete_exec (s, ctx) clock fs new_entry diff 556 556 + with Eio.Exn.Io (Eio.Process.E e, _) -> Shelter.process_error e)