Fix ENV directive quoting, use Fmt.str

src-cmd/dockerfile_cmd.ml

@@ -54,9 +54,9 @@ let run_log ?(ok_to_fail=true) ?env log_dir name cmd =
   let path = Fpath.(log_dir / (name ^ ".sxp")) in
   OS.File.write path (Sexplib.Sexp.to_string_hum (sexp_of_cmd_log cmd_log)) >>= fun () ->
   match status with
-  |`Signaled n -> if ok_to_fail then Ok () else R.error_msg (Fmt.strf "Signal %d" n)
+  |`Signaled n -> if ok_to_fail then Ok () else R.error_msg (Fmt.str "Signal %d" n)
   |`Exited 0 -> Ok ()
-  |`Exited code -> if ok_to_fail then Ok () else R.error_msg (Fmt.strf "Exit code %d" code)
+  |`Exited code -> if ok_to_fail then Ok () else R.error_msg (Fmt.str "Exit code %d" code)
 
 (** Docker *)
 module Docker = struct
@@ -111,9 +111,9 @@ module Docker = struct
 
   let run_cmd ?(mounts=[]) ?(volumes=[]) ?(rm=true) img cmd =
     let rm = if rm then Cmd.(v "--rm") else Cmd.empty in
-    let mounts = List.map (fun (src,dst) -> ["--mount"; Fmt.strf "source=%s,destination=%s" src dst]) mounts |> List.flatten |> Cmd.of_list in
+    let mounts = List.map (fun (src,dst) -> ["--mount"; Fmt.str "source=%s,destination=%s" src dst]) mounts |> List.flatten |> Cmd.of_list in
     let vols =
-     List.map (fun (src,dst) -> ["-v"; Fmt.strf "%s:%s" src dst]) volumes |> List.flatten |> Cmd.of_list in
+     List.map (fun (src,dst) -> ["-v"; Fmt.str "%s:%s" src dst]) volumes |> List.flatten |> Cmd.of_list in
     Cmd.(bin % "run" %% rm %% mounts %% vols % img %% cmd)
 end
 

src-cmd/dockerfile_gen.ml

@@ -66,7 +66,7 @@ let generate_dockerfiles_in_git_branches ?readme ?(crunch=true) output_dir d =
         Cmd.(git % "add" % "README.md") |> OS.Cmd.run
     end >>= fun () ->
     Cmd.(git % "add" % "Dockerfile") |> OS.Cmd.run >>= fun () ->
-    let msg = Fmt.strf "update %s Dockerfile" name in
+    let msg = Fmt.str "update %s Dockerfile" name in
     Cmd.(git % "commit" % "-q" % "-m" % msg % "-a") |> OS.Cmd.run_status >>= fun _ ->
     Ok ()
   ) d >>= fun () ->

src-opam/dockerfile_opam.ml

@@ -52,8 +52,8 @@ let install_opam_from_source_cygwin ?(add_default_link=true) ?(prefix= "/usr/loc
 
 let install_bubblewrap_from_source ?(prefix="/usr/local") () =
   let rel = "0.4.1" in
-  let file = Fmt.strf "bubblewrap-%s.tar.xz" rel in
-  let url = Fmt.strf "https://github.com/projectatomic/bubblewrap/releases/download/v%s/bubblewrap-%s.tar.xz" rel rel in
+  let file = Fmt.str "bubblewrap-%s.tar.xz" rel in
+  let url = Fmt.str "https://github.com/projectatomic/bubblewrap/releases/download/v%s/bubblewrap-%s.tar.xz" rel rel in
   run "curl -fOL %s" url @@
   run "tar xf %s" file @@
   run "cd bubblewrap-%s && ./configure --prefix=%s && make && sudo make install" rel prefix @@
@@ -325,7 +325,7 @@ let all_ocaml_compilers hub_id arch distro =
       | `Linux -> run "opam-sandbox-disable"
       | `Windows | `Cygwin -> empty
     in
-    header ~arch ~tag:(Fmt.strf "%s-opam" distro_tag) ~img:hub_id distro
+    header ~arch ~tag:(Fmt.str "%s-opam" distro_tag) ~img:hub_id distro
     @@ workdir "/home/opam/opam-repository" @@ run "git pull origin master"
     @@ sandbox
     @@ run "opam init -k git -a /home/opam/opam-repository --bare%s"
@@ -340,7 +340,7 @@ let all_ocaml_compilers hub_id arch distro =
        | `Linux | `Cygwin -> cmd "bash"
        | `Windows -> cmd_exec ["cmd.exe"]
   in
-  (Fmt.strf "%s" distro_tag, d)
+  (Fmt.str "%s" distro_tag, d)
 
 let tag_of_ocaml_version ov =
   Ocaml_version.with_patch ov None |>
@@ -366,7 +366,7 @@ let separate_ocaml_compilers hub_id arch distro =
            let sandbox = match os_family with
              | `Linux -> run "opam-sandbox-disable"
              | `Windows | `Cygwin -> empty in
