Add support for nested builds

README.md

@@ -71,8 +71,6 @@ which should make it easier to generate and consume it automatically.
 When performing a build, the user gives OBuilder a specification file (as described below),
 and a source directory, containing files which may be copied into the image using `copy`.
 
-At the moment, multi-stage builds are not supported, so a spec file is just a single stage, of the form:
-
 ```sexp
 ((from BASE) OP...)
 ```
@@ -99,6 +97,29 @@ By default:
 - The workdir is `/`.
 - The shell is `/bin/bash -c`.
 
+### Multi-stage builds
+
+You can define nested builds and use the output from them in `copy` operations.
+For example:
+
+```sexp
+((build dev
+        ((from ocaml/opam:alpine-3.12-ocaml-4.11)
+         (user (uid 1000) (gid 1000))
+         (workdir /home/opam)
+         (run (shell "echo 'print_endline {|Hello, world!|}' > main.ml"))
+         (run (shell "opam exec -- ocamlopt -ccopt -static -o hello main.ml"))))
+ (from alpine:3.12)
+ (shell /bin/sh -c)
+ (copy (from (build dev))
+       (src /home/opam/hello)
+       (dst /usr/local/bin/hello))
+ (run (shell "hello")))
+```
+
+At the moment, the `(build ...)` items must appear before the `(from ...)` line.
+
+
 ### workdir
 
 ```sexp
@@ -175,6 +196,7 @@ Currently, no other networks can be used, so the only options are `host` or an i
 
 ```sexp
 (copy
+ (from ...)?
  (src SRC...)
  (dst DST)
  (exclude EXCL...)?)
@@ -206,6 +228,9 @@ Files whose basenames are listed in `exclude` are ignored.
 If `exclude` is not given, the empty list is used.
 At present, glob patterns or full paths cannot be used here.
 
+If `(from (build NAME))` is given then the source directory is the root directory of the named nested build.
+Otherwise, it is the source directory provided by the user.
+
 Notes:
 
 - Unlike Docker's `COPY` operation, OBuilder copies the files using the current

example.spec

@@ -6,33 +6,44 @@
 ;
 ; The result can then be found in /tank/HASH/rootfs/ (where HASH is displayed at the end of the build).
 
-((from ocurrent/opam@sha256:27504372f75c847ac82eecc4f21599ba81647d377f844bde25325d6852a65760)
- (workdir /src)
- (user (uid 1000) (gid 1000))                           ; Build as the "opam" user
- (run (shell "sudo chown opam /src"))
- (env OPAM_HASH "3332c004db65ef784f67efdadc50982f000b718f") ; Fix the version of opam-repository we want
- (run 
-  (network host)
-  (shell
-   "cd ~/opam-repository \
-    && (git cat-file -e $OPAM_HASH || git fetch origin master) \
-    && git reset -q --hard $OPAM_HASH \
-    && git log --no-decorate -n1 --oneline \
-    && opam update -u"))
- (copy (src obuilder-spec.opam obuilder.opam) (dst ./))                     ; Copy just the opam file first (helps caching)
- (run (shell "opam pin add -yn ."))
- ; Install OS package dependencies
- (run
-  (network host)
-  (cache (opam-archives (target /home/opam/.opam/download-cache)))
-  (shell "opam depext -y obuilder"))
- ; Install OCaml dependencies
+((build dev
+	((from ocurrent/opam@sha256:27504372f75c847ac82eecc4f21599ba81647d377f844bde25325d6852a65760)
+	 (workdir /src)
+	 (user (uid 1000) (gid 1000))                           ; Build as the "opam" user
+	 (run (shell "sudo chown opam /src"))
+	 (env OPAM_HASH "3332c004db65ef784f67efdadc50982f000b718f") ; Fix the version of opam-repository we want
+	 (run 
+	  (network host)
+	  (shell
+	   "cd ~/opam-repository \
+	    && (git cat-file -e $OPAM_HASH || git fetch origin master) \
+	    && git reset -q --hard $OPAM_HASH \
+	    && git log --no-decorate -n1 --oneline \
+	    && opam update -u"))
+	 ; Copy just the opam file first (helps caching)
+	 (copy (src obuilder-spec.opam obuilder.opam) (dst ./))
+	 (run (shell "opam pin add -yn ."))
+	 ; Install OS package dependencies
+	 (run
+	  (network host)
+	  (cache (opam-archives (target /home/opam/.opam/download-cache)))
+	  (shell "opam depext -y obuilder"))
+	 ; Install OCaml dependencies
+	 (run
+	  (network host)
+	  (cache (opam-archives (target /home/opam/.opam/download-cache)))
+	  (shell "opam install --deps-only -t obuilder"))
+	 (copy                                                  ; Copy the rest of the source code
+	  (src .)
+	  (dst /src/)
+	  (exclude .git _build))
+	 (run (shell "opam exec -- dune build @install @runtest"))))    ; Build and test
+ ; Now generate a small runtime image with just the resulting binary:
+ (from debian:10)
  (run
   (network host)
-  (cache (opam-archives (target /home/opam/.opam/download-cache)))
-  (shell "opam install --deps-only -t obuilder"))
- (copy                                                  ; Copy the rest of the source code
-  (src .)
-  (dst /src/)
-  (exclude .git _build))
- (run (shell "opam exec -- dune build @install @runtest && rm -rf _build")))    ; Build and test
+  (shell "apt-get update && apt-get install -y libsqlite3-0 --no-install-recommends"))
+ (copy (from (build dev))
+       (src /src/_build/default/main.exe)
+       (dst /usr/local/bin/obuilder))
+ (run (shell "obuilder --help")))

