diff --git a/CHANGES.md b/CHANGES.md index fe6e8900..6ead6d82 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,10 @@ +### unreleased + +- Add support for secrets (@TheLortex #63, reviewed by @talex5). + The obuilder spec's `run` command supports a new `secrets` fields, which allows to temporarily + mount secret files in an user-specified location. The sandbox build context has an additional + `secrets` parameter to provide values for the requested keys. + ### v0.3 Security fix: diff --git a/README.md b/README.md index 89bbdc61..0c6aa829 100644 --- a/README.md +++ b/README.md @@ -162,6 +162,7 @@ The command run will be this list of arguments followed by the single argument ` (run (cache CACHE...)? (network NETWORK...)? + (secrets SECRET...)? (shell COMMAND)) ``` @@ -176,6 +177,7 @@ Examples: (run (cache (opam-archives (target /home/opam/.opam/download-cache))) (network host) + (secrets (password (target /secrets/password))) (shell "opam install utop")) ``` @@ -198,6 +200,16 @@ networks (if any). Currently, no other networks can be used, so the only options are `host` or an isolated private network. +The `(secrets SECRET...)` field can be used to request values for chosen keys, mounted as read-only files in +the image. Each `SECRET` entry is under the form `(ID (target PATH))`, where `ID` selects the secret, and +`PATH` is the location of the mounted secret file within the container. +The sandbox context API contains a `secrets` parameter to provide values to the runtime. +If a requested secret isn't provided with a value, the runtime fails. +With the command line interface `obuilder`, use the `--secret ID:PATH` option to provide the path of the file +containing the secret for `ID`. +When used with Docker, make sure to use the **buildkit** syntax, as only buildkit supports a `--secret` option. +(See https://docs.docker.com/develop/develop-images/build_enhancements/#new-docker-build-secret-information) + ### copy ```sexp @@ -289,7 +301,7 @@ The dockerfile should work the same way as the spec file, except for these limit - In `(copy (excludes ...) ...)` the excludes part is ignored. You will need to ensure you have a suitable `.dockerignore` file instead. -- If you want to include caches, use `--buildkit` to output in the extended BuildKit syntax. +- If you want to include caches or to use secrets, use `--buildkit` to output in the extended BuildKit syntax. - All `(network ...)` fields are ignored, as Docker does not allow per-step control of networking. diff --git a/lib/build.ml b/lib/build.ml index e18462c7..6bdf64a5 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -26,10 +26,11 @@ module Context = struct shell : string list; log : S.logger; scope : string Scope.t; (* Nested builds that are in scope. *) + secrets : (string * string) list; } - let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?(workdir="/") ?(shell=["/bin/bash"; "-c"]) ~log ~src_dir () = - { switch; env; src_dir; user; workdir; shell; log; scope = Scope.empty } + let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?(workdir="/") ?(shell=["/bin/bash"; "-c"]) ?(secrets=[]) ~log ~src_dir () = + { switch; env; src_dir; user; workdir; shell; log; scope = Scope.empty; secrets } let with_binding name value t = { t with scope = Scope.add name value t.scope } @@ -59,6 +60,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct cmd : string; shell : string list; network : string list; + mount_secrets : Config.Secret.t list; } [@@deriving sexp_of] let run t ~switch ~log ~cache run_input = @@ -68,7 +70,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct |> Sha256.string |> Sha256.to_hex in - let { base; workdir; user; env; cmd; shell; network } = run_input in + let { base; workdir; user; env; cmd; shell; network; mount_secrets } = run_input in Store.build t.store ?switch ~base ~id ~log (fun ~cancelled ~log result_tmp -> let to_release = ref [] in Lwt.finalize @@ -80,7 +82,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct ) >>= fun mounts -> let argv = shell @ [cmd] in - let config = Config.v ~cwd:workdir ~argv ~hostname ~user ~env ~mounts ~network 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 () -> Sandbox.run ~cancelled ~stdin ~log t.sandbox config result_tmp @@ -111,7 +113,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct | _ -> Fmt.error_msg "When copying multiple items, the destination must end with '/'" let copy t ~context ~base { Obuilder_spec.from; src; dst; exclude } = - let { Context.switch; src_dir; workdir; user; log; shell = _; env = _; scope } = context in + let { Context.switch; src_dir; workdir; user; log; shell = _; env = _; scope; secrets = _ } = context in let dst = if Filename.is_relative dst then workdir / dst else dst in begin match from with @@ -145,6 +147,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct ~hostname ~user:Obuilder_spec.root ~env:["PATH", "/bin:/usr/bin"] + ~mount_secrets:[] ~mounts:[] ~network:[] in @@ -178,6 +181,19 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct in { context with workdir } + let mount_secret (values : (string * string) list) (secret: Obuilder_spec.Secret.t) = + match List.assoc_opt secret.id values with + | None -> Error (`Msg ("Couldn't find value for requested secret '"^secret.id^"'") ) + | Some value -> Ok Config.Secret.{value; target=secret.target} + + let resolve_secrets (values : (string * string) list) (secrets: Obuilder_spec.Secret.t list) = + let (>>=) = Result.bind in + let (>>|) x y = Result.map y x in + List.fold_left (fun result secret -> + result >>= fun result -> + mount_secret values secret >>| fun resolved_secret -> + (resolved_secret :: result) ) (Ok []) secrets + let rec run_steps t ~(context:Context.t) ~base = function | [] -> Lwt_result.return base | op :: ops -> @@ -187,11 +203,13 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = 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 } -> - let switch, run_input, log = - let { Context.switch; workdir; user; env; shell; log; src_dir = _; scope = _ } = context in - (switch, { base; workdir; user; env; cmd; shell; network }, log) + | `Run { shell = cmd; cache; network; secrets = mount_secrets } -> + 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 -> k ~base ~context | `Copy x -> diff --git a/lib/build.mli b/lib/build.mli index d0a8e412..2059919a 100644 --- a/lib/build.mli +++ b/lib/build.mli @@ -7,6 +7,7 @@ module Context : sig ?user:Obuilder_spec.user -> ?workdir:string -> ?shell:string list -> + ?secrets:(string * string) list -> log:S.logger -> src_dir:string -> unit -> t @@ -16,6 +17,7 @@ module Context : sig @param user Container user to run as. @param workdir Directory in the container namespace for cwd. @param shell The command used to run shell commands (default [["/bin/bash"; "-c"]]). + @param secrets Provided key-value pairs for secrets. @param log Function to receive log data. *) end diff --git a/lib/config.ml b/lib/config.ml index 31c3fbb6..306b7d62 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -12,6 +12,13 @@ module Mount = struct } end +module Secret = struct + type t = { + value: string; + target: string; + } [@@deriving sexp] +end + type t = { cwd : string; argv : string list; @@ -20,7 +27,8 @@ type t = { env : env; mounts : Mount.t list; network : string list; + mount_secrets : Secret.t list; } -let v ~cwd ~argv ~hostname ~user ~env ~mounts ~network = - { cwd; argv; hostname; user; env; mounts; network } +let v ~cwd ~argv ~hostname ~user ~env ~mounts ~network ~mount_secrets = + { cwd; argv; hostname; user; env; mounts; network; mount_secrets } diff --git a/lib/runc_sandbox.ml b/lib/runc_sandbox.ml index 936d8f92..7c95c3ab 100644 --- a/lib/runc_sandbox.ml +++ b/lib/runc_sandbox.ml @@ -25,6 +25,8 @@ let get_arches () = [] ) +let secret_file id = "secret-" ^ string_of_int id + module Json_config = struct let mount ?(options=[]) ~ty ~src dst = `Assoc [ @@ -99,7 +101,7 @@ module Json_config = struct in `Assoc fields - let make {Config.cwd; argv; hostname; user; env; mounts; network} t ~config_dir ~results_dir : Yojson.Safe.t = + let make {Config.cwd; argv; hostname; user; env; mounts; network; mount_secrets} t ~config_dir ~results_dir : Yojson.Safe.t = let user = let { Obuilder_spec.uid; gid } = user in `Assoc [ @@ -227,6 +229,17 @@ module Json_config = struct ] else [] ) @ + List.mapi (fun id { Config.Secret.target; _} -> + mount target + ~ty:"bind" + ~src:(config_dir / secret_file id) + ~options:[ + "rbind"; + "rprivate"; + "ro"; + ] + ) mount_secrets + @ user_mounts mounts ); "linux", `Assoc [ @@ -253,7 +266,7 @@ module Json_config = struct "seccomp", seccomp_policy t; ]; ] -end +end let next_id = ref 0 @@ -271,6 +284,12 @@ let run ~cancelled ?stdin:stdin ~log t config results_dir = 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; Os.with_pipe_from_child @@ fun ~r:out_r ~w:out_w -> diff --git a/lib_spec/docker.ml b/lib_spec/docker.ml index 2122c2b2..6b4ef99c 100644 --- a/lib_spec/docker.ml +++ b/lib_spec/docker.ml @@ -24,8 +24,21 @@ let pp_cache ~ctx f { Cache.id; target; buildkit_options } = in Fmt.pf f "%a" Fmt.(list ~sep:(unit ",") pp_pair) buildkit_options -let pp_run ~ctx f { Spec.cache; shell; network = _ } = - Fmt.pf f "RUN %a%a" Fmt.(list (pp_cache ~ctx ++ const string " ")) cache pp_wrap shell +let pp_mount_secret ~ctx f { Secret.id; target; buildkit_options } = + let buildkit_options = + ("--mount=type", "secret") :: + ("id", id) :: + ("target", target) :: + ("uid", string_of_int ctx.user.uid) :: + buildkit_options + in + Fmt.pf f "%a" Fmt.(list ~sep:(unit ",") pp_pair) buildkit_options + +let pp_run ~ctx f { Spec.cache; shell; secrets; network = _ } = + Fmt.pf f "RUN %a%a%a" + Fmt.(list (pp_mount_secret ~ctx ++ const string " ")) secrets + Fmt.(list (pp_cache ~ctx ++ const string " ")) cache + pp_wrap shell let pp_copy ~ctx f { Spec.from; src; dst; exclude = _ } = let from = match from with @@ -50,7 +63,7 @@ let pp_op ~buildkit ctx f : Spec.op -> ctx = function | `Workdir x -> Fmt.pf f "WORKDIR %s" x; ctx | `Shell xs -> Fmt.pf f "SHELL [ %a ]" Fmt.(list ~sep:comma (quote string)) xs; ctx | `Run x when buildkit -> pp_run ~ctx f x; ctx - | `Run x -> pp_run ~ctx f { x with cache = [] }; ctx + | `Run x -> pp_run ~ctx f { x with cache = []; secrets = []}; ctx | `Copy x -> pp_copy ~ctx f x; ctx | `User ({ uid; gid } as u) -> Fmt.pf f "USER %d:%d" uid gid; { user = u } | `Env (k, v) -> Fmt.pf f "ENV %s %s" k v; ctx diff --git a/lib_spec/obuilder_spec.ml b/lib_spec/obuilder_spec.ml index 7ef458d1..7294ed17 100644 --- a/lib_spec/obuilder_spec.ml +++ b/lib_spec/obuilder_spec.ml @@ -1,4 +1,5 @@ include Spec module Cache = Cache +module Secret = Secret module Docker = Docker diff --git a/lib_spec/secret.ml b/lib_spec/secret.ml new file mode 100644 index 00000000..b8a7982d --- /dev/null +++ b/lib_spec/secret.ml @@ -0,0 +1,22 @@ +open Sexplib.Std +open Sexplib.Sexp + +type t = { + id : string; + target : string; + buildkit_options : (string * string) list [@sexp.list]; +} [@@deriving sexp] + +let t_of_sexp x = + match x with + | List (Atom id :: fields) -> t_of_sexp (List (List [Atom "id"; Atom id] :: fields)) + | x -> Fmt.failwith "Invalid secret: %a" Sexplib.Sexp.pp_hum x + +let sexp_of_t x = + match sexp_of_t x with + | List (List [Atom "id"; Atom id] :: fields) -> List (Atom id :: fields) + | x -> Fmt.failwith "Invalid secret: %a" Sexplib.Sexp.pp_hum x + +let v ?(buildkit_options=[]) ?target id = + let target = Option.value target ~default:("/run/secrets/"^id) in + { id; target; buildkit_options } diff --git a/lib_spec/secret.mli b/lib_spec/secret.mli new file mode 100644 index 00000000..6ee47b0a --- /dev/null +++ b/lib_spec/secret.mli @@ -0,0 +1,8 @@ +type t = { + id : string; + target : string; + buildkit_options : (string * string) list; (* Only used when converting to Docker BuildKit format. *) +} [@@deriving sexp] + +val v : ?buildkit_options:(string * string) list -> ?target:string -> string -> t +(** [v ~target id] mounts secret [id] at [target]. Default target is /run/secrets/[id]. *) diff --git a/lib_spec/spec.ml b/lib_spec/spec.ml index de5cd59d..ec004944 100644 --- a/lib_spec/spec.ml +++ b/lib_spec/spec.ml @@ -62,11 +62,12 @@ type user = { uid : int; gid : int } type run = { cache : Cache.t list [@sexp.list]; network : string list [@sexp.list]; + secrets : Secret.t list [@sexp.list]; shell : string; } [@@deriving sexp] let run_inlined = function - | "cache" | "network" -> true + | "cache" | "network" | "secrets" -> true | _ -> false let run_of_sexp x = run_of_sexp (inflate_record run_inlined x) @@ -145,7 +146,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=[]) fmt = fmt |> Printf.ksprintf (fun x -> `Run { shell = x; cache; network }) +let run ?(cache=[]) ?(network=[]) ?(secrets=[]) fmt = fmt |> Printf.ksprintf (fun x -> `Run { shell = x; cache; network; secrets }) let copy ?(from=`Context) ?(exclude=[]) src ~dst = `Copy { from; src; dst; exclude } let env k v = `Env (k, v) let user ~uid ~gid = `User { uid; gid } diff --git a/lib_spec/spec.mli b/lib_spec/spec.mli index cfb9e7a3..338911f2 100644 --- a/lib_spec/spec.mli +++ b/lib_spec/spec.mli @@ -13,6 +13,7 @@ type user = { type run = { cache : Cache.t list; network : string list; + secrets : Secret.t list; shell : string; } [@@deriving sexp] @@ -37,7 +38,7 @@ val stage : ?child_builds:(string * t) list -> from: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 -> ('a, unit, string, op) format4 -> 'a +val run : ?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 : uid:int -> gid:int -> op diff --git a/main.ml b/main.ml index a6e9f879..7d6ff5c4 100644 --- a/main.ml +++ b/main.ml @@ -5,11 +5,6 @@ let () = let ( / ) = Filename.concat -(* -module Store = Obuilder.Zfs_store -let store = Lwt_main.run @@ Store.create ~pool:"tank" -*) - module Sandbox = Obuilder.Runc_sandbox type builder = Builder : (module Obuilder.BUILDER with type t = 'a) * 'a -> builder @@ -27,7 +22,13 @@ let create_builder ?fast_sync spec = let builder = Builder.v ~store ~sandbox in Builder ((module Builder), builder) -let build fast_sync store spec src_dir = +let read_whole_file path = + let ic = open_in_bin path in + Fun.protect ~finally:(fun () -> close_in ic) @@ fun () -> + let len = in_channel_length ic in + really_input_string ic len + +let build fast_sync store spec src_dir secrets = Lwt_main.run begin create_builder ~fast_sync store >>= fun (Builder ((module Builder), builder)) -> let spec = @@ -36,7 +37,8 @@ let build fast_sync store spec src_dir = print_endline msg; exit 1 in - let context = Obuilder.Context.v ~log ~src_dir () in + let secrets = List.map (fun (id, path) -> id, read_whole_file path) secrets in + let context = Obuilder.Context.v ~log ~src_dir ~secrets () in Builder.build builder context spec >>= function | Ok x -> Fmt.pr "Got: %S@." (x :> string); @@ -118,9 +120,17 @@ let fast_sync = ~doc:"Ignore sync syscalls (requires runc >= 1.0.0-rc92)" ["fast-sync"] +let secrets = + (Arg.value @@ + Arg.(opt_all (pair ~sep:':' string file)) [] @@ + Arg.info + ~doc:"Provide a secret under the form id:file" + ~docv:"SECRET" + ["secret"]) + let build = let doc = "Build a spec file." in - Term.(const build $ fast_sync $ store $ spec_file $ src_dir), + Term.(const build $ fast_sync $ store $ spec_file $ src_dir $ secrets), Term.info "build" ~doc let delete = diff --git a/test/test.ml b/test/test.ml index 0558377d..72d28977 100644 --- a/test/test.ml +++ b/test/test.ml @@ -63,7 +63,7 @@ let test_simple _switch () = 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; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> saved as .* /: (run (shell Append)) @@ -92,7 +92,7 @@ let test_prune _switch () = 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; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> saved as .* /: (run (shell Append)) @@ -130,7 +130,7 @@ let test_concurrent _switch () = b2 >>!= get store "output" >>= fun b2 -> Alcotest.(check build_result) "Final result" (Ok "AB") b1; Alcotest.(check build_result) "Final result" (Ok "AC") b2; - Log.check "Check AB log" + Log.check "Check AB log" {| (from base) ;---> saved as .* /: (run (shell A)) @@ -141,7 +141,7 @@ let test_concurrent _switch () = ;---> saved as .* |} log1; - Log.check "Check AC log" + Log.check "Check AC log" {| (from base) ;---> using .* from cache /: (run (shell A)) @@ -174,14 +174,14 @@ let test_concurrent_failure _switch () = b2 >>!= get store "output" >>= fun b2 -> Alcotest.(check build_result) "B1 result" (Error (`Msg "Mock build failure")) b1; Alcotest.(check build_result) "B2 result" (Error (`Msg "Mock build failure")) b2; - Log.check "Check AB log" + Log.check "Check AB log" {| (from base) ;---> saved as .* /: (run (shell A)) A |} log1; - Log.check "Check AC log" + Log.check "Check AC log" {| (from base) ;---> using .* from cache /: (run (shell A)) @@ -211,14 +211,14 @@ let test_concurrent_failure_2 _switch () = b2 >>!= get store "output" >>= fun b2 -> Alcotest.(check build_result) "B1 result" (Error (`Msg "Mock build failure")) b1; Alcotest.(check build_result) "B2 result" (Error (`Msg "Mock build failure")) b2; - Log.check "Check AB log" + Log.check "Check AB log" {| (from base) ;---> saved as .* /: (run (shell A)) A |} log1; - Log.check "Check AC log" + Log.check "Check AC log" {| (from base) ;---> using .* from cache /: (run (shell A)) @@ -240,7 +240,7 @@ let test_cancel _switch () = Lwt_switch.turn_off switch >>= fun () -> b >>= fun result -> Alcotest.(check build_result) "Final result" (Error `Cancelled) result; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> saved as .* /: (run (shell Wait)) @@ -267,7 +267,7 @@ let test_cancel_2 _switch () = Lwt_switch.turn_off switch1 >>= fun () -> b1 >>= fun result1 -> Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> saved as .* /: (run (shell Wait)) @@ -276,7 +276,7 @@ let test_cancel_2 _switch () = Lwt.wakeup set_r (Ok ()); b2 >>!= get store "output" >>= fun result2 -> Alcotest.(check build_result) "Final result" (Ok "ok") result2; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> using .* from cache /: (run (shell Wait)) @@ -304,7 +304,7 @@ let test_cancel_3 _switch () = Lwt_switch.turn_off switch1 >>= fun () -> b1 >>= fun result1 -> Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> saved as .* /: (run (shell Wait)) @@ -313,7 +313,7 @@ let test_cancel_3 _switch () = Lwt_switch.turn_off switch2 >>= fun () -> b2 >>!= get store "output" >>= fun result2 -> Alcotest.(check build_result) "User 2 result" (Error `Cancelled) result2; - Log.check "Check log" + Log.check "Check log" {|(from base) ;---> using .* from cache /: (run (shell Wait)) @@ -451,6 +451,7 @@ let test_sexp () = (workdir /src) (run (shell "a command")) (run (cache (a (target /data)) (b (target /srv))) + (secrets (a (target /run/secrets/a)) (b (target /b))) (shell "a very very very very very very very very very very very very very very very long command")) (copy (src a b) (dst c)) (copy (src a b) (dst c) (exclude .git _build)) @@ -536,6 +537,22 @@ let test_docker () = (run (shell "make tools")))) (from base) (copy (from (build tools)) (src binary) (dst /usr/local/bin/)) + ) |}; + test ~buildkit:true "Secrets" + {| FROM base as tools + RUN make tools + + FROM base + RUN --mount=type=secret,id=a,target=/secrets/a,uid=0 --mount=type=secret,id=b,target=/secrets/b,uid=0 command1 + |} {| + ((build tools + ((from base) + (run (shell "make tools")))) + (from base) + (run + (secrets (a (target /secrets/a)) + (b (target /secrets/b))) + (shell "command1")) ) |} let manifest = @@ -602,6 +619,35 @@ let test_cache_id () = check "c-foo%3abar" "foo:bar"; check "c-Az09-id.foo_orig" "Az09-id.foo_orig" + 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 + 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; + Lwt.return_unit + + 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 + 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; + Log.check "Check b log" + {| (from base) + ;---> saved as .* + /: (run (secrets (test (target /testsecret)) (test2 (target /run/secrets/test2))) + ........(shell Append)) + Append + ;---> saved as .* + |} + log; + Lwt.return_unit + let () = let open Alcotest_lwt in Lwt_main.run begin @@ -624,6 +670,10 @@ let () = test_case "Cancel 5" `Quick test_cancel_5; test_case "Delete" `Quick test_delete; ]; + "secrets", [ + test_case "Simple" `Quick test_secrets_simple; + test_case "No secret provided" `Quick test_secrets_not_provided; + ]; "manifest", [ test_case "Copy" `Quick test_copy; ];