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

WIP: use tar

Browse source
This commit is contained in:
Hannes Mehnert 2022-09-06 09:55:00 +02:00
parent ef2ec2e946
commit 6f9d5706cc
2 changed files with 17 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
mirage/config.ml
View file

@ -58,7 +58,7 @@ let mirror =
package "opam-file-format" ;
package ~min:"2.1.0" ~sublibs:[ "gz" ] "tar" ;
]
(kv_rw @-> time @-> pclock @-> stackv4v6 @-> git_client @-> http_client @-> job)
(kv_ro @-> time @-> pclock @-> stackv4v6 @-> git_client @-> http_client @-> job)
let stack = generic_stackv4v6 default_network
@ -95,7 +95,11 @@ let kv_rw =
chamelon ~program_block_size block
*)
let kv_rw = direct_kv_rw "/tmp/mirror"
(* let kv_rw = direct_kv_rw "/tmp/mirror" *)
let kv_ro =
let block = block_of_file "tar" in
archive block
let () = register "mirror"
[ mirror $ kv_rw $ default_time $ default_posix_clock $ stack $ git_client $ http_client ]
[ mirror $ kv_ro $ default_time $ default_posix_clock $ stack $ git_client $ http_client ]

17
mirage/unikernel.ml
View file

@ -3,7 +3,7 @@ open Lwt.Infix
let argument_error = 64
module Make
(KV : Mirage_kv.RW)
(KV : Mirage_kv.RO)
(Time : Mirage_time.S)
(Pclock : Mirage_clock.PCLOCK)
(Stack : Tcpip.Stack.V4V6)
@ -271,17 +271,18 @@ module Make
and sha512s = SM.add sha512 name t.sha512s
in
t.md5s <- md5s ; t.sha512s <- sha512s;
Logs.debug (fun m -> m "added %s" (key_to_string t name));
Logs.info (fun m -> m "added %s" (key_to_string t name));
Lwt.return_unit
end else begin
Logs.err (fun m -> m "corrupt data, expected %s, read %s"
Logs.err (fun m -> m "corrupt data, expected %s, read %s (should remove)"
(key_to_string t name)
(hex_to_string (Cstruct.to_string digest)));
KV.remove dev (Mirage_kv.Key.v name) >|= function
(*KV.remove dev (Mirage_kv.Key.v name) >|= function
| Ok () -> ()
| Error e ->
Logs.err (fun m -> m "error %a while removing %s"
KV.pp_write_error e (key_to_string t name))
KV.pp_write_error e (key_to_string t name)) *)
Lwt.return_unit
end
| Error e ->
Logs.err (fun m -> m "error %a reading %s"
@ -310,7 +311,9 @@ module Make
false
end) hm
then begin
KV.set t.dev (Mirage_kv.Key.v sha256) data >|= function
Logs.warn (fun m -> m "should set %s" (key_to_string t sha256));
Lwt.return_unit
(* KV.set t.dev (Mirage_kv.Key.v sha256) data >|= function
| Ok () ->
t.md5s <- SM.add md5 sha256 t.md5s;
t.sha512s <- SM.add sha512 sha256 t.sha512s;
@ -318,7 +321,7 @@ module Make
(String.length data))
| Error e ->
Logs.err (fun m -> m "error %a while writing %s (key %s)"
KV.pp_write_error e url (key_to_string t sha256))
KV.pp_write_error e url (key_to_string t sha256)) *)
end else
Lwt.return_unit