lib/build.ml

@@ -6,19 +6,25 @@ let ( >>!= ) = Lwt_result.bind
 
 let hostname = "builder"
 
+module Scope = Map.Make(String)
+
 module Context = struct
   type t = {
     switch : Lwt_switch.t option;
     env : Os.env;                       (* Environment in which to run commands. *)
     src_dir : string;                   (* Directory with files for copying. *)
-    user : Obuilder_spec.user;                   (* Container user to run as. *)
+    user : Obuilder_spec.user;          (* Container user to run as. *)
     workdir : string;                   (* Directory in the container namespace for cwd. *)
     shell : string list;
     log : S.logger;
+    scope : string Scope.t;             (* Nested builds that are in scope. *)
   }
 
   let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?(workdir="/") ?(shell=["/bin/bash"; "-c"]) ~log ~src_dir () =
-    { switch; env; src_dir; user; workdir; shell; log }
+    { switch; env; src_dir; user; workdir; shell; log; scope = Scope.empty }
+
+  let with_binding name value t =
+    { t with scope = Scope.add name value t.scope }
 end
 
 module Saved_context = struct
@@ -96,9 +102,22 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct
     | [item] -> Ok (`Copy_item (item, dst))
     | _ -> Fmt.error_msg "When copying multiple items, the destination must end with '/'"
 
-  let copy t ~context ~base { Obuilder_spec.src; dst; exclude } =
-    let { Context.switch; src_dir; workdir; user; log; shell = _; env = _ } = context in
+  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 dst = if Filename.is_relative dst then workdir / dst else dst in
+    begin
+      match from with
+      | `Context -> Lwt_result.return src_dir
+      | `Build name ->
+        match Scope.find_opt name scope with
+        | None -> Fmt.failwith "Unknown build %S" name   (* (shouldn't happen; gets caught earlier) *)
+        | Some id ->
+          match Store.result t.store id with
+          | None ->
+            Lwt_result.fail (`Msg (Fmt.strf "Build result %S not found" id))
+          | Some dir ->
+            Lwt_result.return (dir / "rootfs")
+    end >>!= fun src_dir ->
     let src_manifest = sequence (List.map (Manifest.generate ~exclude ~src_dir) src) in
     match Result.bind src_manifest (to_copy_op ~dst) with
     | Error _ as e -> Lwt.return e
@@ -162,7 +181,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct
       | `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 = _ } = context in
+          let { Context.switch; workdir; user; env; shell; log; src_dir = _; scope = _ } = context in
           (switch, { base; workdir; user; env; cmd; shell; network }, log)
         in
         run t ~switch ~log ~cache run_input >>!= fun base ->
@@ -235,11 +254,23 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct
     let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in
     Lwt_result.return (id, env)
 
-  let build t context { Obuilder_spec.from = base; ops } =
+  let rec build ~scope t context { Obuilder_spec.child_builds; from = base; ops } =
+    let rec aux context = function
+      | [] -> Lwt_result.return context
+      | (name, child_spec) :: child_builds ->
+        context.Context.log `Heading Fmt.(strf "(build %S ...)" name);
+        build ~scope t context child_spec >>!= fun child_result ->
+        context.Context.log `Note Fmt.(strf "--> finished %S" name);
+        let context = Context.with_binding name child_result context in
+        aux context child_builds
+    in
+    aux context child_builds >>!= fun context ->
     get_base t ~log:context.Context.log base >>!= fun (id, env) ->
     let context = { context with env = context.env @ env } in
     run_steps t ~context ~base:id ops
 
+  let build = build ~scope:[]
+
   let delete ?log t id =
     Store.delete ?log t.store id
 

lib_spec/docker.ml

@@ -37,16 +37,24 @@ let of_op ~buildkit (acc, ctx) : Spec.op -> Dockerfile.t list * ctx = function
     in
     run "%s %s" (String.concat " " mounts) (wrap shell) :: acc, ctx
   | `Run { cache = _; network = _; shell } -> run "%s" (wrap shell) :: acc, ctx
-  | `Copy { src; dst; exclude = _ } ->
-    if ctx.user = Spec.root then copy ~src ~dst () :: acc, ctx
+  | `Copy { from; src; dst; exclude = _ } ->
+    let from = match from with
+      | `Build name -> Some name
+      | `Context -> None
+    in
+    if ctx.user = Spec.root then copy ?from ~src ~dst () :: acc, ctx
     else (
       let { Spec.uid; gid } = ctx.user in
       let chown = Printf.sprintf "%d:%d" uid gid in
-      copy ~chown ~src ~dst () :: acc, ctx
+      copy ?from ~chown ~src ~dst () :: acc, ctx
     )
   | `User ({ uid; gid } as u) -> user "%d:%d" uid gid :: acc, { user = u }
   | `Env b -> env [b] :: acc, ctx
 
-let dockerfile_of_spec ~buildkit { Spec.from; ops } =
+let rec convert ?name ~buildkit { Spec.child_builds; from; ops } =
+  let stages = child_builds |> List.map (fun (name, spec) -> convert ~name ~buildkit spec) |> List.flatten in
   let ops', _ctx = List.fold_left (of_op ~buildkit) ([], default_ctx) ops in
-  Dockerfile.from from @@@ List.rev ops'
+  stages @ [Dockerfile.from ?alias:name from @@@ List.rev ops']
+
+let dockerfile_of_spec ~buildkit t =
+  Dockerfile.empty @@@ convert ~buildkit t