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
open Lwt.Infix
open Auth
type t = auth option
let ( >>!= ) = Lwt_result.bind
let id = "docker-pull"
module Key = struct
type t = {
docker_context : string option;
arch: string option;
tag : string;
} [@@deriving to_yojson]
let cmd { docker_context; tag; _ } = Cmd.docker ~docker_context ["pull"; tag]
let digest t = Yojson.Safe.to_string (to_yojson t)
end
module Value = Image
let get_digest_from_manifest manifest arch =
let open Yojson.Basic.Util in
match Yojson.Basic.from_string manifest with
| exception ex -> Fmt.error_msg "Failed to parse manifest JSON: %a@\n%S" Fmt.exn ex manifest
| json ->
try
json |> member "manifests" |> to_list |>
List.find (fun j -> member "platform" j |> fun j ->
(member "architecture" j |> to_string = arch) &&
(member "os" j |> to_string = "linux")) |>
member "digest" |> fun digest -> Ok (to_string digest)
with ex ->
Fmt.error_msg "Failed to find arch %S in manifest (%a):@,%a"
arch
Fmt.exn ex
(Yojson.Basic.pretty_print ~std:true) json
let build auth job key =
Current.Job.start job ~level:Current.Level.Mostly_harmless >>= fun () ->
let { Key.docker_context; tag; arch } = key in
Auth.login ~docker_context ~job auth >>!= (fun () ->
Prometheus.Gauge.inc_one Metrics.docker_pull_events;
match arch with
| None -> begin
Current.Process.exec ~cancellable:true ~job (Key.cmd key) >>!= fun () ->
let cmd = Cmd.docker ~docker_context ["image"; "inspect"; tag; "-f"; "{{index .RepoDigests 0}}"] in
Current.Process.check_output ~cancellable:false ~job cmd >>!= fun id ->
let id = String.trim id in
Current.Job.log job "Pulled %S -> %S" tag id;
Lwt_result.return (Image.of_hash id)
end
| Some arch -> begin
let cmd = Cmd.docker ~docker_context ["manifest"; "inspect"; tag ] in
Current.Process.check_output ~cancellable:true ~job cmd >>!= fun manifest ->
match get_digest_from_manifest manifest arch with
| Error _ as e -> Lwt.return e
| Ok hash ->
let full_tag = tag ^ "@" ^ hash in
Current.Process.exec ~cancellable:true ~job (Key.cmd {key with Key.tag=full_tag}) >>!= fun () ->
Lwt_result.return (Image.of_hash full_tag)
end)
>|= (fun res -> Prometheus.Gauge.dec_one Metrics.docker_pull_events; res)
let pp f key = Cmd.pp f (Key.cmd key)
let auto_cancel = false