From 80f5511133fc36a8b12b7a0b3a1fed4095d04c9e Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Wed, 27 Nov 2024 19:36:48 +0100
Subject: [PATCH] when creating the tarball, only include the packages folder,
 repo and version

fixes #29
---
 mirage/unikernel.ml | 42 ++++++++++++++++++++++++++----------------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml
index 453c092..bcef75e 100644
--- a/mirage/unikernel.ml
+++ b/mirage/unikernel.ml
@@ -640,22 +640,32 @@ module Make
     let entries_of_git ~mtime store repo urls =
       let entries = Git.contents store in
       let to_entry path =
-        Store.get store path >|= function
-        | Ok data ->
-          let data =
-            if Mirage_kv.Key.(equal path (v "repo"))
-            then repo else data
-          in
-          let file_mode = 0o644
-          and mod_time = Int64.of_int mtime
-          and user_id = 0
-          and group_id = 0
-          and size = String.length data in
-          let hdr = Tar.Header.make ~file_mode ~mod_time ~user_id ~group_id
-              (Mirage_kv.Key.to_string path) (Int64.of_int size) in
-          urls := Git.find_urls !urls path data;
-          Some (Some Tar.Header.Ustar, hdr, once data)
-        | Error _ -> None in
+        match Mirage_kv.Key.segments path with
+        (* from opam source code, src/repository/opamHTTP.ml:
+           include only three top-level dirs/files: packages, version, repo *)
+        | "packages" :: _
+        | "version" :: _
+        | "repo" :: _ ->
+          begin
+            Store.get store path >|= function
+            | Ok data ->
+              let data =
+                if Mirage_kv.Key.(equal path (v "repo"))
+                then repo else data
+              in
+              let file_mode = 0o644
+              and mod_time = Int64.of_int mtime
+              and user_id = 0
+              and group_id = 0
+              and size = String.length data in
+              let hdr = Tar.Header.make ~file_mode ~mod_time ~user_id ~group_id
+                  (Mirage_kv.Key.to_string path) (Int64.of_int size) in
+              urls := Git.find_urls !urls path data;
+              Some (Some Tar.Header.Ustar, hdr, once data)
+            | Error _ -> None
+          end
+        | _ -> Lwt.return None
+      in
       let entries = Lwt_stream.filter_map_s to_entry entries in
       Lwt.return begin fun () -> Tar.High (High.inj (Lwt_stream.get entries >|= Result.ok)) end