further fixes (commit_id not in Lwt monad anymore)

minor fix, the commit_id is not in Lwt.t anymore
Merge pull request 'update to git-kv 0.1.1 -- use val commit :)' (#31 ) from git-kv-011 into main
2024-12-09 11:15:04 +01:00 · 2024-12-06 08:51:11 +01:00 · 2024-12-03 12:26:53 +00:00 · 2024-11-29 13:58:17 +01:00 · 2024-11-28 09:12:34 +00:00 · 2024-11-27 19:36:48 +01:00
9 changed files with 1216 additions and 1198 deletions
--- a/mirage/archive_checksum.ml
+++ b/mirage/archive_checksum.ml
@ -0,0 +1,67 @@
+module Hash = struct
+  type t = (* OpamHash.kind = *) [ `MD5 | `SHA256 | `SHA512 ]
+
+  (* Make the compiler check that (t :> Digestif.hash') *)
+  let _ = fun (h :t) -> (h :> Digestif.hash')
+
+  let compare h h' =
+    match h, h' with
+    | `SHA512, `SHA512 -> 0
+    | `SHA512, _ -> 1
+    | _, `SHA512 -> -1
+    | `SHA256, `SHA256 -> 0
+    | `SHA256, _ -> 1
+    | _, `SHA256 -> -1
+    | `MD5, `MD5 -> 0
+
+  let to_string = function
+    | `MD5 -> "md5"
+    | `SHA256 -> "sha256"
+    | `SHA512 -> "sha512"
+
+  let of_string = function
+    | "md5" -> Ok `MD5
+    | "sha256" -> Ok `SHA256
+    | "sha512" -> Ok `SHA512
+    | h -> Error (`Msg ("unknown hash algorithm: " ^ h))
+end
+
+module HM = Map.Make(Hash)
+
+type 'a digests = {
+  md5 : Digestif.MD5.ctx;
+  sha256 : Digestif.SHA256.ctx;
+  sha512 : Digestif.SHA512.ctx;
+}
+
+let empty_digests =
+  {
+    md5 = Digestif.MD5.empty;
+    sha256 = Digestif.SHA256.empty;
+    sha512 = Digestif.SHA512.empty;
+  }
+
+let update_digests { md5; sha256; sha512 } data =
+  {
+    md5 = Digestif.MD5.feed_string md5 data;
+    sha256 = Digestif.SHA256.feed_string sha256 data;
+    sha512 = Digestif.SHA512.feed_string sha512 data;
+  }
+
+let init_write csums =
+  let hash, csum = HM.max_binding csums in
+  (hash, csum), empty_digests
+
+let digests_to_hm digests =
+  HM.empty
+  |> HM.add `MD5
+    Digestif.MD5.(to_raw_string (get digests.md5))
+  |> HM.add `SHA256
+    Digestif.SHA256.(to_raw_string (get digests.sha256))
+  |> HM.add `SHA512
+    Digestif.SHA512.(to_raw_string (get digests.sha512))
+
+let get digests = function
+  | `MD5 -> Digestif.MD5.(to_raw_string (get digests.md5))
+  | `SHA256 -> Digestif.SHA256.(to_raw_string (get digests.sha256))
+  | `SHA512 -> Digestif.SHA512.(to_raw_string (get digests.sha512))
--- a/mirage/bad.ml
+++ b/mirage/bad.ml
@ -1,195 +0,0 @@
-let archives =
-  let too_big =
-    [ "https://github.com/Opsian/opsian-ocaml/releases/download/0.1/0.1.tar.gz" ]
-
-  and hash_mismatch = [
-    "http://cdn.skylable.com/source/libres3-1.3.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-0.3.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-1.2.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-0.9.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-0.2.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-1.0.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-1.1.tar.gz" ;
-    "http://cdn.skylable.com/source/libres3-0.1.tar.gz" ;
-    "https://github.com/lemaetech/http-cookie/releases/download/v3.0.0/http-cookie-v3.0.0.tbz" ;
-    "http://oqamldebug.forge.ocamlcore.org/oqamldebug-0.9.4.tar.gz" ;
-    "http://oqamldebug.forge.ocamlcore.org/oqamldebug-0.9.2.tar.gz" ;
-    "http://oqamldebug.forge.ocamlcore.org/oqamldebug-0.9.3.tar.gz" ;
-    "http://oqamldebug.forge.ocamlcore.org/oqamldebug-0.9.5.tar.gz" ;
-    "http://oqamldebug.forge.ocamlcore.org/oqamldebug-0.9.1.tar.gz" ;
-    "https://github.com/OCamlPro/ezjs_fetch/archive/0.1.tar.gz" ;
-    "http://github.com/OCamlPro/typerex-build/archive/1.99.13-beta.tar.gz" ;
-    "https://github.com/mirage/dyntype/tarball/dyntype-0.8.5" ;
-    "https://github.com/mirage/dyntype/tarball/dyntype-0.8.3" ;
-    "https://github.com/mirage/dyntype/tarball/dyntype-0.8.2" ;
-    "https://github.com/mirage/dyntype/tarball/dyntype-0.8.4" ;
-    "https://github.com/mirage/mirage-http-unix/archive/v1.0.0.tar.gz" ;
-    "http://github.com/OCamlPro/typerex-build/archive/1.99.15-beta.tar.gz" ;
-    "http://github.com/OCamlPro/typerex-build/archive/1.99.14-beta.tar.gz" ;
-    "https://github.com/paulpatault/ocamlog/archive/v0.1.tar.gz" ;
-    "https://github.com/pveber/OCaml-R/archive/pre-nyc-refactoring.tar.gz" ;
-    "https://github.com/paulpatault/ocamlog/archive/v0.2.tar.gz" ;
-    "http://github.com/OCamlPro/typerex-build/archive/1.99.16-beta.tar.gz" ;
-    "https://github.com/FStarLang/kremlin/archive/v0.9.6.0.zip" ;
-    "https://gitlab.com/dailambda/plebeia/-/archive/2.0.2/plebeia-2.0.2.tar.gz" ;
-    "https://github.com/mirleft/ocaml-tls/archive/0.5.0.tar.gz" ;
-    "https://github.com/eth-sri/ELINA/archive/1.3.tar.gz" ;
-    "https://gitlab.com/trustworthy-refactoring/refactorer/-/archive/0.1/refactorer-0.1.zip" ;
-    "https://github.com/completium/archetype-lang/archive/1.3.3.tar.gz" ;
-    "https://github.com/chetmurthy/pa_ppx/archive/0.01.tar.gz" ;
-    "https://github.com/chambart/ocaml-1/archive/lto.tar.gz" ;
-    "https://github.com/Kappa-Dev/KaSim/archive/v3.5-250915.tar.gz" ;
-    "https://github.com/bsansouci/bsb-native/archive/1.9.4.tar.gz";
-    "https://github.com/sanette/oplot/archive/0.7.tar.gz";
-    "https://github.com/ulrikstrid/ocaml-cookie/releases/download/0.1.8/session-cookie-lwt-0.1.8.tbz";
-  ]
-
-  and bad_request = [
-    "http://cgit.freedesktop.org/cairo-ocaml/snapshot/cairo-ocaml-1.2.0.tar.gz"
-  ]
-
-  and not_found = [
-    "http://pw374.github.io/distrib/frag/frag-0.1.0.tar.gz" ;
-    "http://pw374.github.io/distrib/glical/glical-0.0.3.tar.gz" ;
-    "http://pw374.github.io/distrib/glical/glical-0.0.4.tar.gz" ;
-    "http://pw374.github.io/distrib/glical/glical-0.0.1.tar.gz" ;
-    "http://pw374.github.io/distrib/glical/glical-0.0.2.tar.gz" ;
-    "http://pw374.github.io/distrib/glical/glical-0.0.5.tar.gz" ;
-    "http://pw374.github.io/distrib/glical/glical-0.0.7.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.1.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.0.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.2.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.7.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.3.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.8.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.4.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.1.5.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.2.0.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.2.1.tar.gz" ;
-    "http://pw374.github.io/distrib/mpp/mpp-0.3.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.3.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.4.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.5.4.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.5.5.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.5.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.6.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.6.2.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.6.3.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.6.4.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.6.5.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.7.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.7.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.7.2.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.7.4.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.7.3.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.7.5.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.8.2.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.8.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.8.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.7.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.0.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.0.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.1.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.1.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.1.2.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.0.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.2.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.4.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.5.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.6.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.2.3.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.3.0.tar.gz" ;
-    "http://zoggy.github.com/ocamldot/ocamldot-1.0.tar.gz" ;
-    "http://zoggy.github.io/stog/stog-0.4.tar.gz" ;
-    "http://zoggy.github.io/genet/genet-0.6.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.6.1.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.4.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.6.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.5.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-0.9.3.tar.gz" ;
-    "http://pw374.github.io/distrib/omd/omd-1.1.3.tar.gz" ;
-    "http://coccinelle.lip6.fr/distrib/coccinelle-1.0.0-rc22.tgz" ;
-    "http://coccinelle.lip6.fr/distrib/coccinelle-1.0.0-rc21.tgz" ;
-    "http://coccinelle.lip6.fr/distrib/coccinelle-1.0.0.tgz" ;
-    "http://proverif.inria.fr/proverif1.96pl1.tar.gz" ;
-    "http://proverif.inria.fr/proverif1.97.tar.gz" ;
-    "http://proverif.inria.fr/proverif1.98.tar.gz" ;
-    "http://proverif.inria.fr/proverif1.97pl3.tar.gz" ;
-    "http://proverif.inria.fr/proverif1.98pl1.tar.gz" ;
-    "http://proverif.inria.fr/proverif1.97pl1.tar.gz" ;
-    "https://github.com/jrochel/eliom/archive/6.4.0.tar.gz" ;
-    "https://github.com/drjdn/ocaml_lua_parser/archive/1.0.1.tar.gz" ;
-    "https://github.com/sagotch/To.ml/archive/v1.0.0.tar.gz" ;
-    "https://zoggy.github.io/ocaml-rdf/ocaml-rdf-0.9.0.tar.gz" ;
-    "https://github.com/sagotch/To.ml/archive/v2.1.0.tar.gz" ;
-    "https://github.com/sagotch/To.ml/archive/v2.0.0.tar.gz" ;
-    "https://zoggy.github.io/ocaml-taglog/taglog-0.1.0.tar.gz" ;
-    "https://zoggy.github.io/ocaml-taglog/taglog-0.2.0.tar.gz" ;
-    "https://zoggy.github.io/ocf/ocf-0.3.0.tar.gz" ;
-    "https://zoggy.github.io/ojs-base/ojs-base-0.1.0.tar.gz" ;
-    "https://zoggy.github.io/stog/plugins/stog-writing-0.8.0.tar.gz" ;
-    "https://zoggy.github.io/stog/stog-0.13.0.tar.gz" ;
-    "https://zoggy.github.io/ocaml-taglog/taglog-0.3.0.tar.gz" ;
-    "https://zoggy.github.io/ocf/ocf-0.1.0.tar.gz" ;
-    "https://opam.ocaml.org/cache/md5/24/24b163eb77e6832747dccd6cc8a5d57c" ;
-  ]
-
-  and forbidden = [
-    "https://gforge.inria.fr/frs/download.php/33440/heptagon-1.00.06.tar.gz" ;
-    "https://gforge.inria.fr/frs/download.php/file/33677/dose3-3.2.2.tar.gz" ;
-    "https://gforge.inria.fr/frs/download.php/file/34920/javalib-2.3.1.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/36092/javalib-2.3.2.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/36093/sawja-1.5.2.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/37154/javalib-2.3.4.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/37403/sawja-1.5.3.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/36307/javalib-2.3.3.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/37655/javalib-2.3.5.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/37656/sawja-1.5.4.tar.bz2" ;
-    "https://gforge.inria.fr/frs/download.php/file/34921/sawja-1.5.1.tar.bz2" ;
-  ]
-
-  and three_o_o = [
-    "https://github.com/Gbury/dolmen/archive/v0.4.tar.gz" ;
-    "https://github.com/Stevendeo/Pilat/archive/1.3.tar.gz" ;
-    "https://github.com/OCamlPro/ocp-indent/archive/1.5.tar.gz" ;
-    "https://github.com/backtracking/combine/archive/release-0.6.zip" ;
-    "https://github.com/cakeplus/pa_comprehension/archive/0.4.tar.gz" ;
-    "https://github.com/cakeplus/mparser/archive/1.0.tar.gz" ;
-    "https://github.com/chenyukang/rubytt/archive/v0.1.tar.gz" ;
-    "https://github.com/cakeplus/pa_where/archive/0.4.tar.gz" ;
-    "https://github.com/metaocaml/ber-metaocaml/archive/ber-n102.tar.gz" ;
-    "https://github.com/cakeplus/pa_solution/archive/0.5.tar.gz" ;
-    "https://github.com/cakeplus/mparser/archive/1.2.1.tar.gz" ;
-    "https://github.com/cakeplus/pa_solution/archive/0.7.tar.gz" ;
-    "https://github.com/cakeplus/pa_solution/archive/0.6.tar.gz" ;
-    "https://github.com/mirage/mirage-tcpip/archive/v2.8.1.tar.gz" ;
-    "https://github.com/modlfo/pla/archive/v1.4.tar.gz" ;
-    "https://github.com/murmour/pa_qualified/archive/0.5.tar.gz" ;
-    "https://github.com/ocaml-ppx/ocamlformat/archive/v0.2.tar.gz" ;
-    "https://github.com/murmour/pa_qualified/archive/0.6.tar.gz" ;
-    "https://github.com/ocaml-ppx/ocamlformat/archive/support.0.2.tar.gz" ;
-    "https://github.com/ocaml/oloop/archive/0.1.2.tar.gz" ;
-    "https://github.com/cakeplus/mparser/archive/1.0.1.tar.gz" ;
-    "https://github.com/cakeplus/mparser/archive/1.1.tar.gz" ;
-    "https://github.com/savonet/ocaml-ffmpeg/archive/v1.0.0-rc1.tar.gz" ;
-    "https://github.com/ocaml/opam2web/archive/2.0.tar.gz" ;
-    "https://github.com/savonet/ocaml-ffmpeg/archive/v1.0.0.tar.gz" ;
-  ]
-
-  and five_o_three = [ "https://gitlab.com/gasche/build_path_prefix_map/repository/0.2/archive.tar.gz" ]
-
-  and is_ftp = [ "ftp://ftp.netbsd.org/pub/pkgsrc/distfiles/wyrd-1.4.6.tar.gz" ]
-
-  and connect_fails = [
-    "http://godi.0ok.org/godi-backup/shcaml-0.1.3.tar.gz" ;
-    "http://www.first.in-berlin.de/software/tools/apalogretrieve/apalogretrieve-0-9-6_4.tgz" ;
-    "https://cavale.enseeiht.fr/osdp/osdp-0.5.4.tgz" ;
-    "https://cavale.enseeiht.fr/osdp/osdp-0.6.0.tgz" ;
-    "https://cavale.enseeiht.fr/osdp/osdp-1.0.0.tgz" ;
-  ]
-  in
-
-  too_big @ hash_mismatch @ bad_request @ not_found @ forbidden @ three_o_o @ five_o_three @ is_ftp @ connect_fails
--- a/mirage/config.ml
+++ b/mirage/config.ml
@ -1,111 +1,40 @@
+(* mirage >= 4.8.0 & < 4.9.0 *)
 open Mirage

