diff --git a/lib/build.ml b/lib/build.ml index c15547df..d95de30e 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -10,8 +10,8 @@ let hostname = "builder" let healthcheck_base () = if Sys.win32 then Docker_sandbox.servercore () >>= fun (`Docker_image servercore) -> - Lwt.return servercore - else Lwt.return "busybox" + Lwt.return (`Image servercore) + else Lwt.return (`Image "busybox") let healthcheck_ops = let open Obuilder_spec in @@ -71,7 +71,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st mount_secrets : Config.Secret.t list; } [@@deriving sexp_of] - let run t ~switch ~log ~cache run_input = + let run t ~switch ~log ~cache ~(rom:Obuilder_spec.Rom.t list) run_input = let id = sexp_of_run_input run_input |> Sexplib.Sexp.to_string_mach @@ -89,10 +89,22 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st { Config.Mount.ty = `Bind; src; dst = target; readonly = false } ) >>= fun mounts -> - let argv = shell @ [cmd] in + Lwt_list.map_p (fun v -> + match v.Obuilder_spec.Rom.kind with + | `Build (hash, dir) -> + Store.result t.store hash >|= fun path -> + let path = Option.get path in + let src = path / "rootfs" / dir in + { Config.Mount.src; ty = `Bind; dst = v.target; readonly = true } + ) rom >>= fun rom_mounts -> + let argv = `Run (shell @ [cmd]) in + let mounts = mounts @ rom_mounts in let config = Config.v ~cwd:workdir ~argv ~hostname ~user ~env ~mounts ~mount_secrets ~network () in Os.with_pipe_to_child @@ fun ~r:stdin ~w:close_me -> Lwt_unix.close close_me >>= fun () -> + let roms = List.map Obuilder_spec.Rom.sexp_of_t rom in + let roms = Sexplib.Sexp.List roms |> Sexplib.Sexp.to_string in + Os.write_file ~path:(result_tmp / "rom") roms >>= fun () -> Sandbox.run ~cancelled ~stdin ~log t.sandbox config result_tmp ) (fun () -> @@ -100,6 +112,46 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st ) ) + let run_shell t ?unix_sock ~shell_established ~switch:_ ~cache ~(rom:Obuilder_spec.Rom.t list) ?stdin id run_input = + let { base=_; workdir; user; env=_; cmd=_; shell=_; network; mount_secrets } = run_input in + Store.with_temp t.store id (fun result_tmp -> + let to_release = ref [] in + let cancelled, _ = Lwt.wait () in + Lwt.finalize + (fun () -> + let saved_roms = + match Sexplib.Sexp.load_sexp (result_tmp / "rom") with + | Sexplib.Sexp.List sexps -> + List.map Obuilder_spec.Rom.t_of_sexp sexps + | exception _ | _ -> [] + in + cache |> Lwt_list.map_s (fun { Obuilder_spec.Cache.id; target; buildkit_options = _ } -> + Store.cache ~user t.store id >|= fun (src, release) -> + to_release := release :: !to_release; + { Config.Mount.src; ty = `Bind; dst = target; readonly = false } + ) + >>= fun mounts -> + Lwt_list.map_p (fun v -> + match v.Obuilder_spec.Rom.kind with + | `Build (hash, dir) -> + Store.result t.store hash >|= fun path -> + let path = Option.get path in + let src = path / "rootfs" / dir in + { Config.Mount.src; ty = `Bind; dst = v.target; readonly = true } + ) (rom @ saved_roms) >>= fun rom_mounts -> + let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (result_tmp / "env")) in + let mounts = mounts @ rom_mounts in + let config = Config.v ~cwd:workdir ~argv:`Terminal ~hostname ~user ~env ~mounts ~mount_secrets ~network () in + Sandbox.shell ?unix_sock ~cancelled ?stdin t.sandbox config result_tmp >>!= fun cond -> + Lwt.wakeup_later shell_established (); + Lwt_condition.wait cond >>= fun () -> + Lwt.return_ok () + ) + (fun () -> + !to_release |> Lwt_list.iter_s (fun f -> f ()) + ) + ) + type copy_details = { base : S.id; user : Obuilder_spec.user; @@ -148,7 +200,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st (* Fmt.pr "COPY: %a@." Sexplib.Sexp.pp_hum (sexp_of_copy_details details); *) let id = Sha256.to_hex (Sha256.string (Sexplib.Sexp.to_string (sexp_of_copy_details details))) in Store.build t.store ?switch ~base ~id ~log (fun ~cancelled ~log result_tmp -> - let argv = ["tar"; "-xf"; "-"] in + let argv = `Run ["tar"; "-xf"; "-"] in let config = Config.v ~cwd:"/" ~argv @@ -212,14 +264,14 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st | `Comment _ -> k ~base ~context | `Workdir workdir -> k ~base ~context:(update_workdir ~context workdir) | `User user -> k ~base ~context:{context with user} - | `Run { shell = cmd; cache; network; secrets = mount_secrets } -> + | `Run { shell = cmd; cache; network; secrets = mount_secrets; rom } -> let result = let { Context.switch; workdir; user; env; shell; log; src_dir = _; scope = _; secrets } = context in resolve_secrets secrets mount_secrets |> Result.map @@ fun mount_secrets -> (switch, { base; workdir; user; env; cmd; shell; network; mount_secrets }, log) in Lwt.return result >>!= fun (switch, run_input, log) -> - run t ~switch ~log ~cache run_input >>!= fun base -> + run t ~switch ~log ~cache ~rom run_input >>!= fun base -> k ~base ~context | `Copy x -> copy t ~context ~base x >>!= fun base -> @@ -231,21 +283,31 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st k ~base ~context:{context with shell} let get_base t ~log base = - log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); - let id = Sha256.to_hex (Sha256.string base) in - Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp -> - Log.info (fun f -> f "Base image not present; importing %S…" base); - let rootfs = tmp / "rootfs" in - Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs] >>= fun () -> - Fetch.fetch ~log ~rootfs base >>= fun env -> - Os.write_file ~path:(tmp / "env") - (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> - Lwt_result.return () - ) - >>!= fun id -> Store.result t.store id - >|= Option.get >>= fun path -> - let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in - Lwt_result.return (id, env) + let () = match base with + | `Image i -> log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom i)); + | `Build b -> log `Heading (Fmt.str "(base %a)" Sexplib.Sexp.pp_hum (Atom b)); + in + match base with + | `Build base -> + Store.result t.store base + >|= Option.get >>= fun path -> + let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in + Lwt_result.return (base, env) + | `Image base -> + let id = Sha256.to_hex (Sha256.string base) in + Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp -> + Log.info (fun f -> f "Base image not present; importing %S…" base); + let rootfs = tmp / "rootfs" in + Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs] >>= fun () -> + Fetch.fetch ~log ~rootfs base >>= fun env -> + Os.write_file ~path:(tmp / "env") + (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> + Lwt_result.return () + ) + >>!= fun id -> Store.result t.store id + >|= Option.get >>= fun path -> + let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in + Lwt_result.return (id, env) let rec build t context { Obuilder_spec.child_builds; from = base; ops } = let rec aux context = function @@ -262,6 +324,13 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st let context = { context with env = context.env @ env } in run_steps t ~context ~base:id ops + let shell t ?unix_sock ?stdin id = + let stdin = Option.map (fun stdin -> Os.{ raw = stdin; needs_close = false }) stdin in + let rinput = { base = ""; workdir = "/"; user = Obuilder_spec.(`Unix { uid = 1000; gid = 1000 }); env = []; cmd = ""; shell = [ "sh" ]; network = [ "host" ]; mount_secrets = [] } in + let established, shell_established = Lwt.wait () in + let f = run_shell t ?unix_sock ~shell_established ~switch:None ?stdin ~cache:[] ~rom:[] id rinput in + established, f + let build t context spec = let r = build t context spec in (r : (string, [ `Cancelled | `Msg of string ]) Lwt_result.t :> (string, [> `Cancelled | `Msg of string ]) Lwt_result.t) @@ -336,6 +405,9 @@ module Make_Docker (Raw_store : S.STORE) = struct sandbox : Docker_sandbox.t; } + let shell _t ?unix_sock:_ ?stdin:_ _id = + failwith "Shells/Interactive Terminals are not supported via the Docker sandbox" + (* Inputs to run that should affect the hash. i.e. if anything in here changes then we need a fresh build. *) type run_input = { @@ -347,6 +419,7 @@ module Make_Docker (Raw_store : S.STORE) = struct shell : string list; network : string list; mount_secrets : Config.Secret.t list; + rom : Obuilder_spec.Rom.t list; } [@@deriving sexp_of] let run t ~switch ~log ~cache run_input = @@ -356,7 +429,7 @@ module Make_Docker (Raw_store : S.STORE) = struct |> Sha256.string |> Sha256.to_hex in - let { base; workdir; user; env; cmd; shell; network; mount_secrets } = run_input in + let { base; workdir; user; env; cmd; shell; network; mount_secrets; rom } = run_input in Store.build t.store ?switch ~base ~id ~log (fun ~cancelled ~log _ -> let to_release = ref [] in Lwt.finalize @@ -367,8 +440,17 @@ module Make_Docker (Raw_store : S.STORE) = struct { Config.Mount.ty = `Volume; src; dst = target; readonly = false } ) >>= fun mounts -> + Lwt_list.map_p (fun v -> + match v.Obuilder_spec.Rom.kind with + | `Build (hash, dir) -> + Store.result t.store hash >|= fun path -> + let path = Option.get path in + let src = path / "rootfs" / dir in + { Config.Mount.src; ty = `Volume; dst = v.target; readonly = true } + ) rom >>= fun rom_mounts -> + let mounts = mounts @ rom_mounts in let entrypoint, argv = Docker.setup_command ~entp:shell ~cmd:[cmd] in - let config = Config.v ~cwd:workdir ~entrypoint ~argv ~hostname ~user ~env ~mounts ~mount_secrets ~network () in + let config = Config.v ~cwd:workdir ~entrypoint ~argv:(`Run argv) ~hostname ~user ~env ~mounts ~mount_secrets ~network () in Os.with_pipe_to_child @@ fun ~r:stdin ~w:close_me -> Lwt_unix.close close_me >>= fun () -> Lwt_result.bind_lwt @@ -471,11 +553,11 @@ module Make_Docker (Raw_store : S.STORE) = struct | `Comment _ -> k ~base ~context | `Workdir workdir -> k ~base ~context:(update_workdir ~context workdir) | `User user -> k ~base ~context:{context with user} - | `Run { shell = cmd; cache; network; secrets = mount_secrets } -> + | `Run { shell = cmd; cache; network; secrets = mount_secrets; rom } -> let result = let { Context.switch; workdir; user; env; shell; log; src_dir = _; scope = _; secrets } = context in resolve_secrets secrets mount_secrets |> Result.map @@ fun mount_secrets -> - (switch, { base; workdir; user; env; cmd; shell; network; mount_secrets }, log) + (switch, { base; workdir; user; env; cmd; shell; network; mount_secrets; rom }, log) in Lwt.return result >>!= fun (switch, run_input, log) -> run t ~switch ~log ~cache run_input >>!= fun base -> @@ -495,16 +577,26 @@ module Make_Docker (Raw_store : S.STORE) = struct k ~base ~context:{context with shell} let get_base t ~log base = - log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); - let id = Sha256.to_hex (Sha256.string base) in - Store.build t.store ~id ~log (fun ~cancelled:_ ~log:_ _ -> - Log.info (fun f -> f "Base image not present; importing %S…" base); - Docker.Cmd.pull (`Docker_image base) >>= fun () -> - Docker.Cmd.tag (`Docker_image base) (Docker.docker_image id) >>= fun () -> - Lwt_result.return () - ) - >>!= fun id -> - Lwt_result.return (id, []) + let () = match base with + | `Image i -> log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom i)); + | `Build b -> log `Heading (Fmt.str "(base %a)" Sexplib.Sexp.pp_hum (Atom b)); + in + match base with + | `Build base -> + Store.result t.store base + >|= Option.get >>= fun path -> + let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in + Lwt_result.return (base, env) + | `Image base -> + let id = Sha256.to_hex (Sha256.string base) in + Store.build t.store ~id ~log (fun ~cancelled:_ ~log:_ _ -> + Log.info (fun f -> f "Base image not present; importing %S…" base); + Docker.Cmd.pull (`Docker_image base) >>= fun () -> + Docker.Cmd.tag (`Docker_image base) (Docker.docker_image id) >>= fun () -> + Lwt_result.return () + ) + >>!= fun id -> + Lwt_result.return (id, []) let rec build ~scope t context { Obuilder_spec.child_builds; from = base; ops } = let rec aux context = function diff --git a/lib/config.ml b/lib/config.ml index b3cc4efd..d77fccc2 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -24,7 +24,7 @@ end type t = { cwd : string; entrypoint : string option; - argv : string list; + argv : [`Run of string list | `Terminal ]; hostname : string; user : Obuilder_spec.user; env : env; diff --git a/lib/db_store.ml b/lib/db_store.ml index 75f3dae9..9c879dc5 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -78,6 +78,12 @@ module Make (Raw : S.STORE) = struct | `Loaded -> client_log `Note (Fmt.str "---> using %S from cache" id) | `Saved -> client_log `Note (Fmt.str "---> saved as %S" id) + let with_temp t id fn = + let tmp = "tmp-" ^ id in + Raw.build ~base:id t.raw ~id:tmp fn >>!= fun () -> + Raw.delete t.raw tmp >>= fun () -> + Lwt.return @@ Ok () + (* Check to see if we're in the process of building [id]. If so, just tail the log from that. If not, use [get_build] to get the build. diff --git a/lib/db_store.mli b/lib/db_store.mli index 95b29a93..6610029c 100644 --- a/lib/db_store.mli +++ b/lib/db_store.mli @@ -14,6 +14,8 @@ module Make (Raw : S.STORE) : sig @param switch Turn this off if you no longer need the result. The build will be cancelled if no-one else is waiting for it. *) + val with_temp : t -> S.id -> (string -> (unit, [`Cancelled | `Msg of string]) Lwt_result.t) -> (unit, [`Cancelled | `Msg of string]) Lwt_result.t + val delete : ?log:(S.id -> unit) -> t -> S.id -> unit Lwt.t val prune : ?log:(S.id -> unit) -> t -> before:Unix.tm -> int -> int Lwt.t diff --git a/lib/docker_sandbox.ml b/lib/docker_sandbox.ml index 9d66f853..82696cc8 100644 --- a/lib/docker_sandbox.ml +++ b/lib/docker_sandbox.ml @@ -23,6 +23,9 @@ type t = { docker_network : string; (* Default network, overridden by network stanza *) } +let shell ~cancelled:_ ?stdin:_ ?unix_sock:_ _t _config _results_dir = + failwith "Shell's are not supported on docker, use runc + linux" + type config = { cpus : float; isolation : isolation; @@ -33,6 +36,10 @@ type config = { let secrets_guest_root = if Sys.win32 then {|C:\ProgramData\obuilder\|} else "/run/secrets/obuilder" let secret_dir id = "secrets" / string_of_int id +let not_a_terminal = function + | `Run args -> args + | `Terminal -> failwith "Terminals not supported by the docker sandbox" + module Docker_config = struct let make {Config.cwd; argv; hostname; user; env; mounts; network; mount_secrets; entrypoint} ?(config_dir="") @@ -61,7 +68,7 @@ module Docker_config = struct "--workdir"; cwd; "--entrypoint"; Option.get entrypoint; ] @ memory @ user @ env @ mounts @ mount_secrets @ network in - docker_argv, argv + docker_argv, not_a_terminal argv end let secrets_layer ~log mount_secrets base_image container docker_argv = @@ -137,7 +144,7 @@ let run ~cancelled ?stdin ~log t config (id:S.id) = Lwt.return_unit in let stdin = Option.map (fun x -> `FD_move_safely x) stdin in - Docker.Cmd_log.run_result ~log ?stdin ~name:container docker_argv base_image argv) + Docker.Cmd_log.run_result ~log ?stdin ~name:container docker_argv base_image argv) in Lwt.on_termination cancelled (fun () -> let aux () = @@ -174,7 +181,7 @@ let manifest_from_build t ~base ~exclude src workdir user = let entrypoint, argv = Docker.setup_command ~entp:Docker.(bash_entrypoint (obuilder_libexec ())) ~cmd:[argv] in Config.v ~cwd:workdir - ~argv + ~argv:(`Run argv) ~hostname ~user ~env:["PATH", if Sys.win32 then Docker.mount_point_inside_unix // Docker.obuilder_libexec () else "/bin:/usr/bin"] @@ -185,10 +192,10 @@ let manifest_from_build t ~base ~exclude src workdir user = () in let docker_args, args = Docker_config.make config t in - Docker.Cmd.run_pread_result ~rm:true docker_args (Docker.docker_image base) args >>!= fun manifests -> - match Parsexp.Many.parse_string manifests with - | Ok ts -> List.rev_map Manifest.t_of_sexp ts |> Lwt_result.return - | Error e -> Lwt_result.fail (`Msg (Parsexp.Parse_error.message e)) + Docker.Cmd.run_pread_result ~rm:true docker_args (Docker.docker_image base) args >>!= fun manifests -> + match Parsexp.Many.parse_string manifests with + | Ok ts -> List.rev_map Manifest.t_of_sexp ts |> Lwt_result.return + | Error e -> Lwt_result.fail (`Msg (Parsexp.Parse_error.message e)) let manifest_files_from op fd = let copy_root manifest = @@ -213,7 +220,7 @@ let tarball_from_build t ~log ~files_from ~tar workdir user id = let config = Config.v ~cwd:workdir - ~argv + ~argv:(`Run argv) ~hostname ~user ~env:[] @@ -229,7 +236,7 @@ let tarball_from_build t ~log ~files_from ~tar workdir user id = reads the end-of-tar magic sequence, then we can close the output pipe of the Docker process and ignore the error. *) let is_success = if Sys.win32 then Some (function 0 | 1 -> true | _ -> false) else None in - Docker.Cmd_log.run' ~log ~stdin:(`FD_move_safely files_from) ~stdout:(`FD_move_safely tar) + Docker.Cmd_log.run' ~log ~stdin:(`FD_move_safely files_from) ~stdout:(`FD_move_safely tar) ~rm:true ?is_success docker_args (Docker.docker_image id) args let transform op ~user ~from_tar ~to_untar = @@ -256,7 +263,7 @@ let untar t ~cancelled ~stdin ~log ?dst_dir id = end in let config = Config.v ~cwd:(if Sys.unix then "/" else "C:/") - ~argv + ~argv:(`Run argv) ~hostname ~user:Obuilder_spec.root ~env:[] @@ -413,7 +420,7 @@ let create_tar_volume (t:t) = in let entrypoint, argv = {|C:\Windows\System32\cmd.exe|}, ["/S"; "/C"; {|C:\extract.cmd|}] in - Config.v ~cwd:{|C:/|} ~argv ~hostname:"" + Config.v ~cwd:{|C:/|} ~argv:(`Run argv) ~hostname:"" ~user:Obuilder_spec.((root_windows :> user)) ~env:["DESTINATION", destination] ~mount_secrets:[] @@ -439,7 +446,7 @@ let create_tar_volume (t:t) = in let entrypoint, argv = "/bin/sh", ["-c"; ":"] in - Config.v ~cwd:"/" ~argv ~hostname:"" + Config.v ~cwd:"/" ~argv:(`Run argv) ~hostname:"" ~user:Obuilder_spec.((root_unix :> user)) ~env:["DESTINATION", destination] ~mount_secrets:[] @@ -449,8 +456,8 @@ let create_tar_volume (t:t) = () in let docker_args, args = Docker_config.make config t in - let* () = Docker.Cmd.run ~rm:true docker_args img args in - Docker.Cmd.image (`Remove img) + let* () = Docker.Cmd.run ~rm:true docker_args img args in + Docker.Cmd.image (`Remove img) let create (c : config) = let t = { docker_cpus = c.cpus; docker_isolation = c.isolation; diff --git a/lib/s.ml b/lib/s.ml index 5aad754e..7d9b339f 100644 --- a/lib/s.ml +++ b/lib/s.ml @@ -74,6 +74,15 @@ end module type SANDBOX = sig type t + val shell : + cancelled:unit Lwt.t -> + ?stdin:Os.unix_fd -> + ?unix_sock:string -> + t -> + Config.t -> + string -> + (unit Lwt_condition.t, [`Cancelled | `Msg of string]) Lwt_result.t + val run : cancelled:unit Lwt.t -> ?stdin:Os.unix_fd -> @@ -102,6 +111,13 @@ module type BUILDER = sig Obuilder_spec.t -> (id, [> `Cancelled | `Msg of string]) Lwt_result.t + val shell : + t -> + ?unix_sock:string -> + ?stdin:Unix.file_descr -> + id -> + unit Lwt.t * (unit, [ `Cancelled | `Msg of string]) Lwt_result.t + val finish : t -> unit Lwt.t (** [finish builder] close allocated resources and store state (e.g., sqlite3 databases). *) diff --git a/lib/sandbox.macos.ml b/lib/sandbox.macos.ml index 8e568ebc..514a8be3 100644 --- a/lib/sandbox.macos.ml +++ b/lib/sandbox.macos.ml @@ -70,11 +70,18 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp = let proc_id = ref None in let proc = let stdin = Option.map (fun x -> `FD_move_safely x) stdin in - let pp f = Os.pp_cmd f ("", config.Config.argv) in + let pp f = match config.Config.argv with + | `Run args -> Os.pp_cmd f ("", args) + | `Terminal -> Os.pp_cmd f ("", [ "TERMINAL" ]) + in Os.pread @@ Macos.get_tmpdir ~user >>= fun tmpdir -> let tmpdir = List.hd (String.split_on_char '\n' tmpdir) in let env = ("TMPDIR", tmpdir) :: osenv in - let cmd = run_as ~env ~user ~cmd:config.Config.argv in + let cmd = + match config.Config.argv with + | `Run args -> run_as ~env ~user ~cmd:args + | `Terminal -> failwith "Terminal's are not supported on macOS use Linux" + in Os.ensure_dir config.Config.cwd; let pid, proc = Os.open_process ?stdin ~stdout ~stderr ~pp ~cwd:config.Config.cwd cmd in proc_id := Some pid; @@ -101,6 +108,9 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp = Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result) else Lwt_result.fail `Cancelled) + let shell ~cancelled:_ ?stdin:_ ?unix_sock:_ _t _config _results_dir = + failwith "Shell's are not supported on macOS, use Linux" + let create ~state_dir:_ c = Lwt.return { uid = c.uid; diff --git a/lib/sandbox.runc.ml b/lib/sandbox.runc.ml index 26045fc9..786c0e6a 100644 --- a/lib/sandbox.runc.ml +++ b/lib/sandbox.runc.ml @@ -124,10 +124,12 @@ module Json_config = struct let namespaces = network_ns @ ["pid"; "ipc"; "uts"; "mount"] in `Assoc [ "ociVersion", `String "1.0.1-dev"; - "process", `Assoc [ - "terminal", `Bool false; + "process", `Assoc ( + (match argv with + | `Run r -> [ "terminal", `Bool false; "args", strings r ] + | `Terminal -> [ "terminal", `Bool true; "args", strings [ "/bin/bash" ] ]) + @ [ "user", user; - "args", strings argv; "env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env); "cwd", `String cwd; "capabilities", `Assoc [ @@ -139,12 +141,12 @@ module Json_config = struct "rlimits", `List [ `Assoc [ "type", `String "RLIMIT_NOFILE"; - "hard", `Int 1024; - "soft", `Int 1024 + "hard", `Int 16384; + "soft", `Int 16384 ]; ]; "noNewPrivileges", `Bool false; - ]; + ]); "root", `Assoc [ "path", `String (results_dir / "rootfs"); "readonly", `Bool false; @@ -296,7 +298,11 @@ let run ~cancelled ?stdin:stdin ~log t config results_dir = let copy_log = Build_log.copy ~src:out_r ~dst:log in let proc = let stdin = Option.map (fun x -> `FD_move_safely x) stdin in - let pp f = Os.pp_cmd f ("", config.argv) in + let pp f = + match config.argv with + | `Run argv -> Os.pp_cmd f ("", argv) + | `Terminal -> Os.pp_cmd f ("", ["terminal"]) + in Os.sudo_result ~cwd:tmp ?stdin ~stdout ~stderr ~pp cmd in Lwt.on_termination cancelled (fun () -> @@ -318,6 +324,55 @@ let run ~cancelled ?stdin:stdin ~log t config results_dir = if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result) else Lwt_result.fail `Cancelled +let shell ~cancelled ?stdin ?unix_sock t config results_dir = + Lwt_io.with_temp_dir ~perm:0o700 ~prefix:"obuilder-runc-" @@ fun tmp -> + let json_config = Json_config.make config ~config_dir:tmp ~results_dir t in + Os.write_file ~path:(tmp / "config.json") (Yojson.Safe.pretty_to_string json_config ^ "\n") >>= fun () -> + Os.write_file ~path:(tmp / "hosts") "127.0.0.1 localhost builder" >>= fun () -> + Lwt_list.fold_left_s + (fun id Config.Secret.{value; _} -> + Os.write_file ~path:(tmp / secret_file id) value >|= fun () -> + id + 1 + ) 0 config.mount_secrets + >>= fun _ -> + let id = string_of_int !next_id in + incr next_id; + let opts = + match unix_sock with + | Some s -> ["-d"; "--console-socket"; s] + | None -> [] + in + let cmd = ["runc"; "--root"; t.runc_state_dir; "run"] @ opts @ [ id] in + let proc = + let stdin = Option.map (fun x -> `FD_move_safely x) stdin in + let pp f = + match config.argv with + | `Run argv -> Os.pp_cmd f ("", argv) + | `Terminal -> Os.pp_cmd f ("", ["terminal"]) + in + Os.sudo_result ~cwd:tmp ?stdin ~pp cmd + in + let cond = Lwt_condition.create () in + Lwt.on_termination cancelled (fun () -> + let rec aux () = + if Lwt.is_sleeping proc then ( + let pp f = Fmt.pf f "runc kill %S" id in + Os.sudo_result ~cwd:tmp ["runc"; "--root"; t.runc_state_dir; "kill"; id; "KILL"] ~pp >>= function + | Ok () -> Lwt_condition.broadcast cond (); Lwt.return_unit + | Error (`Msg m) -> + (* This might be because it hasn't been created yet, so retry. *) + Log.warn (fun f -> f "kill failed: %s (will retry in 10s)" m); + Lwt_unix.sleep 10.0 >>= aux + ) else Lwt.return_unit (* Process has already finished *) + in + Lwt.async aux + ); + proc >>= fun r -> + if Lwt.is_sleeping cancelled then + let r = Result.map (fun () -> cond) r in + Lwt.return (r :> (unit Lwt_condition.t, [`Msg of string | `Cancelled]) result) + else Lwt_result.fail `Cancelled + let clean_runc dir = Sys.readdir dir |> Array.to_list diff --git a/lib_spec/docker.ml b/lib_spec/docker.ml index d78e8824..b6da07dc 100644 --- a/lib_spec/docker.ml +++ b/lib_spec/docker.ml @@ -42,7 +42,7 @@ let pp_mount_secret ~ctx f { Secret.id; target; buildkit_options } = in Fmt.pf f "%a" Fmt.(list ~sep:(any ",") pp_pair) buildkit_options -let pp_run ~escape ~ctx f { Spec.cache; shell; secrets; network = _ } = +let pp_run ~escape ~ctx f { Spec.cache; shell; secrets; network = _; rom = _ } = Fmt.pf f "RUN %a%a%a" Fmt.(list (pp_mount_secret ~ctx ++ const string " ")) secrets Fmt.(list (pp_cache ~ctx ++ const string " ")) cache @@ -100,6 +100,11 @@ let rec convert ~buildkit ~escape ~ctx f (name, { Spec.child_builds; from; ops } convert ~buildkit ~escape ~ctx f (Some name, spec); Format.pp_print_newline f (); ); + let from = + match from with + | `Image s -> s + | `Build _ -> failwith "Not a docker image!!!" + in Fmt.pf f "@[FROM %s%a@]@." from Fmt.(option (const string " as " ++ string)) name; let (_ : ctx) = List.fold_left (fun ctx op -> Format.pp_open_hbox f (); diff --git a/lib_spec/obuilder_spec.ml b/lib_spec/obuilder_spec.ml index 7294ed17..955485f5 100644 --- a/lib_spec/obuilder_spec.ml +++ b/lib_spec/obuilder_spec.ml @@ -1,5 +1,6 @@ include Spec +module Rom = Rom module Cache = Cache module Secret = Secret module Docker = Docker diff --git a/lib_spec/rom.ml b/lib_spec/rom.ml new file mode 100644 index 00000000..55cc4972 --- /dev/null +++ b/lib_spec/rom.ml @@ -0,0 +1,15 @@ + +open Sexplib.Conv + +type t = { + kind : kind; + target : string; +} [@@deriving sexp] + +and kind = [ `Build of string * string ] [@@deriving sexp] + +let of_build ~hash ~build_dir target = + { + kind = `Build (hash, build_dir); + target + } \ No newline at end of file diff --git a/lib_spec/rom.mli b/lib_spec/rom.mli new file mode 100644 index 00000000..c4568521 --- /dev/null +++ b/lib_spec/rom.mli @@ -0,0 +1,10 @@ +type t = { + kind : kind; + target : string; +} [@@deriving sexp] + +and kind = [ `Build of string * string ] [@@deriving sexp] + +val of_build : hash:string -> build_dir:string -> string -> t +(** Construct a read-only mount from a previous build and a specific directory + in that build that will be mounted on the target. *) \ No newline at end of file diff --git a/lib_spec/spec.ml b/lib_spec/spec.ml index b3994fd6..79256b43 100644 --- a/lib_spec/spec.ml +++ b/lib_spec/spec.ml @@ -86,6 +86,7 @@ let sexp_of_user x : Sexplib.Sexp.t = | x -> Fmt.failwith "Invalid op: %a" Sexplib.Sexp.pp_hum x type run = { + rom : Rom.t list [@sexp.list]; cache : Cache.t list [@sexp.list]; network : string list [@sexp.list]; secrets : Secret.t list [@sexp.list]; @@ -142,7 +143,7 @@ let op_of_sexp x = type t = { child_builds : (string * t) list; - from : string; + from : [ `Image of string | `Build of string ]; ops : op list; } @@ -152,7 +153,8 @@ let rec sexp_of_t { child_builds; from; ops } = List [ Atom "build"; Atom name; sexp_of_t spec ] ) in - List (child_builds @ List [ Atom "from"; Atom from ] :: List.map sexp_of_op ops) + let from = match from with `Image s -> [ Atom "from"; Atom s ] | `Build s -> [ Atom "base"; Atom s ] in + List (child_builds @ List from :: List.map sexp_of_op ops) let rec t_of_sexp = function | Atom _ as x -> Fmt.failwith "Invalid spec: %a" Sexplib.Sexp.pp_hum x @@ -161,9 +163,12 @@ let rec t_of_sexp = function | List [ Atom "build"; Atom name; child_spec ] :: xs -> let child = (name, t_of_sexp child_spec) in aux (child :: acc) xs + | List [ Atom "base"; Atom from ] :: ops -> + let child_builds = List.rev acc in + { child_builds; from = `Build from; ops = List.map op_of_sexp ops } | List [ Atom "from"; Atom from ] :: ops -> let child_builds = List.rev acc in - { child_builds; from; ops = List.map op_of_sexp ops } + { child_builds; from = `Image from; ops = List.map op_of_sexp ops } | x :: _ -> Fmt.failwith "Invalid spec item: %a" Sexplib.Sexp.pp_hum x | [] -> Fmt.failwith "Invalid spec: missing (from)" in @@ -172,7 +177,7 @@ let rec t_of_sexp = function let comment fmt = fmt |> Printf.ksprintf (fun c -> `Comment c) let workdir x = `Workdir x let shell xs = `Shell xs -let run ?(cache=[]) ?(network=[]) ?(secrets=[]) fmt = fmt |> Printf.ksprintf (fun x -> `Run { shell = x; cache; network; secrets }) +let run ?(rom=[]) ?(cache=[]) ?(network=[]) ?(secrets=[]) fmt = fmt |> Printf.ksprintf (fun x -> `Run { shell = x; cache; network; secrets; rom }) let copy ?(from=`Context) ?(exclude=[]) src ~dst = `Copy { from; src; dst; exclude } let env k v = `Env (k, v) let user_unix ~uid ~gid = `User (`Unix { uid; gid }) diff --git a/lib_spec/spec.mli b/lib_spec/spec.mli index 245f45a3..66ed2c97 100644 --- a/lib_spec/spec.mli +++ b/lib_spec/spec.mli @@ -20,6 +20,7 @@ type user = [ ] [@@deriving sexp] type run = { + rom : Rom.t list; cache : Cache.t list; network : string list; secrets : Secret.t list; @@ -38,16 +39,16 @@ type op = [ type t = private { child_builds : (string * t) list; - from : string; + from : [ `Image of string | `Build of string ]; ops : op list; } [@@deriving sexp] -val stage : ?child_builds:(string * t) list -> from:string -> op list -> t +val stage : ?child_builds:(string * t) list -> from:[`Image of string | `Build of string] -> op list -> t val comment : ('a, unit, string, op) format4 -> 'a val workdir : string -> op val shell : string list -> op -val run : ?cache:Cache.t list -> ?network:string list -> ?secrets:Secret.t list -> ('a, unit, string, op) format4 -> 'a +val run : ?rom:Rom.t list -> ?cache:Cache.t list -> ?network:string list -> ?secrets:Secret.t list -> ('a, unit, string, op) format4 -> 'a val copy : ?from:[`Context | `Build of string] -> ?exclude:string list -> string list -> dst:string -> op val env : string -> string -> op val user_unix : uid:int -> gid:int -> op diff --git a/main.ml b/main.ml index 76e0c735..5bea622e 100644 --- a/main.ml +++ b/main.ml @@ -67,6 +67,21 @@ let build () store spec native_conf docker_conf src_dir secrets = exit 1 end +let run () (_, store) conf id = + Lwt_main.run begin + create_builder store conf >>= fun (Builder ((module Builder), builder)) -> + Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () -> + let _, v = Builder.shell builder id in + v >>= fun v -> match v with + | Ok _ -> Lwt.return_unit + | Error `Cancelled -> + Fmt.epr "Cancelled at user's request@."; + exit 1 + | Error (`Msg m) -> + Fmt.epr "Build step failed: %s@." m; + exit 1 + end + let healthcheck () store native_conf docker_conf = Lwt_main.run begin select_backend store native_conf docker_conf @@ -202,7 +217,13 @@ let healthcheck = Term.(const healthcheck $ setup_log $ store $ Native_sandbox.cmdliner $ Docker_sandbox.cmdliner) -let cmds = [build; delete; clean; dockerfile; healthcheck] +let run = + let doc = "Run a shell inside a container" in + let info = Cmd.info "run" ~doc in + Cmd.v info + Term.(const run $ setup_log $ store $ Native_sandbox.cmdliner $ id) + +let cmds = [build; run; delete; clean; dockerfile; healthcheck] let () = let doc = "a command-line interface for OBuilder" in diff --git a/stress/stress.ml b/stress/stress.ml index 95df2ff4..858afbda 100644 --- a/stress/stress.ml +++ b/stress/stress.ml @@ -139,7 +139,7 @@ module Test(Store : S.STORE) = struct |> fun got -> assert_str expected got in - check_log, Spec.stage ~from:"busybox" ops + check_log, Spec.stage ~from:(`Image "busybox") ops let do_build (Builder ((module Builder), builder)) = let src_dir = "/root" in diff --git a/test/mock_sandbox.ml b/test/mock_sandbox.ml index 57dbf5ee..90027112 100644 --- a/test/mock_sandbox.ml +++ b/test/mock_sandbox.ml @@ -12,7 +12,7 @@ let expect t x = Queue.add x t.expect let run ~cancelled ?stdin ~log t (config:Obuilder.Config.t) dir = match Queue.take_opt t.expect with - | None -> Fmt.failwith "Unexpected sandbox execution: %a" Fmt.(Dump.list string) config.argv + | None -> Fmt.failwith "Unexpected sandbox execution: %a" Fmt.(Dump.list string) (match config.argv with `Run args -> args | `Terminal -> assert false) | Some fn -> Lwt.catch (fun () -> fn ~cancelled ?stdin ~log config dir) @@ -21,6 +21,12 @@ let run ~cancelled ?stdin ~log t (config:Obuilder.Config.t) dir = | ex -> Lwt_result.fail (`Msg (Printexc.to_string ex)) ) +let shell + ~cancelled:_ + ?stdin:_ + ?unix_sock:_ + _t _conf _s = assert false + let create () = { expect = Queue.create () } let finished () = Lwt.return () diff --git a/test/test.ml b/test/test.ml index 7503457f..e815363f 100644 --- a/test/test.ml +++ b/test/test.ml @@ -48,8 +48,9 @@ let mock_op ?(result=Lwt_result.return ()) ?(delay_store=Lwt.return_unit) ?cance Mock_store.delay_store := delay_store; let cmd = match config.argv with - | ["/usr/bin/env" ; "bash"; "-c"; cmd] | ["cmd"; "/S"; "/C"; cmd] -> cmd - | x -> Fmt.str "%a" Fmt.(Dump.list string) x + | `Run ["/usr/bin/env" ; "bash"; "-c"; cmd] | `Run ["cmd"; "/S"; "/C"; cmd] -> cmd + | `Run x -> Fmt.str "%a" Fmt.(Dump.list string) x + | `Terminal -> failwith "Terminal not support in the mock store" in Build_log.printf log "%s@." cmd >>= fun () -> cancel |> Option.iter (fun cancel -> @@ -72,7 +73,7 @@ let test_simple _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> let log = Log.create "b" in let context = Context.v ~src_dir ~log:(Log.add log) () in - let spec = Spec.(stage ~from:"base" [ run "Append" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Append" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Append ("runner", "base-id")) ()); B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; @@ -101,7 +102,7 @@ let test_prune _switch () = let start = Unix.(gettimeofday () |> gmtime) in let log = Log.create "b" in let context = Context.v ~src_dir ~log:(Log.add log) () in - let spec = Spec.(stage ~from:"base" [ run "Append" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Append" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Append ("runner", "base-id")) ()); B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; @@ -128,8 +129,8 @@ let test_concurrent _switch () = let log2 = Log.create "b2" in let context1 = Obuilder.Context.v ~log:(Log.add log1) ~src_dir () in let context2 = Obuilder.Context.v ~log:(Log.add log2) ~src_dir () in - let spec1 = Obuilder.Spec.(stage ~from:"base"[ run "A"; run "B" ]) in - let spec2 = Obuilder.Spec.(stage ~from:"base"[ run "A"; run "C" ]) in + let spec1 = Obuilder.Spec.(stage ~from:(`Image "base")[ run "A"; run "B" ]) in + let spec2 = Obuilder.Spec.(stage ~from:(`Image "base")[ run "A"; run "C" ]) in let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:a ~output:(`Constant "A") ()); Mock_sandbox.expect sandbox (mock_op ~output:`Append_cmd ()); @@ -174,8 +175,8 @@ let test_concurrent_failure _switch () = let log2 = Log.create "b2" in let context1 = Obuilder.Context.v ~log:(Log.add log1) ~src_dir () in let context2 = Obuilder.Context.v ~log:(Log.add log2) ~src_dir () in - let spec1 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "B" ]) in - let spec2 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "C" ]) in + let spec1 = Obuilder.Spec.(stage ~from:(`Image "base") [ run "A"; run "B" ]) in + let spec2 = Obuilder.Spec.(stage ~from:(`Image "base") [ run "A"; run "C" ]) in let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:a ()); let b1 = B.build builder context1 spec1 in @@ -211,8 +212,8 @@ let test_concurrent_failure_2 _switch () = let log2 = Log.create "b2" in let context1 = Obuilder.Context.v ~log:(Log.add log1) ~src_dir () in let context2 = Obuilder.Context.v ~log:(Log.add log2) ~src_dir () in - let spec1 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "B" ]) in - let spec2 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "C" ]) in + let spec1 = Obuilder.Spec.(stage ~from:(`Image "base") [ run "A"; run "B" ]) in + let spec2 = Obuilder.Spec.(stage ~from:(`Image "base") [ run "A"; run "C" ]) in let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:(Lwt_result.fail (`Msg "Mock build failure")) ~delay_store:a ()); let b1 = B.build builder context1 spec1 in @@ -245,7 +246,7 @@ let test_cancel _switch () = let log = Log.create "b" in let switch = Lwt_switch.create () in let context = Context.v ~switch ~src_dir ~log:(Log.add log) () in - let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let b = B.build builder context spec in @@ -264,7 +265,7 @@ let test_cancel _switch () = (* Two users are sharing a build. One cancels. *) let test_cancel_2 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ~output:(`Constant "ok") ()); let log1 = Log.create "b1" in @@ -301,7 +302,7 @@ let test_cancel_2 _switch () = (* Two users are sharing a build. Both cancel. *) let test_cancel_3 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let log1 = Log.create "b1" in @@ -340,7 +341,7 @@ let test_cancel_3 _switch () = (* One user cancels a failed build after its replacement has started. *) let test_cancel_4 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let log1 = Log.create "b1" in @@ -377,7 +378,7 @@ let test_cancel_4 _switch () = (* Start a new build while the previous one is cancelling. *) let test_cancel_5 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "Wait" ]) in let r, set_r = Lwt.wait () in let delay_store, set_delay = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ~delay_store ()); @@ -403,7 +404,7 @@ let test_cancel_5 _switch () = let test_delete _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.(stage ~from:"base" [ run "A"; run "B" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run "A"; run "B" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Constant "A") ()); Mock_sandbox.expect sandbox (mock_op ~output:(`Constant "B") ()); let log1 = Log.create "b1" in @@ -767,7 +768,7 @@ let test_secrets_not_provided _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> let log = Log.create "b" in let context = Context.v ~src_dir ~log:(Log.add log) () in - let spec = Spec.(stage ~from:"base" [ run ~secrets:[Secret.v ~target:"/run/secrets/test" "test"] "Append" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run ~secrets:[Secret.v ~target:"/run/secrets/test" "test"] "Append" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Append ("runner", "base-id")) ()); B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Error (`Msg "Couldn't find value for requested secret 'test'")) result; @@ -777,7 +778,7 @@ let test_secrets_simple _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> let log = Log.create "b" in let context = Context.v ~src_dir ~log:(Log.add log) ~secrets:["test", "top secret value"; "test2", ""] () in - let spec = Spec.(stage ~from:"base" [ run ~secrets:[Secret.v ~target:"/testsecret" "test"; Secret.v "test2"] "Append" ]) in + let spec = Spec.(stage ~from:(`Image "base") [ run ~secrets:[Secret.v ~target:"/testsecret" "test"; Secret.v "test2"] "Append" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Append ("runner", "base-id")) ()); B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result;