robur/opam-mirror
4
0
Fork 0
Code Issues 5 Pull requests 2 Projects Releases Packages Wiki Activity Actions

Merge pull request 'when creating the tarball, only include the packages folder, repo and version' (#30) from tar-include-only-packages-version-repo into main

Browse source 
Reviewed-on: #30
Reviewed-by: Reynir Björnsson <reynir@reynir.dk>
This commit is contained in:
Reynir Björnsson 2024-11-28 09:12:34 +00:00
commit ddb0f610e4
1 changed files with 26 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
mirage/unikernel.ml
View file

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