Support RUN command arguments (mounts, network, security)

CHANGES.md

@@ -1,6 +1,9 @@
 unreleased
 ----------
 
+- Support mounts, networks, and security parameters in RUN
+  commands, add buildkit_syntax helper function.
+  (@MisterDA, @edwintorok, #137, #139, review by @edwintorok)
 - Build and install opam master from source in Windows images.
   (@MisterDA #140, #142, #143)
 - Include the ocaml-beta-repository in the images. (@kit-ty-kate #132, review by @MisterDA)

src/dockerfile.ml

@@ -51,6 +51,50 @@ type heredoc = {
 type heredocs_to_dest = [ `Chown of string option ] * heredoc list * string
 [@@deriving sexp]
 
+type mount_bind = {
+  target : string;
+  source : string option;
+  from : string option;
+  readwrite : bool option;
+}
+[@@deriving sexp]
+
+type mount_cache = {
+  id : string option;
+  target : string;
+  readonly : bool option;
+  sharing : [ `Shared | `Private | `Locked ] option;
+  from : string option;
+  source : string option;
+  mode : int option;
+  uid : int option;
+  gid : int option;
+}
+[@@deriving sexp]
+
+type mount_tmpfs = { target : string; size : int option } [@@deriving sexp]
+
+(* secret or ssh *)
+type mount_file = {
+  id : string option;
+  target : string option;
+  required : bool option;
+  mode : int option;
+  uid : int option;
+  gid : int option;
+}
+[@@deriving sexp]
+
+type mount = {
+  typ :
+    [ `Bind of mount_bind
+    | `Cache of mount_cache
+    | `Tmpfs of mount_tmpfs
+    | `Secret of mount_file
+    | `Ssh of mount_file ];
+}
+[@@deriving sexp]
+
 type healthcheck_options = {
   interval : string option;
   timeout : string option;
@@ -62,12 +106,29 @@ type healthcheck_options = {
 type healthcheck = [ `Cmd of healthcheck_options * shell_or_exec | `None ]
 [@@deriving sexp]
 
+type network = [ `Default | `None | `Host ] [@@deriving sexp]
+type security = [ `Insecure | `Sandbox ] [@@deriving sexp]
+
+let escape_string ~char_to_escape ~escape v =
+  let len = String.length v in
+  let buf = Buffer.create len in
+  let j = ref 0 in
+  for i = 0 to len - 1 do
+    if String.unsafe_get v i = char_to_escape || String.unsafe_get v i = escape
+    then (
+      if i - !j > 0 then Buffer.add_substring buf v !j (i - !j);
+      Buffer.add_char buf escape;
+      j := i)
+  done;
+  Buffer.add_substring buf v !j (len - !j);
+  Buffer.contents buf
+
 type line =
   [ `ParserDirective of parser_directive
   | `Comment of string
   | `From of from
   | `Maintainer of string
-  | `Run of shell_or_exec
+  | `Run of mount list * network option * security option * shell_or_exec
   | `Cmd of shell_or_exec
   | `Expose of int list
   | `Arg of string * string option
@@ -98,15 +159,24 @@ open Printf
 (* Multiple RUN lines will be compressed into a single one in
    order to reduce the number of layers used *)
 let crunch l =
+  let merge m m' =
+    if m = m' then m else invalid_arg "crunch: at least two mounts list differ."
+  in
   let pack l =
     let rec aux acc = function
       | [] -> acc
-      | `Run (`Shell a) :: `Run (`Shell b) :: tl ->
-          aux (`Run (`Shells [ a; b ]) :: acc) tl
-      | `Run (`Shells a) :: `Run (`Shell b) :: tl ->
-          aux (`Run (`Shells (a @ [ b ])) :: acc) tl
-      | `Run (`Shells a) :: `Run (`Shells b) :: tl ->
-          aux (`Run (`Shells (a @ b)) :: acc) tl
+      | `Run (m, n, s, `Shell a) :: `Run (m', n', s', `Shell b) :: tl ->
+          if n <> n' then invalid_arg "crunch: at least two networks differ.";
+          if s <> s' then invalid_arg "crunch: at least two securities differ.";
+          aux (`Run (merge m m', n, s, `Shells [ a; b ]) :: acc) tl
+      | `Run (m, n, s, `Shells a) :: `Run (m', n', s', `Shell b) :: tl ->
+          if n <> n' then invalid_arg "crunch: at least two networks differ.";
+          if s <> s' then invalid_arg "crunch: at least two securities differ.";
+          aux (`Run (merge m m', n, s, `Shells (a @ [ b ])) :: acc) tl
+      | `Run (m, n, s, `Shells a) :: `Run (m', n', s', `Shells b) :: tl ->
+          if n <> n' then invalid_arg "crunch: at least two networks differ.";
+          if s <> s' then invalid_arg "crunch: at least two securities differ.";
+          aux (`Run (merge m m', n, s, `Shells (a @ b)) :: acc) tl
       | hd :: tl -> aux (hd :: acc) tl
     in
     List.rev (aux [] l)
@@ -131,18 +201,7 @@ let string_of_shell_or_exec ~escape (t : shell_or_exec) =
   | `Shells l -> String.concat (" && " ^ String.make 1 escape ^ "\n  ") l
   | `Exec sl -> json_array_of_list sl
 
-let quote_env_var ~escape v =
-  let len = String.length v in
-  let buf = Buffer.create len in
-  let j = ref 0 in
-  for i = 0 to len - 1 do
-    if v.[i] = '"' || v.[i] = escape then (
-      if i - !j > 0 then Buffer.add_substring buf v !j (i - !j);
-      Buffer.add_char buf escape;
-      j := i)
-  done;
-  Buffer.add_substring buf v !j (len - !j);
-  Buffer.contents buf
+let quote_env_var = escape_string ~char_to_escape:'"'
 
 let string_of_env_var ~escape (name, value) =
   sprintf {|%s="%s"|} name (quote_env_var ~escape value)
@@ -162,10 +221,22 @@ let optional_int name = function
   | None -> []
   | Some value -> [ sprintf "%s=%d" name value ]
 
+let optional_int_octal name = function
+  | None -> []
+  | Some value -> [ sprintf "%s=%04o" name value ]
+
+let optional_bool name = function
+  | None -> []
+  | Some value -> [ sprintf "%s=%b" name value ]
+
 let optional_flag name = function
   | Some true -> [ name ]
   | Some false | None -> []
 
+let optional_enum name string_of_val = function
+  | None -> []
+  | Some value -> [ sprintf "--%s=%s" name (string_of_val value) ]
+
 let string_of_sources_to_dest (t : sources_to_dest) =
   let `From frm, `Src sl, `Dst d, `Chown chown, `Link link = t in
   String.concat " "
@@ -188,6 +259,65 @@ let string_of_copy_heredoc (t : heredocs_to_dest) =
   String.concat " " (optional "--chown" chown @ List.rev header @ [ dst ])
   ^ docs
 
+let string_of_mount { typ } =
+  match typ with
+  | `Bind { target; source; from; readwrite } ->
+      String.concat ","
+        ([ "--mount=type=bind" ]
+        @ [ sprintf "target=%s" target ]
+        @ optional "source" source @ optional "from" from
+        @ optional_bool "readwrite" readwrite)
+  | `Cache { id; target; readonly; sharing; from; source; mode; uid; gid } ->
+      String.concat ","
+        ([ "--mount=type=cache" ] @ optional "id" id
+        @ [ sprintf "target=%s" target ]
+        @ optional_bool "readonly" readonly
+        @ (match sharing with
+          | None -> []
+          | Some `Shared -> [ "sharing=shared" ]
+          | Some `Private -> [ "sharing=private" ]
+          | Some `Locked -> [ "sharing=locked" ])
+        @ optional "from" from @ optional "source" source
+        @ optional_int_octal "mode" mode
+        @ optional_int "uid" uid @ optional_int "gid" gid)
+  | `Tmpfs { target; size } ->
+      String.concat ","
+        ([ "--mount=type=bind" ]
+        @ [ sprintf "target=%s" target ]
+        @ optional_int "size" size)
+  | `Ssh m | `Secret m ->
+      let typ =
+        match typ with
+        | `Ssh _ -> "ssh"
+        | `Secret _ -> "secret"
+        | _ -> assert false
+      in
+      let { id; target; required; mode; uid; gid } = m in
+      String.concat ","
+        ([ sprintf "--mount=type=%s" typ ]
+        @ optional "id" id @ optional "target" target
+        @ optional_bool "required" required
+        @ optional_int_octal "mode" mode
+        @ optional_int "uid" uid @ optional_int "gid" gid)
+
+let string_of_run ~escape mounts network security c =
+  let mounts =
+    mounts |> List.map string_of_mount
+    |> List.map (escape_string ~char_to_escape:' ' ~escape)
+  in
+  let network =
+    optional_enum "network"
+      (function `Default -> "default" | `None -> "none" | `Host -> "host")
+      network
+  in
+  let security =
+    optional_enum "security"
+      (function `Insecure -> "insecure" | `Sandbox -> "sandbox")
+      security
+  in
+  let run = string_of_shell_or_exec ~escape c in
+  String.concat " " (mounts @ network @ security @ [ run ])
+
 let rec string_of_line ~escape (t : line) =
   match t with
   | `ParserDirective (`Escape c) -> cmd "#" ("escape=" ^ String.make 1 c)
@@ -205,7 +335,8 @@ let rec string_of_line ~escape (t : line) =
              (match alias with None -> "" | Some a -> " as " ^ a);
            ])
   | `Maintainer m -> cmd "MAINTAINER" m
-  | `Run c -> cmd "RUN" (string_of_shell_or_exec ~escape c)
+  | `Run (mounts, network, security, c) ->
+      cmd "RUN" (string_of_run ~escape mounts network security c)
   | `Cmd c -> cmd "CMD" (string_of_shell_or_exec ~escape c)
   | `Expose pl -> cmd "EXPOSE" (String.concat " " (List.map string_of_int pl))
   | `Arg a -> cmd "ARG" (string_of_arg ~escape a)
@@ -235,15 +366,42 @@ and string_of_healthcheck ~escape options c =
 
 (* Function interface *)
 let parser_directive pd : t = [ `ParserDirective pd ]
+let buildkit_syntax = parser_directive (`Syntax "docker/dockerfile:1")
 
 let heredoc ?(strip = false) ?(word = "EOF") ?(delimiter = word) fmt =
   ksprintf (fun here_document -> { here_document; strip; word; delimiter }) fmt
 
+let mount_bind ~target ?source ?from ?readwrite () =
+  let m = { target; source; from; readwrite } in
+  { typ = `Bind m }
+
+let mount_cache ?id ~target ?readonly ?sharing ?from ?source ?mode ?uid ?gid ()
+    =
+  let m = { id; target; readonly; sharing; from; source; mode; uid; gid } in
+  { typ = `Cache m }
+
+let mount_tmpfs ~target ?size () =
+  let m = { target; size } in
+  { typ = `Tmpfs m }
+
+let mount_secret ?id ?target ?required ?mode ?uid ?gid () =
+  let m = { id; target; required; mode; uid; gid } in
+  { typ = `Secret m }
+
+let mount_ssh ?id ?target ?required ?mode ?uid ?gid () =
+  let m = { id; target; required; mode; uid; gid } in
+  { typ = `Ssh m }
+
 let from ?alias ?tag ?platform image = [ `From { image; tag; alias; platform } ]
 let comment fmt = ksprintf (fun c -> [ `Comment c ]) fmt
 let maintainer fmt = ksprintf (fun m -> [ `Maintainer m ]) fmt
-let run fmt = ksprintf (fun b -> [ `Run (`Shell b) ]) fmt
-let run_exec cmds : t = [ `Run (`Exec cmds) ]
+
+let run ?(mounts = []) ?network ?security fmt =
+  ksprintf (fun b -> [ `Run (mounts, network, security, `Shell b) ]) fmt
+
+let run_exec ?(mounts = []) ?network ?security cmds : t =
+  [ `Run (mounts, network, security, `Exec cmds) ]
+
 let cmd fmt = ksprintf (fun b -> [ `Cmd (`Shell b) ]) fmt
 let cmd_exec cmds : t = [ `Cmd (`Exec cmds) ]
 let expose_port p : t = [ `Expose [ p ] ]