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

minor: no console

Browse source
This commit is contained in:
Hannes Mehnert 2022-08-25 15:13:42 +02:00
parent 8b5bfdd789
commit 788f58d3cf
2 changed files with 5 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
mirage/config.ml
View file

@ -15,11 +15,11 @@ let mirror =
foreign "Unikernel.Make"
~keys:[ Key.v uri ]
~packages:[ package "paf" ~min:"0.0.9" ; package "paf-cohttp" ~min:"0.0.7" ]
(console @-> time @-> pclock @-> stackv4v6 @-> dns_client @-> paf @-> job)
(time @-> pclock @-> stackv4v6 @-> dns_client @-> paf @-> job)
let paf time stackv4v6 = paf_conf () $ time $ tcpv4v6_of_stackv4v6 stackv4v6
let stackv4v6 = generic_stackv4v6 default_network
let () = register "mirror"
[ mirror $ default_console $ default_time $ default_posix_clock $ stackv4v6 $ generic_dns_client stackv4v6 $ paf default_time stackv4v6 ]
[ mirror $ default_time $ default_posix_clock $ stackv4v6 $ generic_dns_client stackv4v6 $ paf default_time stackv4v6 ]

9
mirage/unikernel.ml
View file

@ -8,7 +8,6 @@ end
open Lwt.Infix
module Make
(Console : Mirage_console.S)
(Time : Mirage_time.S)
(Pclock : Mirage_clock.PCLOCK)
(Stack : Tcpip.Stack.V4V6)
@ -61,9 +60,7 @@ module Make
| _ -> Lwt.return_none in
Mimic.(fold Client.ipaddr Fun.[ req dns; req Client.domain_name ] ~k ctx)
let log console fmt = Fmt.kstr (Console.log console) fmt
let start console _time _pclock stack dns _paf_cohttp =
let start _time _pclock stack dns _paf_cohttp =
let uri = Uri.of_string (Key_gen.uri ()) in
let ctx =
Mimic.empty
@ -74,6 +71,6 @@ module Make
|> with_stack stack (* stack *)
|> with_dns dns (* dns *) in
Client.get ~ctx uri >>= fun (_resp, body) ->
Cohttp_lwt.Body.to_string body >>= fun str ->
log console "%S\n%!" str
Cohttp_lwt.Body.to_string body >|= fun str ->
Logs.info (fun m -> m "%S\n%!" str)
end