Add more checkout logic

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.26.1
+version = 0.26.2
 profile = conventional
 break-infix = fit-or-vertical
 parse-docstrings = true

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

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"

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

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))