-           header ~arch ~tag:(Fmt.strf "%s-opam" distro_tag) ~img:hub_id distro
+           header ~arch ~tag:(Fmt.str "%s-opam" distro_tag) ~img:hub_id distro
            @@ workdir "/home/opam/opam-repository"
            @@ sandbox
            @@ run "opam init -k git -a /home/opam/opam-repository --bare%s"
@@ -382,7 +382,7 @@ let separate_ocaml_compilers hub_id arch distro =
               | `Linux | `Cygwin -> cmd "bash"
               | `Windows -> cmd_exec ["cmd.exe"]
          in
-         (Fmt.strf "%s-ocaml-%s" distro_tag (tag_of_ocaml_version ov), d) )
+         (Fmt.str "%s-ocaml-%s" distro_tag (tag_of_ocaml_version ov), d) )
 
 
 let deprecated =
@@ -393,10 +393,10 @@ let multiarch_manifest ~target ~platforms =
   let ms =
     List.map
       (fun (image, arch) ->
-        Fmt.strf
+        Fmt.str
           "  -\n    image: %s\n    platform:\n      architecture: %s\n      os: linux"
           image arch)
       platforms
     |> String.concat "\n"
   in
-  Fmt.strf "image: %s\nmanifests:\n%s" target ms
+  Fmt.str "image: %s\nmanifests:\n%s" target ms

src/dockerfile.ml

@@ -98,17 +98,31 @@ let json_array_of_list sl =
   sprintf "[ %s ]" (String.concat ", " (List.map quote sl))
 
 
-let string_of_shell_or_exec ~escape:(escape) (t: shell_or_exec) =
+let string_of_shell_or_exec ~escape (t: shell_or_exec) =
   match t with
   | `Shell s -> s
   | `Shells [] -> ""
   | `Shells [s] -> s
-  | `Shells l -> String.concat (" && "^escape^"\n  ") l
+  | `Shells l -> String.concat (" && "^(String.make 1 escape)^"\n  ") l
   | `Exec sl -> json_array_of_list sl
 
 
-let string_of_env_list el =
-  String.concat " " (List.map (fun (k, v) -> sprintf "%s=%S" k v) el)
+let string_of_env_list ~escape el =
+  let quote 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 begin
+        if i - !j > 0 then Buffer.add_substring buf v !j (i - !j);
+        Buffer.add_char buf escape;
+        j := i
+      end
+    done;
+    Buffer.add_substring buf v !j (len - !j);
+    Buffer.contents buf
+  in
+  String.concat " " (List.map (fun (k, v) -> sprintf {|%s="%s"|} k (quote v)) el)
 
 
 let optional name = function
@@ -127,11 +141,10 @@ let string_of_label_list ls =
   List.map (fun (k, v) -> sprintf "%s=%S" k v) ls |> String.concat " "
 
 
-let rec string_of_line ~escape:(escape) (t: line) =
+let rec string_of_line ~escape (t: line) =
   match t with
   | `ParserDirective (`Escape c) ->
-     let escape = String.make 1 c in
-     cmd "#" ("escape="^escape)
+     cmd "#" ("escape="^(String.make 1 c))
   | `ParserDirective (`Syntax str) -> cmd "#" ("syntax="^str)
   | `Comment c -> cmd "#" c
   | `From {image; tag; alias; platform} ->
@@ -144,7 +157,7 @@ let rec string_of_line ~escape:(escape) (t: line) =
   | `Run c -> cmd "RUN" (string_of_shell_or_exec ~escape c)
   | `Cmd c -> cmd "CMD" (string_of_shell_or_exec ~escape c)
   | `Expose pl -> cmd "EXPOSE" (String.concat " " (List.map string_of_int pl))
-  | `Env el -> cmd "ENV" (string_of_env_list el)
+  | `Env el -> cmd "ENV" (string_of_env_list ~escape el)
   | `Add c -> cmd "ADD" (string_of_sources_to_dest c)
   | `Copy c -> cmd "COPY" (string_of_sources_to_dest c)
   | `User u -> cmd "USER" u
@@ -208,7 +221,6 @@ let string_of_t tl =
     | `ParserDirective _ :: tl -> find_escape tl
     | _ -> '\\'
   in
-  let escape = String.make 1 (find_escape tl) in
-  String.concat "\n" (List.map (string_of_line ~escape) tl)
+  String.concat "\n" (List.map (string_of_line ~escape:(find_escape tl)) tl)
 
 let pp ppf tl = Fmt.pf ppf "%s" (string_of_t tl)