-let check =
-  let doc =
-    Key.Arg.info ~doc:"Only check the cache" ["check"]
-  in
-  Key.(create "check" Arg.(flag doc))
-
-let verify_sha256 =
-  let doc =
-    Key.Arg.info ~doc:"Verify the SHA256 checksums of the cache contents, and \
-                       re-build the other checksum caches."
-      ["verify-sha256"]
-  in
-  Key.(create "verify-sha256" Arg.(flag doc))
-
-let remote =
-  let doc =
-    Key.Arg.info
-      ~doc:"Remote repository url, use suffix #foo to specify a branch 'foo': \
-            https://github.com/ocaml/opam-repository.git"
-      ["remote"]
-  in
-  Key.(create "remote" Arg.(opt string "https://github.com/ocaml/opam-repository.git#master" doc))
-
-let parallel_downloads =
-  let doc =
-    Key.Arg.info
-      ~doc:"Amount of parallel HTTP downloads"
-      ["parallel-downloads"]
-  in
-  Key.(create "parallel-downloads" Arg.(opt int 20 doc))
-
-let hook_url =
-  let doc =
-    Key.Arg.info
-      ~doc:"URL to conduct an update of the git repository" ["hook-url"]
-  in
-  Key.(create "hook-url" Arg.(opt string "update" doc))
-
-let port =
-  let doc = Key.Arg.info ~doc:"HTTP listen port." ["port"] in
-  Key.(create "port" Arg.(opt int 80 doc))
-
-let tls_authenticator =
-  (* this will not look the same in the help printout *)
-  let doc = "TLS host authenticator. See git_http in lib/mirage/mirage.mli for a description of the format."
-  in
-  let doc = Key.Arg.info ~doc ["tls-authenticator"] in
-  Key.(create "tls-authenticator" Arg.(opt (some string) None doc))
-
-let sectors_cache =
-  let doc = "Number of sectors reserved for each checksum cache (md5, sha512)." in
-  let doc = Key.Arg.info ~doc ["sectors-cache"] in
-  Key.(create "sectors-cache" Arg.(opt int64 Int64.(mul 4L 2048L) doc))
-
-let sectors_git =
-  let doc = "Number of sectors reserved for git dump." in
-  let doc = Key.Arg.info ~doc ["sectors-git"] in
-  Key.(create "sectors-git" Arg.(opt int64 Int64.(mul 40L (mul 2L 1024L)) doc))
-
-let ignore_local_git =
-  let doc = "Ignore restoring locally saved git repository." in
-  let doc = Key.Arg.info ~doc ["ignore-local-git"] in
-  Key.(create "ignore-local-git" Arg.(flag doc))
-
 let mirror =
