diff --git a/config.ml b/config.ml index f28928e..c092574 100644 --- a/config.ml +++ b/config.ml @@ -1,3 +1,4 @@ +(* mirage >= 4.5.0 *) (* Copyright (C) 2017, Thomas Leonard See the README file for details. *) @@ -5,55 +6,31 @@ open Mirage -let 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 ipv4 = - let doc = Key.Arg.info ~doc:"Manual IP setting." ["ipv4"] in - Key.(create "ipv4" Arg.(opt string "0.0.0.0" doc)) - -let ipv4_gw = - let doc = Key.Arg.info ~doc:"Manual Gateway IP setting." ["ipv4-gw"] in - Key.(create "ipv4_gw" Arg.(opt string "0.0.0.0" doc)) - -let ipv4_dns = - let doc = Key.Arg.info ~doc:"Manual DNS IP setting." ["ipv4-dns"] in - Key.(create "ipv4_dns" Arg.(opt string "10.139.1.1" doc)) - -let ipv4_dns2 = - let doc = Key.Arg.info ~doc:"Manual Second DNS IP setting." ["ipv4-dns2"] in - Key.(create "ipv4_dns2" Arg.(opt string "10.139.1.2" doc)) +let nat_table_size = runtime_arg ~pos:__POS__ "Unikernel.nat_table_size" +let ipv4 = runtime_arg ~pos:__POS__ "Unikernel.ipv4" +let ipv4_gw = runtime_arg ~pos:__POS__ "Unikernel.ipv4_gw" +let ipv4_dns = runtime_arg ~pos:__POS__ "Unikernel.ipv4_dns" +let ipv4_dns2 = runtime_arg ~pos:__POS__ "Unikernel.ipv4_dns2" let main = - foreign - ~keys:[ - Key.v table_size; - Key.v ipv4; - Key.v ipv4_gw; - Key.v ipv4_dns; - Key.v ipv4_dns2; - ] + main + ~runtime_args:[ nat_table_size; ] ~packages:[ package "vchan" ~min:"4.0.2"; package "cstruct"; package "astring"; package "tcpip" ~min:"3.7.0"; - package ~min:"2.3.0" ~sublibs:["mirage"] "arp"; - package ~min:"3.0.0" "ethernet"; + package "arp" ~min:"2.3.0" ~sublibs:["mirage"]; + package "ethernet" ~min:"3.0.0"; package "shared-memory-ring" ~min:"3.0.0"; - package ~min:"2.1.3" "netchannel"; - package ~min:"2.1.3" "mirage-net-xen"; + package "netchannel" ~min:"2.1.3"; + package "mirage-net-xen" ~min:"2.1.3"; package "ipaddr" ~min:"5.2.0"; 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-xen" ~min:"8.0.0"; - package ~min:"6.4.0" "dns-client"; + package "dns-client" ~min:"6.4.0"; package "pf-qubes"; ] "Unikernel.Main" (random @-> mclock @-> time @-> job) diff --git a/fw_utils.ml b/fw_utils.ml index 4469e4d..0307810 100644 --- a/fw_utils.ml +++ b/fw_utils.ml @@ -8,7 +8,7 @@ module IpMap = struct let find x map = try Some (find x map) with Not_found -> None - | e -> Logs.err( fun f -> f "uncaught exception in find...%!"); None + | _ -> Logs.err( fun f -> f "uncaught exception in find...%!"); None end (** An Ethernet interface. *) diff --git a/unikernel.ml b/unikernel.ml index ef02620..dcbdafe 100644 --- a/unikernel.ml +++ b/unikernel.ml @@ -3,10 +3,31 @@ open Lwt open Qubes +open Cmdliner let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code" 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) + +let ipv4 = + let doc = Arg.info ~doc:"Manual IP setting." [ "ipv4" ] in + Arg.(value & opt string "0.0.0.0" doc) + +let ipv4_gw = + let doc = Arg.info ~doc:"Manual Gateway IP setting." [ "ipv4-gw" ] in + Arg.(value & opt string "0.0.0.0" doc) + +let ipv4_dns = + let doc = Arg.info ~doc:"Manual DNS IP setting." [ "ipv4-dns" ] in + Arg.(value & opt string "10.139.1.1" doc) + +let ipv4_dns2 = + let doc = Arg.info ~doc:"Manual Second DNS IP setting." [ "ipv4-dns2" ] in + Arg.(value & opt string "10.139.1.2" doc) + module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) = struct module Dispatcher = Dispatcher.Make(R)(Clock)(Time) module Dns_transport = My_dns.Transport(R)(Clock)(Time) @@ -24,7 +45,7 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim ] (* Main unikernel entry point (called from auto-generated main.ml). *) - let start _random _clock _time = + let start _random _clock _time nat_table_size ipv4 ipv4_gw ipv4_dns ipv4_dns2 = let start_time = Clock.elapsed_ns () in (* Start qrexec agent and QubesDB agent in parallel *) let qrexec = RExec.connect ~domid:0 () in @@ -45,13 +66,12 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim Xen_os.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) -> Lwt.return_unit in (* Set up networking *) - let max_entries = Key_gen.nat_table_size () in - let nat = My_nat.create ~max_entries in + let nat = My_nat.create ~max_entries:nat_table_size in - let netvm_ip = Ipaddr.V4.of_string_exn (Key_gen.ipv4_gw ()) in - let our_ip = Ipaddr.V4.of_string_exn (Key_gen.ipv4 ()) in - let dns = Ipaddr.V4.of_string_exn (Key_gen.ipv4_dns ()) in - let dns2 = Ipaddr.V4.of_string_exn (Key_gen.ipv4_dns2 ()) in + let netvm_ip = Ipaddr.V4.of_string_exn ipv4_gw in + let our_ip = Ipaddr.V4.of_string_exn ipv4 in + let dns = Ipaddr.V4.of_string_exn ipv4_dns in + let dns2 = Ipaddr.V4.of_string_exn ipv4_dns2 in let zero_ip = (Ipaddr.V4.make 0 0 0 0) in