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

use git-kv on store to dump and restore the git commit

Browse source
This commit is contained in:
Hannes Mehnert 2022-09-26 22:42:00 +02:00
parent 83d494c433
commit 5e427897be
2 changed files with 48 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
mirage/config.ml
View file

@ -55,9 +55,16 @@ let sectors_cache =
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 mirror =
foreign "Unikernel.Make"
~keys:[ Key.v check ; Key.v verify ; Key.v remote ; Key.v parallel_downloads ; Key.v hook_url ; Key.v tls_authenticator ; Key.v port ; Key.v sectors_cache ]
~keys:[ Key.v check ; Key.v verify ; 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 ; ]
~packages:[
package ~min:"0.1.0" ~sublibs:[ "mirage" ] "paf" ;
package "h2" ;

42
mirage/unikernel.ml
View file

@ -276,7 +276,6 @@ module Make
(* on disk, we use a flat file system where the filename is the sha256 of the data *)
let init ~verify dev dev_md5s dev_sha512s =
Logs.info (fun m -> m "init with verify %B" verify);
KV.list dev Mirage_kv.Key.empty >>= function
| Error e -> Logs.err (fun m -> m "error %a listing kv" KV.pp_error e); assert false
| Ok entries ->
@ -757,22 +756,57 @@ stamp: %S
Disk.update_caches disk >|= fun () ->
Logs.info (fun m -> m "downloading of %d urls done" (SM.cardinal urls))
let dump_git git_dump git_kv =
Git_kv.to_octets git_kv >>= fun data ->
Cache.write git_dump data >|= function
| Ok () ->
Logs.info (fun m -> m "dumped git %d bytes" (String.length data))
| Error e ->
Logs.warn (fun m -> m "failed to dump git: %a" Cache.pp_write_error e)
let restore_git git_dump git_ctx =
Cache.read git_dump >>= function
| Ok None -> Lwt.return (Error ())
| Error e ->
Logs.warn (fun m -> m "failed to read git state: %a" Cache.pp_error e);
Lwt.return (Error ())
| Ok Some data ->
Git_kv.of_octets git_ctx ~remote:(Key_gen.remote ()) data >|= function
| Ok git_kv -> Ok git_kv
| Error `Msg msg ->
Logs.err (fun m -> m "error restoring git state: %s" msg);
Error ()
module Paf = Paf_mirage.Make(Time)(Stack.TCP)
let start block _time _pclock stack git_ctx http_ctx =
BLOCK.get_info block >>= fun info ->
let sectors_cache = Key_gen.sectors_cache () in
Part.connect Int64.(sub info.size_sectors (mul 2L sectors_cache)) block >>= fun (b1, rest) ->
let sectors_git = Key_gen.sectors_git () in
let git_start =
let cache_size = Int64.(mul 2L sectors_cache) in
Int64.(sub info.size_sectors (add cache_size sectors_git))
in
Part.connect git_start block >>= fun (b1, rest) ->
let git_dump, rest = Part.subpartition sectors_git rest in
let b2, b3 = Part.subpartition sectors_cache rest in
KV.connect b1 >>= fun kv ->
Cache.connect b2 >>= fun md5s ->
Cache.connect b3 >>= fun sha512s ->
Cache.connect git_dump >>= fun git_dump ->
Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv));
Disk.init ~verify:(Key_gen.verify ()) kv md5s sha512s >>= fun disk ->
if Key_gen.check () then
Lwt.return_unit
else
begin
restore_git git_dump git_ctx >>= function
| Ok git_kv -> Lwt.return git_kv
| Error () ->
Git_kv.connect git_ctx (Key_gen.remote ()) >>= fun git_kv ->
dump_git git_dump git_kv >|= fun () ->
git_kv
end >>= fun git_kv ->
Serve.commit_id git_kv >>= fun commit_id ->
Logs.info (fun m -> m "git: %s" commit_id);
Serve.create git_kv >>= fun serve ->
@ -780,7 +814,9 @@ stamp: %S
let update () =
Serve.update_git serve git_kv >>= function
| None | Some [] -> Lwt.return_unit
| Some _changes -> download_archives disk http_ctx git_kv
| Some _changes ->
dump_git git_dump git_kv >>= fun () ->
download_archives disk http_ctx git_kv
in
let service =
Paf.http_service