From 78cc1718049ce2817c8bfffb5673b368a28d6916 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 10 Jun 2021 22:19:15 +0200 Subject: [PATCH 1/3] Simplify escape parameter --- src/dockerfile.ml | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/dockerfile.ml b/src/dockerfile.ml index f03f4433..a7a966ed 100644 --- a/src/dockerfile.ml +++ b/src/dockerfile.ml @@ -98,12 +98,12 @@ 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 @@ -127,11 +127,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} -> @@ -208,7 +207,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) From a64508b5ba8a58b2c47dec50c42f38090995b271 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 10 Jun 2021 21:48:30 +0200 Subject: [PATCH 2/3] Correctly quote ENV instructions Docker uses the character defined by the #escape parser directive to escape characters in strings. If we surround the environment variable value with double-quotes, we only need to escape double-quotes and the escape character itself in the value. Using the OCaml quoting %S introduces wrong changes and doesn't work when Docker escape character is changed. --- src/dockerfile.ml | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/src/dockerfile.ml b/src/dockerfile.ml index a7a966ed..819e04e8 100644 --- a/src/dockerfile.ml +++ b/src/dockerfile.ml @@ -107,8 +107,22 @@ let string_of_shell_or_exec ~escape (t: shell_or_exec) = | `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 @@ -143,7 +157,7 @@ let rec string_of_line ~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 From 3c0873459f3d9b7af6ac7f0e38b80a3ac5777661 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Fri, 11 Jun 2021 11:16:41 +0200 Subject: [PATCH 3/3] Replace Fmt.strf with Fmt.str --- src-cmd/dockerfile_cmd.ml | 8 ++++---- src-cmd/dockerfile_gen.ml | 2 +- src-opam/dockerfile_opam.ml | 16 ++++++++-------- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src-cmd/dockerfile_cmd.ml b/src-cmd/dockerfile_cmd.ml index 7e0b0446..5320fdf9 100644 --- a/src-cmd/dockerfile_cmd.ml +++ b/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 diff --git a/src-cmd/dockerfile_gen.ml b/src-cmd/dockerfile_gen.ml index f1fca1c6..46a6091e 100644 --- a/src-cmd/dockerfile_gen.ml +++ b/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 () -> diff --git a/src-opam/dockerfile_opam.ml b/src-opam/dockerfile_opam.ml index 1f7f2d7f..2a6005e6 100644 --- a/src-opam/dockerfile_opam.ml +++ b/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