mirror of
https://github.com/mirage/qubes-mirage-firewall.git
synced 2024-10-01 05:05:39 +00:00
update to mirage 4.5.0
This commit is contained in:
parent
5da270568b
commit
076deb3f65
23
config.ml
23
config.ml
@ -1,3 +1,4 @@
|
|||||||
|
(* mirage >= 4.5.0 *)
|
||||||
(* Copyright (C) 2017, Thomas Leonard <thomas.leonard@unikernel.com>
|
(* Copyright (C) 2017, Thomas Leonard <thomas.leonard@unikernel.com>
|
||||||
See the README file for details. *)
|
See the README file for details. *)
|
||||||
|
|
||||||
@ -5,33 +6,27 @@
|
|||||||
|
|
||||||
open Mirage
|
open Mirage
|
||||||
|
|
||||||
let table_size =
|
let nat_table_size = runtime_arg ~pos:__POS__ "Unikernel.nat_table_size"
|
||||||
let info = Key.Arg.info
|
|
||||||
~doc:"The number of NAT entries to allocate."
|
|
||||||
~docv:"ENTRIES" ["nat-table-size"]
|
|
||||||
in
|
|
||||||
let key = Key.Arg.opt ~stage:`Both Key.Arg.int 5_000 info in
|
|
||||||
Key.create "nat_table_size" key
|
|
||||||
|
|
||||||
let main =
|
let main =
|
||||||
foreign
|
main
|
||||||
~keys:[Key.v table_size]
|
~runtime_args:[ nat_table_size; ]
|
||||||
~packages:[
|
~packages:[
|
||||||
package "vchan" ~min:"4.0.2";
|
package "vchan" ~min:"4.0.2";
|
||||||
package "cstruct";
|
package "cstruct";
|
||||||
package "astring";
|
package "astring";
|
||||||
package "tcpip" ~min:"3.7.0";
|
package "tcpip" ~min:"3.7.0";
|
||||||
package ~min:"2.3.0" ~sublibs:["mirage"] "arp";
|
package "arp" ~min:"2.3.0" ~sublibs:["mirage"];
|
||||||
package ~min:"3.0.0" "ethernet";
|
package "ethernet" ~min:"3.0.0";
|
||||||
package "shared-memory-ring" ~min:"3.0.0";
|
package "shared-memory-ring" ~min:"3.0.0";
|
||||||
package ~min:"2.1.2" "netchannel";
|
package "netchannel" ~min:"2.1.2";
|
||||||
package "mirage-net-xen";
|
package "mirage-net-xen";
|
||||||
package "ipaddr" ~min:"5.2.0";
|
package "ipaddr" ~min:"5.2.0";
|
||||||
package "mirage-qubes" ~min:"0.9.1";
|
package "mirage-qubes" ~min:"0.9.1";
|
||||||
package ~min:"3.0.1" "mirage-nat";
|
package "mirage-nat" ~min:"3.0.1";
|
||||||
package "mirage-logs";
|
package "mirage-logs";
|
||||||
package "mirage-xen" ~min:"8.0.0";
|
package "mirage-xen" ~min:"8.0.0";
|
||||||
package ~min:"6.4.0" "dns-client";
|
package "dns-client" ~min:"6.4.0";
|
||||||
package "pf-qubes";
|
package "pf-qubes";
|
||||||
]
|
]
|
||||||
"Unikernel.Main" (random @-> mclock @-> time @-> job)
|
"Unikernel.Main" (random @-> mclock @-> time @-> job)
|
||||||
|
10
unikernel.ml
10
unikernel.ml
@ -3,10 +3,15 @@
|
|||||||
|
|
||||||
open Lwt
|
open Lwt
|
||||||
open Qubes
|
open Qubes
|
||||||
|
open Cmdliner
|
||||||
|
|
||||||
let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code"
|
let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code"
|
||||||
module Log = (val Logs.src_log src : Logs.LOG)
|
module Log = (val Logs.src_log src : Logs.LOG)
|
||||||
|
|
||||||
|
let nat_table_size =
|
||||||
|
let doc = Arg.info ~doc:"The number of NAT entries to allocate." [ "nat-table-size" ] in
|
||||||
|
Arg.(value & opt int 5_000 doc)
|
||||||
|
|
||||||
module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) = struct
|
module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) = struct
|
||||||
module Uplink = Uplink.Make(R)(Clock)(Time)
|
module Uplink = Uplink.Make(R)(Clock)(Time)
|
||||||
module Dns_transport = My_dns.Transport(R)(Clock)(Time)
|
module Dns_transport = My_dns.Transport(R)(Clock)(Time)
|
||||||
@ -23,7 +28,7 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim
|
|||||||
]
|
]
|
||||||
|
|
||||||
(* Main unikernel entry point (called from auto-generated main.ml). *)
|
(* Main unikernel entry point (called from auto-generated main.ml). *)
|
||||||
let start _random _clock _time =
|
let start _random _clock _time nat_table_size =
|
||||||
let start_time = Clock.elapsed_ns () in
|
let start_time = Clock.elapsed_ns () in
|
||||||
(* Start qrexec agent and QubesDB agent in parallel *)
|
(* Start qrexec agent and QubesDB agent in parallel *)
|
||||||
let qrexec = RExec.connect ~domid:0 () in
|
let qrexec = RExec.connect ~domid:0 () in
|
||||||
@ -44,8 +49,7 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim
|
|||||||
Xen_os.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) ->
|
Xen_os.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) ->
|
||||||
Lwt.return_unit in
|
Lwt.return_unit in
|
||||||
(* Set up networking *)
|
(* Set up networking *)
|
||||||
let max_entries = Key_gen.nat_table_size () in
|
let nat = My_nat.create ~max_entries:nat_table_size in
|
||||||
let nat = My_nat.create ~max_entries in
|
|
||||||
|
|
||||||
(* Read network configuration from QubesDB *)
|
(* Read network configuration from QubesDB *)
|
||||||
Dao.read_network_config qubesDB >>= fun config ->
|
Dao.read_network_config qubesDB >>= fun config ->
|
||||||
|
Loading…
Reference in New Issue
Block a user