-  foreign "Unikernel.Make"
-    ~keys:[ Key.v check ; Key.v verify_sha256 ; Key.v remote ;
-            Key.v parallel_downloads ; Key.v hook_url ; Key.v tls_authenticator ;
-            Key.v port ; Key.v sectors_cache ; Key.v sectors_git ;
-            Key.v ignore_local_git ;
-          ]
+  main "Unikernel.Make"
    ~packages:[
      package ~min:"0.3.0" ~sublibs:[ "mirage" ] "paf" ;
      package "h2" ;
-      package "hex" ;
+      package "ohex" ;
      package "httpaf" ;
-      package "git-kv" ;
+      package ~min:"0.1.1" "git-kv" ;
      package ~min:"3.10.0" "git-paf" ;
      package "opam-file-format" ;
-      package ~min:"2.2.0" ~sublibs:[ "gz" ] "tar" ;
-      package ~min:"2.2.0" "tar-mirage" ;
+      package ~min:"3.0.0" ~sublibs:[ "gz" ] "tar" ;
+      package ~min:"3.0.0" "tar-mirage" ;
      package ~max:"0.2.0" "mirage-block-partition" ;
+      package ~min:"0.0.8" "http-mirage-client" ;
      package "gpt" ;
-      package "gptar" ~pin:"git+https://github.com/reynir/gptar.git" ;
+      package "gptar" ;
      package "oneffs" ;
+      package "digestif" ;
+      package "swapfs" ;
    ]
    (block @-> time @-> pclock @-> stackv4v6 @-> git_client @-> alpn_client @-> job)

 let stack = generic_stackv4v6 default_network
-
-let dns = generic_dns_client stack
-
+let he = generic_happy_eyeballs stack
+let dns = generic_dns_client stack he
 let tcp = tcpv4v6_of_stackv4v6 stack
-
-let git_client, alpn_client =
-  let happy_eyeballs = generic_happy_eyeballs stack dns in
-  let git = mimic_happy_eyeballs stack dns happy_eyeballs in
-  merge_git_clients (git_tcp tcp git)
-    (git_http ~authenticator:tls_authenticator tcp git),
-  paf_client ~pclock:default_posix_clock tcp (mimic_happy_eyeballs stack dns happy_eyeballs)
-
-let program_block_size =
-  let doc = Key.Arg.info [ "program-block-size" ] in
-  Key.(create "program_block_size" Arg.(opt int 16 doc))
-
 let block = block_of_file "tar"

