1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
type ctx = {
user : Spec.user;
}
let pp_pair f (k, v) =
Fmt.pf f "%s=%s" k v
let pp_escape ~escape =
match escape with
| '\\' -> Fmt.any " \\@\n "
| '`' -> Fmt.any " `@\n "
| _ -> assert false
let pp_wrap ~escape =
Fmt.using (String.split_on_char '\n')
Fmt.(list ~sep:(pp_escape ~escape) (using String.trim string))
let pp_cache ~ctx f { Cache.id; target; buildkit_options } =
let buildkit_options = match ctx.user with
| `Unix {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
| `Windows _ -> assert false
in
let buildkit_options =
("--mount=type", "cache") ::
("id", id) ::
("target", target) ::
buildkit_options
in
Fmt.pf f "%a" Fmt.(list ~sep:(any ",") pp_pair) buildkit_options
let pp_mount_secret ~ctx f { Secret.id; target; buildkit_options } =
let buildkit_options = match ctx.user with
| `Unix {uid; gid = _} -> ("uid", string_of_int uid) :: buildkit_options
| `Windows _ -> assert false
in
let buildkit_options =
("--mount=type", "secret") ::
("id", id) ::
("target", target) ::
buildkit_options
in
Fmt.pf f "%a" Fmt.(list ~sep:(any ",") pp_pair) buildkit_options
let pp_run ~escape ~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 ~escape) shell
let is_root user =
user = (Spec.root_windows :> Spec.user) || user = (Spec.root_unix :> Spec.user)
let pp_copy ~ctx f { Spec.from; src; dst; exclude = _ } =
let from = match from with
| `Build name -> Some name
| `Context -> None
in
let chown =
if is_root ctx.user then None
else (
match ctx.user with
| `Unix { uid; gid } -> Some (Printf.sprintf "%d:%d" uid gid)
| `Windows _ -> None
)
in
Fmt.pf f "COPY %a%a%a %s"
Fmt.(option (fmt "--chown=%s ")) chown
Fmt.(option (fmt "--from=%s ")) from
Fmt.(list ~sep:sp string) src
dst
let quote ~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 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
let pp_op ~buildkit ~escape ctx f : Spec.op -> ctx = function
| `Comment x -> Fmt.pf f "# %s" x; ctx
| `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 ~escape ~ctx f x; ctx
| `Run x -> pp_run ~escape ~ctx f { x with cache = []; secrets = []}; ctx
| `Copy x -> pp_copy ~ctx f x; ctx
| `User (`Unix { uid; gid } as u) -> Fmt.pf f "USER %d:%d" uid gid; { user = u }
| `User (`Windows { name } as u) -> Fmt.pf f "USER %s" name; { user = u }
| `Env (k, v) -> Fmt.pf f "ENV %s=\"%s\"" k (quote ~escape v); ctx
let rec convert ~buildkit ~escape ~ctx f (name, { Spec.child_builds; from; ops }) =
child_builds |> List.iter (fun (name, spec) ->
convert ~buildkit ~escape ~ctx f (Some name, spec);
Format.pp_print_newline f ();
);
Fmt.pf f "@[<h>FROM %s%a@]@." from Fmt.(option (const string " as " ++ string)) name;
let (_ : ctx) = List.fold_left (fun ctx op ->
Format.pp_open_hbox f ();
let ctx = pp_op ~buildkit ~escape ctx f op in
Format.pp_close_box f ();
Format.pp_print_newline f ();
ctx
) ctx ops
in ()
let dockerfile_of_spec ~buildkit ~os t =
Fmt.str "%a" (fun f ->
match os with
| `Windows ->
let ctx = { user = (Spec.root_windows :> Spec.user) } in
(Fmt.pf f "@[<h>#escape=`@]@.";
convert ~buildkit ~escape:'`' ~ctx f)
| `Unix ->
let ctx = { user = (Spec.root_unix :> Spec.user) } in
convert ~buildkit ~escape:'\\' ~ctx f) (None, t)