qubes-mirage-firewall/unikernel.ml
Thomas Leonard e05a92da50 Update to new Logs API
Note: this reintroduces mirage-qubes pin, as that uses Logs too.
2016-01-08 11:40:11 +00:00

73 lines
2.6 KiB
OCaml

(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
open Lwt
open Qubes
let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code"
module Log = (val Logs.src_log src : Logs.LOG)
(* Configure logging *)
let () =
let open Logs in
(* Set default log level *)
set_level (Some Logs.Info)
module Main (Clock : V1.CLOCK) = struct
module Log_reporter = Mirage_logs.Make(Clock)
module Uplink = Uplink.Make(Clock)
(* Set up networking and listen for incoming packets. *)
let network qubesDB =
(* Read configuration from QubesDB *)
let config = Dao.read_network_config qubesDB in
Logs.info (fun f -> f "Client (internal) network is %a"
Ipaddr.V4.Prefix.pp_hum config.Dao.clients_prefix);
(* Initialise connection to NetVM *)
Uplink.connect config >>= fun uplink ->
(* Report success *)
Dao.set_iptables_error qubesDB "" >>= fun () ->
(* Set up client-side networking *)
let client_eth = Client_eth.create
~client_gw:config.Dao.clients_our_ip
~prefix:config.Dao.clients_prefix in
(* Set up routing between networks and hosts *)
let router = Router.create
~client_eth
~uplink:(Uplink.interface uplink) in
(* Handle packets from both networks *)
Lwt.join [
Client_net.listen router;
Uplink.listen uplink router
]
(* Main unikernel entry point (called from auto-generated main.ml). *)
let start () =
let start_time = Clock.time () in
Log_reporter.init_logging ();
(* Start qrexec agent, GUI agent and QubesDB agent in parallel *)
let qrexec = RExec.connect ~domid:0 () in
let gui = GUI.connect ~domid:0 () in
let qubesDB = DB.connect ~domid:0 () in
(* Wait for clients to connect *)
qrexec >>= fun qrexec ->
let agent_listener = RExec.listen qrexec Command.handler in
gui >>= fun gui ->
Lwt.async (fun () -> GUI.listen gui);
qubesDB >>= fun qubesDB ->
Log.info (fun f -> f "agents connected in %.3f s (CPU time used since boot: %.3f s)"
(Clock.time () -. start_time) (Sys.time ()));
(* Watch for shutdown requests from Qubes *)
let shutdown_rq =
OS.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) ->
return () in
(* Set up networking *)
let net_listener = network qubesDB in
(* Report memory usage to XenStore *)
Memory_pressure.init ();
(* Run until something fails or we get a shutdown request. *)
Lwt.choose [agent_listener; net_listener; shutdown_rq] >>= fun () ->
(* Give the console daemon time to show any final log messages. *)
OS.Time.sleep 1.0
end