+let git_client, alpn_client =
+  let git = mimic_happy_eyeballs stack he dns in
+  merge_git_clients (git_ssh tcp git)
+    (merge_git_clients (git_tcp tcp git)
+      (git_http tcp git)),
+  paf_client tcp (mimic_happy_eyeballs stack he dns)
+
 let () = register "mirror"
-    [ mirror $ block $ default_time $ default_posix_clock $ stack $ git_client $ alpn_client ]
+  [ mirror $ block $ default_time $ default_posix_clock $ stack $ git_client $ alpn_client ]
--- a/mirage/opam_file.ml
+++ b/mirage/opam_file.ml
@ -0,0 +1,144 @@
+module HM = Archive_checksum.HM
+
+let hash_to_string = Archive_checksum.Hash.to_string
+
+let hex_of_string s =
+  match Ohex.decode s with
+  | d -> Ok d
+  | exception Invalid_argument err -> Error (`Msg err)
+
+let decode_digest filename str =
+  let hex h s =
+    match hex_of_string s with
+    | Ok d -> Ok (h, d)
+    | Error _ as e -> e
+  in
+  match String.split_on_char '=' str with
+  | [ data ] -> hex `MD5 data
+  | [ "md5" ; data ] -> hex `MD5 data
+  | [ "sha256" ; data ] -> hex `SHA256 data
+  | [ "sha512" ; data ] -> hex `SHA512 data
+  | [ hash ; _ ] -> Error (`Msg ("unknown hash " ^ hash))
+  | _ -> Error (`Msg ("unexpected hash format " ^ str))
+
+let extract_url_checksum filename items =
+  let open OpamParserTypes.FullPos in
+  let url =
+    List.find_opt
+      (function { pelem = Variable ({ pelem = "src" ; _ }, _); _ } -> true | _ -> false)
+      items
+  and archive =
+    List.find_opt
+      (function { pelem = Variable ({ pelem = "archive" ; _ }, _); _ } -> true | _ -> false)
+      items
+  and checksum =
+    List.find_opt
+      (function { pelem = Variable ({ pelem = "checksum" ; _ }, _); _ } -> true | _ -> false)
+      items
+  and mirrors =
+    List.find_opt
+      (function { pelem = Variable ({ pelem = "mirrors" ; _ }, _); _ } -> true | _ -> false)
+      items
+  in
+  let url =
+    match url, archive with
+    | Some { pelem = Variable (_, { pelem = String url ; _ }) ; _ }, None -> Ok url
+    | None, Some { pelem = Variable (_, { pelem = String url ; _ }); _ } -> Ok url
+    | _ -> Error (`Msg "neither 'src' nor 'archive' present")
+  and mirrors = match mirrors with
+    | None -> []
+    | Some { pelem = Variable (_, { pelem = String url ; _ }) ; _ } -> [ url ]
+    | Some { pelem = Variable (_, { pelem = List { pelem = urls ; _ } ; _ }) } ->
+      List.fold_left (fun acc -> function
+          | { pelem = String url ; _ } -> url :: acc
+          | v ->
+            Logs.err (fun m -> m "bad mirror data (expected a string in the list): %s"
+                         (OpamPrinter.FullPos.value v));
+            acc)
+        [] urls
+    | Some v ->
+      Logs.err (fun m -> m "bad mirror data (expected string or string list): %s"
+                   (OpamPrinter.FullPos.items [ v ]));
+      []
+  in
+  let csum, csum_errs =
+    match checksum with
+    | Some { pelem = Variable (_, { pelem = List { pelem = csums ; _ } ; _ }); _ } ->
+      let csums, errs =
+        List.fold_left (fun (csums, errs) ->
+            function
+            | { pelem = String csum ; _ } ->
+              begin match decode_digest filename csum with
+                | Error e -> csums, e :: errs
+                | Ok (h, v) ->
+                  HM.update h (function
+                      | None -> Some v
+                      | Some v' when String.equal v v' -> None
+                      | Some v' ->
+                        Logs.warn (fun m -> m "for %s, hash %s, multiple keys are present: %s %s"
+                                      (Result.value ~default:"NONE" url) (hash_to_string h) (Ohex.encode v) (Ohex.encode v'));
+                        None)
+                    csums, errs
+              end
+            | v ->
+              csums, `Msg (Fmt.str "bad checksum data: %s" (OpamPrinter.FullPos.value v)) :: errs)
+          (HM.empty, []) csums
+      in
+      if HM.is_empty csums then
+        match errs with
+        | hd :: tl -> Error hd, tl
+        | [] -> Error (`Msg "empty checksums"), []
+      else
+        Ok csums, errs
+    | Some { pelem = Variable (_, { pelem = String csum ; _ }) ; _ } ->
+      begin match decode_digest filename csum with
+        | Error _ as e -> e, []
+        | Ok (h, v) -> Ok (HM.singleton h v), []
+      end
+    | _ -> Error (`Msg "couldn't find or decode 'checksum'"), []
+  in
+  (match url, csum with
+   | Ok url, Ok csum -> Ok (url, csum, mirrors)
+   | Error _ as e, _
+   | _, (Error _ as e) -> e), csum_errs
+
+let extract_checksums_and_urls filename opam =
+  let open OpamParserTypes.FullPos in
+  List.fold_left (fun (csum_urls, errs) ->
+      function
+      | { pelem = Section ({ section_kind = { pelem = "url" ; _ } ; section_items = { pelem = items ; _ } ; _ }) ; _} ->
+        begin match extract_url_checksum filename items with
+          | Error `Msg msg, errs' -> csum_urls, `Msg ("url: " ^ msg) :: errs' @ errs
+          | Ok url, errs' -> url :: csum_urls, errs' @ errs
+        end
+      | { pelem = Section ({ section_kind = { pelem = "extra-source" ; _ } ; section_name = Some { pelem ; _ } ;  section_items = { pelem = items ; _ };  _ }) ; _} ->
+        begin
+          match extract_url_checksum filename items with
+          | Error `Msg msg, errs' -> csum_urls, `Msg ("extra-source " ^ pelem ^ " " ^ msg) :: errs' @ errs
+          | Ok url, errs' -> url :: csum_urls, errs' @ errs
+        end
+      | _ -> csum_urls, errs)
+    ([], []) opam.file_contents
+
+let extract_urls filename str =
+  (* in an opam file, there may be:
+     url { src: <string> checksum: [ STRING ] } <- list of hash
+     url { src: <string> checksum: STRING } <- single hash
+     url { archive: <string> checksum: STRING } <- MD5
+     extra-source NAME { src: URL checksum: [ STRING ] } (OR checksum: STRING) <- multiple occurences possible
+  *)
+  let open OpamParserTypes.FullPos in
+  let opamfile = OpamParser.FullPos.string str filename in
+  let unavailable =
+    List.exists
+      (function
+        | { pelem = Variable ({ pelem = "available" ; _ },
+                              { pelem = (Bool false | List { pelem = [{ pelem = Bool false; _ }] ; _ }); _ })
+          ; _ } -> true
+        | _ -> false)
+      opamfile.file_contents
+  in
+  if unavailable then
+     [], []
+  else
+    extract_checksums_and_urls filename opamfile
--- a/mirage/partitions.ml
+++ b/mirage/partitions.ml
@ -0,0 +1,222 @@
+open Lwt.Syntax
+
+module Make(BLOCK : Mirage_block.S) = struct
+  module Part = Mirage_block_partition.Make(BLOCK)
+
+  include Part
+
+  type partitions = {
+    tar : Part.t ;
+    swap : Part.t ;
+    git_dump : Part.t ;
+    md5s : Part.t ;
+    sha512s : Part.t ;
+  }
+
+  (* I just made these ones up... *)
+  let swap_guid = Uuidm.of_string "76515dc1-953f-4c59-8b41-90011bdddfcd" |> Option.get
+  let tar_guid = Uuidm.of_string "53cd6812-46cc-474e-a141-30b3aed85f53" |> Option.get
+  let cache_guid = Uuidm.of_string "22ab9cf5-6e51-45c2-998a-862e23aab264" |> Option.get
+  let git_guid = Uuidm.of_string "30faa50a-4c9d-47ff-a1a5-ecfb3401c027" |> Option.get
+
+  (* GPT uses a 72 byte utf16be encoded string for partition names *)
+  let utf16be_of_ascii s =
+    String.init 72
+      (fun i ->
+         if i mod 2 = 0 && i / 2 < String.length s then
+           s.[i/2]
+         else
+           '\000')
+
+  let read_partition_table info block =
+    let b = Cstruct.create info.Mirage_block.sector_size in
+    (* We will ignore the protective MBR at lba [0L] *)
+    let* r = BLOCK.read block 1L [b] in
+    match r with
+    | Error e ->
+      Format.kasprintf failwith "Reading partition table: %a"
+        BLOCK.pp_error e
+    | Ok () ->
+      match Gpt.unmarshal b ~sector_size:info.Mirage_block.sector_size with
+      | Error e ->
+        Format.kasprintf failwith "Reading partition table: %s" e
+      | Ok (`Read_partition_table (lba, sectors), k) ->
+        let b = Cstruct.create (sectors * info.Mirage_block.sector_size) in
+        let* r = BLOCK.read block lba [b] in
+        match r with
+        | Error e ->
+          Format.kasprintf failwith "Reading partition table: %a"
+            BLOCK.pp_error e
+        | Ok () ->
+          match k b with
+          | Error e ->
+            Format.kasprintf failwith "Reading partition table: %s" e
+          | Ok gpt -> Lwt.return gpt
+
+  let connect block =
+    let* info = BLOCK.get_info block in
+    let* gpt = read_partition_table info block in
+    let tar, swap, git_dump, md5s, sha512s =
+      match
+        List.fold_left
+          (fun (tar, swap, git_dump, md5s, sha512s) p ->
+             if String.equal p.Gpt.Partition.name
+                 (utf16be_of_ascii "tar")
+             then
+               (Some p, swap, git_dump, md5s, sha512s)
+             else if String.equal p.name
+                 (utf16be_of_ascii "git_dump")
+             then
+               (tar, swap, Some p, md5s, sha512s)
+             else if String.equal p.name
+                 (utf16be_of_ascii "md5s")
+             then
+               (tar, swap, git_dump, Some p, sha512s)
+             else if String.equal p.name
+                 (utf16be_of_ascii "sha512s")
+             then
+               (tar, swap, git_dump, md5s, Some p)
+             else if String.equal p.name
+                 (utf16be_of_ascii "swap")
+             then
+               (tar, Some p, git_dump, md5s, sha512s)
+             else
+               Format.kasprintf failwith "Unknown partition %S" p.name)
+          (None, None, None, None, None)
+          gpt.partitions
+      with
+      | (Some tar, Some swap, Some git_dump, Some md5s, Some sha512s) ->
+        (tar, swap, git_dump, md5s, sha512s)
+      | _ ->
+        failwith "not all partitions found :("
+    in
+    let+ (_empty, p) = Part.connect 0L block in
+    let get_part part =
+      let len = Int64.(succ (sub part.Gpt.Partition.ending_lba part.starting_lba)) in
+      let (_before, after) = Part.subpartition part.starting_lba p in
+      let (part, _after) = Part.subpartition len after in
+      part
+    in
+    let tar = get_part tar and swap = get_part swap and git_dump = get_part git_dump
+    and md5s = get_part md5s and sha512s = get_part sha512s in
+    { tar ; swap; git_dump ; md5s ; sha512s }
+
+  let format block ~cache_size ~git_size ~swap_size =
+    let* { size_sectors; sector_size; _ } = BLOCK.get_info block in
+    let ( let*? ) = Lwt_result.bind in
+    (* ocaml-gpt uses a fixed size partition entries table. Create an empty GPT
+       to figure out the first usable LBA *)
+    let empty =
+      Gpt.make ~sector_size ~disk_sectors:size_sectors []
+      |> Result.get_ok
+    in
+    let mb_in_sectors mb =
+      (* 1 megabyte is 2^20 bytes (1024 * 1024) *)
+      let mb_in_bytes = Int64.(shift_left (of_int mb) 20) in
+      let ss = Int64.of_int sector_size in
+      Int64.(div (add mb_in_bytes (sub ss 1L)) ss)
+    in
+    let sectors_cache = mb_in_sectors cache_size
+    and sectors_git = mb_in_sectors git_size
+    and sectors_swap = mb_in_sectors swap_size
+    in
+    let*? () =
+      if size_sectors <
+         (* protective MBR + GPT header + GPT table *)
+         let ( + ) = Int64.add in
+         empty.first_usable_lba +
+         min 1L (Int64.of_int (2 * Tar.Header.length / sector_size)) + sectors_cache + sectors_cache + sectors_git
+         + 1L (* backup GPT header *) then
+        Lwt.return_error (`Msg "too small disk")
+      else Lwt_result.return ()
+    in
+    (* Current implementation of [Gpt.Partition.make] only returns [Ok _] or
+       raises [Invalid_argument _] :/ *)
+    let attributes = 1L in
+    let sha512s =
+      Gpt.Partition.make
+        ~name:(utf16be_of_ascii "sha512s")
+        ~type_guid:cache_guid
+        ~attributes
+        Int64.(succ (sub empty.last_usable_lba sectors_cache))
+        empty.last_usable_lba
+      |> Result.get_ok
+    in
+    let md5s =
+      Gpt.Partition.make
+        ~name:(utf16be_of_ascii "md5s")
+        ~type_guid:cache_guid
+        ~attributes
+        (Int64.sub sha512s.starting_lba sectors_cache)
+        (Int64.pred sha512s.starting_lba)
+      |> Result.get_ok
+    in
+    let git_dump =
+      Gpt.Partition.make
+        ~name:(utf16be_of_ascii "git_dump")
+        ~type_guid:git_guid
+        ~attributes
+        (Int64.sub md5s.starting_lba sectors_git)
+        (Int64.pred md5s.starting_lba)
+      |> Result.get_ok
+    in
+    let swap =
+      Gpt.Partition.make
+        ~name:(utf16be_of_ascii "swap")
+        ~type_guid:swap_guid
+        ~attributes
+        (Int64.sub git_dump.starting_lba sectors_swap)
+        (Int64.pred git_dump.starting_lba)
+      |> Result.get_ok
+    in
+    let tar =
+      Gpt.Partition.make
+        ~name:(utf16be_of_ascii "tar")
+        ~type_guid:tar_guid
+        ~attributes
+        empty.first_usable_lba
+        (Int64.pred swap.starting_lba)
+      |> Result.get_ok
+    in
+    let gpt =
+      let partitions =
+        [ tar; swap; git_dump; md5s; sha512s ]
+      in
+      Gpt.make ~sector_size ~disk_sectors:size_sectors partitions
+      |> Result.get_ok
+    in
+    let buf =
+      Cstruct.create (sector_size * (Int64.to_int gpt.first_usable_lba + 2 * Tar.Header.length))
+    in
+    Gptar.marshal_header ~sector_size buf gpt;
+    Gpt.marshal_partition_table ~sector_size
+      (Cstruct.shift buf (sector_size * Int64.to_int gpt.partition_entry_lba))
+    gpt;
+    let write block sector_start buffers =
+      BLOCK.write block sector_start buffers
+      |> Lwt_result.map_error (fun e -> `Block e)
+    in
+    let*? () =
+      write block 0L [ buf ]
+    in
+    (* Format the file systems by writing zeroes *)
+    (* For tar we need to zero (at least) the first 2*512 bytes so we round up
+       to the nearest sector alignment *)
+    let zeroes =
+      let sectors =
+        (2 * Tar.Header.length + sector_size - 1) / sector_size * sector_size
+      in
+      Cstruct.create sectors in
+    let*? () =
+      write block tar.starting_lba [ zeroes ]
+    in
+    (* For the OneFFS filesystems we just need to zero out the first sector *)
+    let zero_sector = Cstruct.create sector_size in
+    let*? () =
+      write block git_dump.starting_lba [ zero_sector ]
+    in
+    let*? () =
+      write block md5s.starting_lba [ zero_sector ]
+    in
+    write block sha512s.starting_lba [ zero_sector ]
+end
--- a/mirage/unikernel.ml
+++ b/mirage/unikernel.ml
--- a/mkimg/bin/dune
+++ b/mkimg/bin/dune
@ -1,3 +0,0 @@
-(executable
- (name mkimg)
- (libraries unix cstruct gptar gpt uuidm cmdliner))
--- a/mkimg/bin/mkimg.ml
+++ b/mkimg/bin/mkimg.ml
@ -1,148 +0,0 @@
-(* I just made these ones up... *)
-let tar_guid = Uuidm.of_string "53cd6812-46cc-474e-a141-30b3aed85f53" |> Option.get
-let cache_guid = Uuidm.of_string "22ab9cf5-6e51-45c2-998a-862e23aab264" |> Option.get
-let git_guid = Uuidm.of_string "30faa50a-4c9d-47ff-a1a5-ecfb3401c027" |> Option.get
-
-(* GPT uses a 72 byte utf16be encoded string for partition names *)
-let gptutf16be_of_ascii s =
-  String.init 72
-    (fun i ->
-       if i mod 2 = 0 && i / 2 < String.length s then
-         s.[i/2]
-       else
-         '\000')
-
-let jump dest sector_size size_sectors sectors_cache sectors_git =
-  let ( let* ) = Result.bind in
-  let* () =
-    if sector_size < 0 then Error "negative sector size"
-    else if size_sectors < 0L then Error "negative size"
-    else if sectors_cache < 0L then Error "negative cache size"
-    else if sectors_git < 0L then Error "negative git dump size"
-    else Ok ()
-  in
-  let* () =
-    if sector_size >= 512 && sector_size land (pred sector_size) == 0 then
-      Ok ()
-    else Error "sector size must be a power of two greater than or equal 512"
-  in
-  (* ocaml-gpt uses a fixed size partition entries table. Create an empty GPT
-     to figure out the first usable LBA *)
-  let empty =
-    Gpt.make ~sector_size ~disk_sectors:size_sectors []
-    |> Result.get_ok
-  in
-  let* () =
-    let ( + ) = Int64.add in
-    if size_sectors <
-       (* protective MBR + GPT header + GPT table *)
-       empty.first_usable_lba +
-       min 1L (Int64.of_int (2 * Tar.Header.length / sector_size)) + sectors_cache + sectors_cache + sectors_git
-       + 1L (* backup GPT header *) then
-      Error "too small size"
-    else Ok ()
-  in
-  (* TODO: handle exceptions *)
-  let fd = Unix.openfile dest Unix.[ O_WRONLY; O_CREAT ] 0o664 in
-  Unix.ftruncate fd (sector_size * Int64.to_int size_sectors);
-  let gpt =
-    let partitions =
-      (* Current implementation of [Gpt.Partition.make] only returns [Ok _] or
-         raises [Invalid_argument _] :/ *)
-      let attributes = 1L in
-      let sha512s =
-        Gpt.Partition.make
-          ~name:(gptutf16be_of_ascii "sha512s")
-          ~type_guid:cache_guid
-          ~attributes
-          Int64.(succ (sub empty.last_usable_lba sectors_cache))
-          empty.last_usable_lba
-        |> Result.get_ok
-      in
-      let md5s =
-        Gpt.Partition.make
-          ~name:(gptutf16be_of_ascii "md5s")
-          ~type_guid:cache_guid
-          ~attributes
-          (Int64.sub sha512s.starting_lba sectors_cache)
-          (Int64.pred sha512s.starting_lba)
-        |> Result.get_ok
-      in
-      let git_dump =
-        Gpt.Partition.make
-          ~name:(gptutf16be_of_ascii "git_dump")
-          ~type_guid:git_guid
-          ~attributes
-          (Int64.sub md5s.starting_lba sectors_git)
-          (Int64.pred md5s.starting_lba)
-        |> Result.get_ok
-      in
-      let tar =
-        Gpt.Partition.make
-          ~name:(gptutf16be_of_ascii "tar")
-          ~type_guid:tar_guid
-          ~attributes
-          empty.first_usable_lba
-          (Int64.pred git_dump.starting_lba)
-        |> Result.get_ok
-      in
-      [ tar; git_dump; md5s; sha512s ]
-    in
-    Gpt.make ~sector_size ~disk_sectors:size_sectors partitions
-    |> Result.get_ok
-  in
-  let buf =
-    Cstruct.create (sector_size * (Int64.to_int gpt.first_usable_lba + 2 * Tar.Header.length))
-  in
-  Gptar.marshal_header ~sector_size buf gpt;
-  Gpt.marshal_partition_table ~sector_size
-    (Cstruct.shift buf (sector_size * Int64.to_int gpt.partition_entry_lba))
-    gpt;
-  let s = Cstruct.to_string buf in
-  ignore (Unix.write_substring fd s 0 (String.length s));
-  ignore (Unix.lseek fd (Int64.to_int gpt.backup_lba * sector_size) Unix.SEEK_SET);
-  (* Let's reuse the buffer *)
-  let buf = Cstruct.sub buf 0 sector_size in
-  Cstruct.memset buf 0;
-  Gpt.marshal_header ~sector_size ~primary:false buf gpt;
-  let s = Cstruct.to_string buf in
-  ignore (Unix.write_substring fd s 0 (String.length s));
-  Unix.close fd;
-  Ok ()
-
-open Cmdliner
-
-let dest =
-  Arg.(required & pos 0 (some string) None &
-       info ~docv:"DEST" [])
-
-let sector_size =
-  let doc = "Sector size or block size to use" in
-  (* TODO: should be a power of two >= 512 *)
-  Arg.(value & opt int 512 &
-       info ~doc ~docv:"SECTOR-SIZE" ["sector-size"])
-
-let size_sectors =
-  let doc = "Size of disk image in terms of sectors" in
-  Arg.(value & opt int64 (Int64.mul 1024L 2048L) &
-       info ~doc ~docv:"SIZE-SECTORS" ["size-sectors"])
-
-let sectors_cache =
-  let doc = "Number of sectors reserved for each checksum cache (md5, sha512)." in
-  Arg.(value & opt int64 (Int64.mul 4L 2048L) &
-       info ~doc ~docv:"SECTORS-CACHE" ["sectors-cache"])
-
-let sectors_git =
-  let doc = "Number of sectors reserved for git dump." in
-  Arg.(value & opt int64 (Int64.mul 40L 2048L) &
-       info ~doc ~docv:"SECTORS-GIT" ["sectors-git"])
-
-let command =
-  let info =
-    Cmd.info "mkimg"
-  in
-  Cmd.v info
-    Term.(const jump $ dest $ sector_size $ size_sectors $ sectors_cache $ sectors_git)
-
-let () =
-  exit (Cmdliner.Cmd.eval_result command)
--- a/mkimg/dune-project
+++ b/mkimg/dune-project
@ -1,2 +0,0 @@
-(lang dune 3.14)
-(name mkimg)
Author	SHA1	Message	Date
Hannes Mehnert	ccf1871604	further fixes (commit_id not in Lwt monad anymore)	2024-12-09 11:15:04 +01:00
Hannes Mehnert	df53182114	minor fix, the commit_id is not in Lwt.t anymore	2024-12-06 08:51:11 +01:00
Reynir Björnsson	bbd09258d0	Merge pull request 'update to git-kv 0.1.1 -- use val commit :)' (#31 ) from git-kv-011 into main Reviewed-on: #31 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-12-03 12:26:53 +00:00
Hannes Mehnert	16dd833477	update to git-kv 0.1.1 -- use val commit :)	2024-11-29 13:58:17 +01:00
Reynir Björnsson	ddb0f610e4	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 Reviewed-on: #30 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-11-28 09:12:34 +00:00
Hannes Mehnert	80f5511133	when creating the tarball, only include the packages folder, repo and version fixes #29	2024-11-27 19:36:48 +01:00
Reynir Björnsson	6447339f64	Merge pull request 'add some Lwt.pause during Disk.check to allow the web server to process requests' (#26 ) from add-pause-during-check into main Reviewed-on: #26 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-11-21 11:31:04 +00:00
Reynir Björnsson	2c606dbeb4	Merge pull request 'specify sizes of partitions in MB, not in sectors' (#27 ) from specify-in-mb into main Reviewed-on: #27 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-11-21 11:27:40 +00:00
Hannes Mehnert	c5e091a294	specify sizes of partitions in MB, not in sectors	2024-11-21 12:11:48 +01:00
Hannes Mehnert	c57b070d87	add some Lwt.pause during Disk.check to allow the web server to process requests	2024-11-20 12:42:06 +01:00
Hannes Mehnert	2edc311a33	Merge pull request 'revise startup, address urls pointing to same sha256 and support mirrors (upstream and in opam file)' (#24 ) from startup into main Reviewed-on: #24	2024-11-20 10:38:21 +00:00
Reynir Björnsson	a9c249ea86	Use Map.fold over List.fold_left ... (Map.bindings _)	2024-11-19 16:26:02 +01:00
Reynir Björnsson	ec45a6a77a	Prioritize mirrors over upstream caches Also expand on the semantics of --upstream-cache.	2024-11-19 16:04:08 +01:00
Hannes Mehnert	62d62420b7	remove some logs	2024-11-14 19:39:38 +01:00
Hannes Mehnert	da4533c2d3	uniquify urls in respect to sha256 checksums (#21 ) this reduces 19139 urls down to 18563 urls	2024-11-14 19:25:14 +01:00
Hannes Mehnert	6a0ae2bcab	take mirrors into account (#13 ) and allow upstream-caches (#5 ) This is done by introducing a set of alternative download locations.	2024-11-14 17:40:22 +01:00
Hannes Mehnert	c376a4b70e	checked: do on file-by-file basis, incrementally	2024-11-14 16:58:20 +01:00
Hannes Mehnert	4481923ade	revise startup (as proposed in #18 ): - recover git (from disk or download) - make index.tar.gz - start web service - check disk (unless skip-verify-sha256) - dump git state - start downloads - enable update job, and hook	2024-11-14 16:36:10 +01:00
Hannes Mehnert	7e09f08767	print git last modified as well as HTTP date	2024-11-14 16:35:56 +01:00
Hannes Mehnert	6dab71a9ac	introduce more data on status page: - remaining downloads - identified urls - last git fetch & fetch status see #22	2024-11-14 15:50:26 +01:00
Hannes Mehnert	e51550aedc	if there's a http error, return the error	2024-11-13 20:03:51 +01:00
Hannes Mehnert	982a35a5b1	status: sort time as newest first	2024-11-13 14:14:32 +01:00
Hannes Mehnert	97f68a85e9	cope with git-kv change in 0.0.5: digest returns the raw digest	2024-11-13 12:47:36 +01:00
Hannes Mehnert	921ee6b684	Merge pull request 'use git-kv 0.0.5+ API for to/of_octets' (#17 ) from git-kv-05 into main Reviewed-on: #17 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-11-08 14:41:12 +00:00
Hannes Mehnert	68d2ec8e98	use git-kv 0.0.5+ API for to/of_octets	2024-11-08 15:31:50 +01:00
Hannes Mehnert	ccc8e562b1	require http-mirage-client	2024-11-08 13:56:47 +01:00
Hannes Mehnert	96368097e9	Merge pull request 'Use swapfs' (#16 ) from swap into main Reviewed-on: #16	2024-11-08 12:54:01 +00:00
Hannes Mehnert	1f9e3e6e23	log less, now that status is around	2024-11-08 13:51:33 +01:00
Hannes Mehnert	1e75be6900	remove logging from opam_file (now reported to status)	2024-11-08 13:46:05 +01:00
Hannes Mehnert	c3d5c74075	use K.remote, not the entire repo	2024-11-06 13:15:10 +01:00
Hannes Mehnert	be87d19797	reset errors, and sort failures	2024-11-06 13:08:28 +01:00
Hannes Mehnert	37008e81f3	organize failures into sections	2024-11-06 12:57:43 +01:00
Hannes Mehnert	8ba4cfae00	group download failures by error	2024-11-04 18:43:50 +01:00
Hannes Mehnert	9c50538877	record and preserve opam file parsing issues	2024-11-04 18:43:21 +01:00
Hannes Mehnert	a47193f147	tweaks	2024-11-04 17:33:50 +01:00
Hannes Mehnert	1e35bfefbd	initialization: potentially rename bad data	2024-11-04 17:33:33 +01:00
Hannes Mehnert	a9b8f18192	stream git contents, also make the tarball and the find_urls in one go	2024-11-04 17:17:52 +01:00
Hannes Mehnert	2312092e42	first write to a temporary filename, and rename later	2024-11-04 17:17:37 +01:00
Hannes Mehnert	4bec3bfbd8	restore checksum failure error	2024-11-04 16:50:42 +01:00
Hannes Mehnert	f48cc19fc4	drop superfluous 'unknown'	2024-11-04 16:46:01 +01:00
Hannes Mehnert	7689397ac3	remove bad archive list	2024-11-04 16:14:09 +01:00
Hannes Mehnert	e59f02a16f	always use swap, remove the pending / to_delete stuff	2024-11-04 16:13:36 +01:00
Reynir Björnsson	456340562d	Use swapfs	2024-11-01 14:35:08 +01:00
Reynir Björnsson	f9620e9011	Merge pull request 'Add a download status page, recording:' (#15 ) from dl-status into main Reviewed-on: #15 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-11-01 11:01:51 +00:00
Hannes Mehnert	53af2665fa	record free bytes in tar archive	2024-10-31 17:45:34 +01:00
Hannes Mehnert	f40083692a	tweaks	2024-10-31 17:17:34 +01:00
Hannes Mehnert	eb95821b2e	Add a download status page, recording: - number of archives on disk - current downloads - failed downloads	2024-10-31 11:30:52 +01:00
Hannes Mehnert	9bb86b3507	gptar is released now, no need to pin	2024-10-28 19:35:16 +01:00
Hannes Mehnert	826cc85b71	Merge pull request 'extra-source' (#14 ) from extra-source into main Reviewed-on: #14 Reviewed-by: Reynir Björnsson <reynir@reynir.dk>	2024-10-26 14:42:11 +00:00
Hannes Mehnert	9bfde48f43	also handle extra-source, fixes #8	2024-10-24 15:03:35 +02:00
Hannes Mehnert	9a2576c423	extract the opam parsing function to a separate module (opam_file.ml / Opam_file) prepares for handling extra-source as well	2024-10-24 14:45:31 +02:00
Reynir Björnsson	8af9f04dd0	Hex-encode computed checksum in log message Oops!	2024-10-18 10:43:09 +02:00
Reynir Björnsson	5accfcfc08	More informative log message	2024-10-18 10:26:43 +02:00
Reynir Björnsson	625081abff	Merge pull request 'Improve logging of bad checksums' (#7 ) from log-bad-checksum into main Reviewed-on: #7	2024-10-17 16:12:30 +00:00
Reynir Björnsson	1016c54ee7	Merge pull request 'Demote log level for unavailable packages' (#6 ) from demote-unavailable into main Reviewed-on: #6	2024-10-17 16:12:09 +00:00
Reynir Björnsson	5938a60289	Improve logging of bad checksums We now print the computed hash \o/	2024-10-17 17:26:00 +02:00
Reynir Björnsson	7a71e095da	Demote log level for unavailable packages Many packages are marked unavailable these days in preparation of opam-repository cleanup \o/ so let's be a little less noisy.	2024-10-17 17:18:16 +02:00
Reynir Björnsson	1241753a8c	Merge pull request 'Use GPTar table' (#3 ) from gptar' into main Reviewed-on: #3	2024-10-16 09:10:32 +00:00
Reynir Björnsson	26643fbcde	Add a message on successful --initialize-disk	2024-10-16 11:06:48 +02:00
Reynir Björnsson	30266f4e09	Fix sector alignment bug in formatting	2024-10-16 11:05:27 +02:00
Reynir Björnsson	068c640dac	Reset the partitions when initializing the disk THIS DESTROYS DATA	2024-10-16 11:05:27 +02:00
Reynir Björnsson	719b4ea45d	Repo tarball: use level Ustar	2024-10-16 11:05:27 +02:00
Reynir Björnsson	ceb4674ec2	Add code for formatting a disk	2024-10-16 11:05:24 +02:00
Reynir Björnsson	d36a0714e7	Use GPTar table We expect the disk to be formatted already.	2024-10-16 10:56:20 +02:00
Hannes Mehnert	9ada5c4a94	Merge pull request 'update to mirage 4.8' (#4 ) from mirage-48 into main Reviewed-on: #4	2024-10-16 08:40:11 +00:00
Hannes Mehnert	58656926e3	update to mirage 4.8	2024-10-11 13:31:48 +02:00
Hannes Mehnert	534292ec3f	Merge pull request 'Remove unnecessary complexity' (#2 ) from opam-checksums into main Reviewed-on: #2	2024-10-03 22:10:08 +00:00
Reynir Björnsson	02f9c2f9c7	Remove unnecessary complexity Opam 2 only supports md5, sha256 and sha512. We don't need the extra complexity of other hash algorithms. Opam 2 will fail to parse such an opam file anyway.	2024-10-03 18:10:21 +02:00
Reynir Björnsson	a99f7f65a3	Merge pull request 'Upgrade opam-mirror' (#1 ) from with-new-tar into main Reviewed-on: #1	2024-10-03 13:42:12 +00:00
Reynir Björnsson	6490801ce1	Update dependencies, refactor - Tar.3.0.0 was released! So we can drop the pin and depend on it directly. - Use digestif in favor of the bygone mirage-crypto hash - Move most of the hashing logic into archive_checksum.ml - When checking the checksum we should check the checksum chosen, too. I believe this was a bug that was hidden due to opam packages always using one of md5, sha256 or sha512 for checksums.	2024-10-03 14:37:37 +02:00
Calascibetta Romain	1b1414c5ca	Fix the compilation of the unikernel with the last version of ocaml-tar	2024-08-01 13:50:12 +02:00
Calascibetta Romain	8fc8f1c62d	Update the unikernel with the new version of tar	2024-07-31 14:54:26 +02:00
Calascibetta Romain	c2ffbdb891	Update to mirage.4.6.0	2024-07-15 12:22:57 +02:00