diff --git a/.ocamlformat b/.ocamlformat index 5ff887c..48f842c 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version = 0.26.1 +version = 0.26.2 profile = conventional break-infix = fit-or-vertical parse-docstrings = true diff --git a/bin/main.ml b/bin/main.ml index 4332009..44dc0c3 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -65,17 +65,22 @@ let setup = $ style_renderer $ Logs_cli.level ()) -let null_auth ?ip:_ ~host:_ _ = - Ok None (* Warning: use a real authenticator in your code! *) +let authenticator = + match Ca_certs.authenticator () with + | Ok x -> x + | Error (`Msg m) -> + Fmt.failwith "Failed to create system store X509 authenticator: %s" m let https ~authenticator = - let tls_config = Tls.Config.client ~authenticator () in - fun uri raw -> - let host = - Uri.host uri - |> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x))) - in - Tls_eio.client_of_flow ?host tls_config raw + match Tls.Config.client ~authenticator () with + | Error (`Msg m) -> failwith m + | Ok tls_config -> + fun uri raw -> + let host = + Uri.host uri + |> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x))) + in + Tls_eio.client_of_flow ?host tls_config raw let cache env = let fs = Eio.Stdenv.fs env in @@ -91,7 +96,7 @@ let fetch () all_tags platform image username password no_progress = Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () -> let client = Cohttp_eio.Client.make - ~https:(Some (https ~authenticator:null_auth)) + ~https:(Some (https ~authenticator)) (Eio.Stdenv.net env) in let cache = cache env in diff --git a/container-image.opam b/container-image.opam index a2d179f..0ac2669 100644 --- a/container-image.opam +++ b/container-image.opam @@ -13,6 +13,7 @@ depends: [ "ocaml" {>= "5.00.0"} "dune" {>= "3.8.0"} "yojson" + "ca-certs" "ppx_deriving_yojson" "digestif" "decompress" @@ -22,11 +23,11 @@ depends: [ "astring" "dune-build-info" "mirage-crypto-rng-eio" - "cohttp" - "cohttp-eio" + "cohttp" {>= "6.0.0"} + "cohttp-eio" {>= "6.0.0"} "progress" "tls-eio" - "eio" {>= "0.13"} + "eio" {>= "1.2"} "tar-eio" "eio_main" "xdg" @@ -35,15 +36,4 @@ depends: [ "osrelease" "alcotest" {with-test} ] - -pin-depends: [ - [ "cohttp-eio.dev" "git+https://github.com/mirage/ocaml-cohttp.git#master"] - [ "cohttp.dev" "git+https://github.com/mirage/ocaml-cohttp.git#master"] - [ "http.dev" "git+https://github.com/mirage/ocaml-cohttp.git#master"] - [ "mirage-crypto-rng.0.11.2" "git+https://github.com/dinosaure/mirage-crypto.git#parallel"] - [ "tar.dev" "git+https://github.com/samoht/ocaml-tar.git#eio-0.12"] - [ "tar-eio.dev" "git+https://github.com/samoht/ocaml-tar.git#eio-0.12"] - [ "osrelease.dev" "git+https://github.com/avsm/osrelease#master"] -] - synopsis: "Tools to manage OCI and Docker images" diff --git a/src/checkout.ml b/src/checkout.ml index 9a220e5..20e349d 100644 --- a/src/checkout.ml +++ b/src/checkout.ml @@ -20,28 +20,60 @@ let bytes_to_size ?(decimals = 2) ppf = function let r = n /. Float.pow 1024. i in Format.fprintf ppf "%.*f %s" decimals r sizes.(int_of_float i) +let ignore_if_already_exists f v = + try f v with Eio.Exn.Io (Eio.Fs.E (Already_exists _), _) -> () + +(* TODO: Upstream patches to Eio for fchmodat, fchownat, utimensat *) let checkout_layer ~sw ~cache layer dir = - let fd = Cache.Blob.get_fd ~sw cache layer in - let fd = Tar_eio_gz.of_source fd in - Fmt.epr "Extracting layer %a:\n%!" Digest.pp layer; - Tar_eio_gz.fold - ~filter:(fun _ -> `Header_and_file) - (fun hdr src () -> - let path = dir / hdr.file_name in - mkdir_parent path; - (* TODO(patricoferrs): Why landing? *) + let ( let* ) = Tar.( let* ) in + let src = Cache.Blob.get_fd ~sw cache layer in + Eio.traceln "Extracting layer %a:\n%!" Digest.pp layer; + let go ?global:_ (hdr : Tar.Header.t) _ = + let path = dir / hdr.file_name in + let* () = let file_mode = 0o777 land hdr.file_mode in - (* TODO(patricoferris): Symlinks etc. *) match hdr.link_indicator with - | Directory -> Eio.Path.mkdir ~perm:file_mode path - | _ -> - Eio.Switch.run @@ fun sw -> - let dst = - Eio.Path.open_out ~sw ~append:false ~create:(`If_missing file_mode) - path + | Directory -> + ignore_if_already_exists (Eio.Path.mkdir ~perm:file_mode) path; + Tar.return (Ok ()) + | Symbolic -> + ignore_if_already_exists + (Eio.Path.symlink ~link_to:hdr.link_name) + path; + Tar.return (Ok ()) + | Normal -> + Eio.Path.with_open_out ~append:false ~create:(`If_missing file_mode) + path + @@ fun dst -> + Eio.Flow.copy src dst; + Tar.return (Ok ()) + | _ -> Tar.return (Ok ()) + in + (* Updating ownership, permission and times if root user *) + if Unix.getuid () = 0 then ( + Eio.Path.chown ~follow:true ~uid:(Int64.of_int hdr.user_id) + ~gid:(Int64.of_int hdr.group_id) + path; + if hdr.link_indicator <> Symbolic then + Eio.Path.chmod path ~follow:false ~perm:hdr.file_mode; + Eio_unix.run_in_systhread ~label:"utimes" (fun () -> + let access_time = + Option.value ~default:0. + @@ Option.bind hdr.extended (fun e -> + Option.map Int64.to_float e.access_time) in - Eio.Flow.copy src dst) - fd () + let mod_time = hdr.mod_time |> Int64.to_float in + if hdr.link_indicator <> Symbolic then + Unix.utimes (Eio.Path.native_exn path) access_time mod_time)); + Tar.return (Ok ()) + in + match Tar_eio.run (Tar_gz.in_gzipped (Tar.fold go ())) (File src) with + | Ok () -> () + | Error (`Eof | `Unexpected_end_of_file) -> + failwith "Unexpected end of file when untarring" + | Error (`Msg m) -> failwith m + | Error (`Fatal e) -> Fmt.failwith "%a" Tar.pp_error e + | Error (`Gz g) -> failwith g let checkout_layers ~sw ~cache ~dir layers = List.iteri diff --git a/src/dune b/src/dune index 8ed7a74..d05bcb0 100644 --- a/src/dune +++ b/src/dune @@ -5,10 +5,13 @@ container-image.spec progress cohttp-eio + eio.unix + ca-certs tls-eio astring optint - tar-eio.gz + tar-eio + tar.gz decompress.gz mirage-crypto-rng-eio osrelease))