mirror of
https://github.com/mirage/qubes-mirage-firewall.git
synced 2024-10-01 01:05:39 -04:00
update to mirage 4.5.0
This commit is contained in:
parent
fc7f7f3544
commit
46deafa650
51
config.ml
51
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,55 +6,31 @@
|
|||||||
|
|
||||||
open Mirage
|
open Mirage
|
||||||
|
|
||||||
let table_size =
|
let nat_table_size = runtime_arg ~pos:__POS__ "Unikernel.nat_table_size"
|
||||||
let info = Key.Arg.info
|
let ipv4 = runtime_arg ~pos:__POS__ "Unikernel.ipv4"
|
||||||
~doc:"The number of NAT entries to allocate."
|
let ipv4_gw = runtime_arg ~pos:__POS__ "Unikernel.ipv4_gw"
|
||||||
~docv:"ENTRIES" ["nat-table-size"]
|
let ipv4_dns = runtime_arg ~pos:__POS__ "Unikernel.ipv4_dns"
|
||||||
in
|
let ipv4_dns2 = runtime_arg ~pos:__POS__ "Unikernel.ipv4_dns2"
|
||||||
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 main =
|
let main =
|
||||||
foreign
|
main
|
||||||
~keys:[
|
~runtime_args:[ nat_table_size; ]
|
||||||
Key.v table_size;
|
|
||||||
Key.v ipv4;
|
|
||||||
Key.v ipv4_gw;
|
|
||||||
Key.v ipv4_dns;
|
|
||||||
Key.v ipv4_dns2;
|
|
||||||
]
|
|
||||||
~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.3" "netchannel";
|
package "netchannel" ~min:"2.1.3";
|
||||||
package ~min:"2.1.3" "mirage-net-xen";
|
package "mirage-net-xen" ~min:"2.1.3";
|
||||||
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)
|
||||||
|
@ -8,7 +8,7 @@ module IpMap = struct
|
|||||||
let find x map =
|
let find x map =
|
||||||
try Some (find x map)
|
try Some (find x map)
|
||||||
with Not_found -> None
|
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
|
end
|
||||||
|
|
||||||
(** An Ethernet interface. *)
|
(** An Ethernet interface. *)
|
||||||
|
34
unikernel.ml
34
unikernel.ml
@ -3,10 +3,31 @@
|
|||||||
|
|
||||||
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)
|
||||||
|
|
||||||
|
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 Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) = struct
|
||||||
module Dispatcher = Dispatcher.Make(R)(Clock)(Time)
|
module Dispatcher = Dispatcher.Make(R)(Clock)(Time)
|
||||||
module Dns_transport = My_dns.Transport(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). *)
|
(* 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
|
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
|
||||||
@ -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) ->
|
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
|
|
||||||
|
|
||||||
let netvm_ip = Ipaddr.V4.of_string_exn (Key_gen.ipv4_gw ()) in
|
let netvm_ip = Ipaddr.V4.of_string_exn ipv4_gw in
|
||||||
let our_ip = Ipaddr.V4.of_string_exn (Key_gen.ipv4 ()) in
|
let our_ip = Ipaddr.V4.of_string_exn ipv4 in
|
||||||
let dns = Ipaddr.V4.of_string_exn (Key_gen.ipv4_dns ()) in
|
let dns = Ipaddr.V4.of_string_exn ipv4_dns in
|
||||||
let dns2 = Ipaddr.V4.of_string_exn (Key_gen.ipv4_dns2 ()) in
|
let dns2 = Ipaddr.V4.of_string_exn ipv4_dns2 in
|
||||||
|
|
||||||
let zero_ip = (Ipaddr.V4.make 0 0 0 0) in
|
let zero_ip = (Ipaddr.V4.make 0 0 0 0) in
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user