diff --git a/conduit_server_manual/unikernel.ml b/conduit_server_manual/unikernel.ml index aed279d7..c9a52f2b 100644 --- a/conduit_server_manual/unikernel.ml +++ b/conduit_server_manual/unikernel.ml @@ -17,14 +17,14 @@ module Main (C:CONSOLE) (S:STACKV4) = struct let start console s = C.log_s console (sprintf "IP address: %s\n" - (Ipaddr.V4.to_string (S.IPV4.get_ipv4 (S.ipv4 s)))) + (String.concat ", " (List.map Ipaddr.V4.to_string (S.IPV4.get_ip (S.ipv4 s))))) >>= fun () -> - lwt ctx = CON.init () in + lwt ctx = CON.init ~stack:s () in let http_callback conn_id req body = let path = Uri.path (H.Server.Request.uri req) in - C.log_s console (sprintf "Got request for %s\n" path) + C.log_s console (sprintf "Got request for %s\n" path) >>= fun () -> H.Server.respond_string ~status:`OK ~body:"hello mirage world!\n" () in diff --git a/ethifv4/config.ml b/ethifv4/config.ml index 2a8f7058..9e5c4ac8 100644 --- a/ethifv4/config.ml +++ b/ethifv4/config.ml @@ -1,18 +1,18 @@ open Mirage -let main = foreign "Unikernel.Main" (console @-> network @-> job) +let main = foreign "Unikernel.Main" (console @-> network @-> clock @-> job) (* TODO: workaround a bug in the command-line tool by adding Clock for Unix (this is pulled in as an implicit dependency in Xen) *) let unix_libs = - match get_mode () with + match get_mode () with | `Xen -> [] - | _ -> ["mirage-clock-unix"] + | _ -> ["mirage-clock-unix"] let () = add_to_ocamlfind_libraries - ([ "tcpip.ethif"; "tcpip.tcpv4"; "tcpip.udpv4"; "tcpip.dhcpv4" ] + ([ "tcpip.ethif"; "tcpip.tcp"; "tcpip.udp"; "tcpip.dhcpv4" ] @ unix_libs); register "ethifv4" [ - main $ default_console $ tap0 + main $ default_console $ tap0 $ default_clock ] diff --git a/ethifv4/unikernel.ml b/ethifv4/unikernel.ml index aa861b38..e9279bbb 100644 --- a/ethifv4/unikernel.ml +++ b/ethifv4/unikernel.ml @@ -6,12 +6,12 @@ let green fmt = Printf.sprintf ("\027[32m"^^fmt^^"\027[m") let yellow fmt = Printf.sprintf ("\027[33m"^^fmt^^"\027[m") let blue fmt = Printf.sprintf ("\027[36m"^^fmt^^"\027[m") -module Main (C: CONSOLE) (N: NETWORK) = struct +module Main (C: CONSOLE) (N: NETWORK) (Clock : V1.CLOCK) = struct module E = Ethif.Make(N) module I = Ipv4.Make(E) - module U = Udpv4.Make(I) - module T = Tcpv4.Flow.Make(I)(OS.Time)(Clock)(Random) + module U = Udp.Make(I) + module T = Tcp.Flow.Make(I)(OS.Time)(Clock)(Random) module D = Dhcp_clientv4.Make(C)(OS.Time)(Random)(U) let or_error c name fn t = @@ -20,18 +20,18 @@ module Main (C: CONSOLE) (N: NETWORK) = struct | `Error e -> fail (Failure ("Error starting " ^ name)) | `Ok t -> return t - let start c net = + let start c net _ = or_error c "Ethif" E.connect net >>= fun e -> or_error c "Ipv4" I.connect e >>= fun i -> - I.set_ipv4 i (Ipaddr.V4.of_string_exn "10.0.0.2") + I.set_ip i (Ipaddr.V4.of_string_exn "10.0.0.2") >>= fun () -> - I.set_ipv4_netmask i (Ipaddr.V4.of_string_exn "255.255.255.0") + I.set_ip_netmask i (Ipaddr.V4.of_string_exn "255.255.255.0") >>= fun () -> - I.set_ipv4_gateways i [Ipaddr.V4.of_string_exn "10.0.0.1"] + I.set_ip_gateways i [Ipaddr.V4.of_string_exn "10.0.0.1"] >>= fun () -> or_error c "UDPv4" U.connect i >>= fun udp -> @@ -42,6 +42,7 @@ module Main (C: CONSOLE) (N: NETWORK) = struct N.listen net ( E.input + ~arpv4:(I.input_arpv4 i) ~ipv4:( I.input ~tcp:( diff --git a/kv_ro/config.ml b/kv_ro/config.ml index e1e28578..b4ee81c9 100644 --- a/kv_ro/config.ml +++ b/kv_ro/config.ml @@ -14,7 +14,7 @@ let disk = match mode, get_mode () with | `Fat , _ -> fat_ro "t" | `Crunch, `Xen -> crunch "t" - | `Crunch, `Unix -> direct_kv_ro "t" + | `Crunch, (`Unix | `MacOSX) -> direct_kv_ro "t" let main = foreign "Unikernel.Main" (console @-> kv_ro @-> kv_ro @-> job) diff --git a/ping/config.ml b/ping/config.ml index a3cf4da8..6b9d08b3 100644 --- a/ping/config.ml +++ b/ping/config.ml @@ -3,5 +3,6 @@ open Mirage let main = foreign "Unikernel.Main" (console @-> network @-> job) let () = + add_to_opam_packages [ "tcpip" ]; add_to_ocamlfind_libraries [ "tcpip.ethif"; "tcpip.ipv4" ]; register "ping" [ main $ default_console $ tap0 ] diff --git a/ping/unikernel.ml b/ping/unikernel.ml index f2ac5b4e..7fbc3f73 100644 --- a/ping/unikernel.ml +++ b/ping/unikernel.ml @@ -26,17 +26,18 @@ module Main (C:CONSOLE) (N:NETWORK) = struct or_error c "Ethif" E.connect n >>= fun e -> or_error c "Ipv4" I.connect e >>= fun i -> - I.set_ipv4 i (Ipaddr.V4.of_string_exn ipaddr) >>= fun () -> - I.set_ipv4_netmask i (Ipaddr.V4.of_string_exn netmask) >>= fun () -> - I.set_ipv4_gateways i (List.map Ipaddr.V4.of_string_exn gateways) + I.set_ip i (Ipaddr.V4.of_string_exn ipaddr) >>= fun () -> + I.set_ip_netmask i (Ipaddr.V4.of_string_exn netmask) >>= fun () -> + I.set_ip_gateways i (List.map Ipaddr.V4.of_string_exn gateways) >>= fun () -> let handler s = fun ~src ~dst data -> - C.log_s c (yellow "%s > %s TCP" - (Ipaddr.V4.to_string src) (Ipaddr.V4.to_string dst)) + C.log_s c (yellow "%s > %s %s" + (Ipaddr.V4.to_string src) (Ipaddr.V4.to_string dst) s) in N.listen n (E.input + ~arpv4:(I.input_arpv4 i) ~ipv4:(I.input ~tcp:(handler "TCP") ~udp:(handler "UDP") diff --git a/ping6/config.ml b/ping6/config.ml new file mode 100644 index 00000000..d53ff3fe --- /dev/null +++ b/ping6/config.ml @@ -0,0 +1,8 @@ +open Mirage + +let main = foreign "Unikernel.Main" (console @-> network @-> clock @-> job) + +let () = + add_to_opam_packages [ "tcpip" ]; + add_to_ocamlfind_libraries [ "tcpip.ethif"; "tcpip.ipv6" ]; + register "ping" [ main $ default_console $ tap0 $ default_clock ] diff --git a/ping6/unikernel.ml b/ping6/unikernel.ml new file mode 100644 index 00000000..06e2d952 --- /dev/null +++ b/ping6/unikernel.ml @@ -0,0 +1,51 @@ +open Lwt +open V1_LWT + +let red fmt = Printf.sprintf ("\027[31m"^^fmt^^"\027[m") +let green fmt = Printf.sprintf ("\027[32m"^^fmt^^"\027[m") +let yellow fmt = Printf.sprintf ("\027[33m"^^fmt^^"\027[m") +let blue fmt = Printf.sprintf ("\027[36m"^^fmt^^"\027[m") + +let ipaddr = "fc00::2" +let gateways = ["fc00::1"] + +module Main (C:CONSOLE) (N:NETWORK) (Clock : V1.CLOCK) = struct + + module E = Ethif.Make(N) + module I = Ipv6.Make(E)(OS.Time)(Clock) + + let or_error c name fn t = + fn t + >>= function + | `Error e -> fail (Failure ("Error starting " ^ name)) + | `Ok t -> return t + + let start c n _ = + C.log c (green "starting..."); + or_error c "Ethif" E.connect n >>= fun e -> + or_error c "Ipv6" I.connect e >>= fun i -> + + I.set_ip i (Ipaddr.V6.of_string_exn ipaddr) >>= fun () -> + I.set_ip_gateways i (List.map Ipaddr.V6.of_string_exn gateways) >>= fun () -> + + let handler s = fun ~src ~dst data -> + C.log_s c (yellow "%s > %s %s" + (Ipaddr.V6.to_string src) (Ipaddr.V6.to_string dst) s) + in + N.listen n + (E.input + ~arpv4:(fun _ -> return (C.log c (red "ARP4"))) + ~ipv4:(fun _ -> return (C.log c (red "IP4"))) + ~ipv6:(I.input + ~tcp:(handler "TCP") + ~udp:(handler "UDP") + ~default:(fun ~proto ~src ~dst data -> + C.log_s c (red "%d DEFAULT" proto)) + i + ) + e) + >>= fun () -> + C.log c (green "done!"); + return () + +end diff --git a/stackv4/unikernel.ml b/stackv4/unikernel.ml index 0487ebfa..c3771f5a 100644 --- a/stackv4/unikernel.ml +++ b/stackv4/unikernel.ml @@ -14,9 +14,9 @@ module Main (C:CONSOLE) (S:STACKV4) = struct let start console s = - C.log_s console - (sprintf "IP address: %s\n" - (Ipaddr.V4.to_string (S.IPV4.get_ipv4 (S.ipv4 s)))) + C.log_s console + (sprintf "IP address: %s\n" + (String.concat ", " (List.map Ipaddr.V4.to_string (S.IPV4.get_ip (S.ipv4 s))))) >>= fun () -> S.listen_udpv4 s 53 ( @@ -28,7 +28,7 @@ module Main (C:CONSOLE) (S:STACKV4) = struct fun flow -> let dst, dst_port = T.get_dest flow in C.log_s console - (green "new tcp from %s %d" + (green "new tcp from %s %d" (Ipaddr.V4.to_string dst) dst_port ) >>= fun () -> @@ -36,7 +36,7 @@ module Main (C:CONSOLE) (S:STACKV4) = struct >>= function | `Ok b -> C.log_s console - (yellow "read: %d\n%s" + (yellow "read: %d\n%s" (Cstruct.len b) (Cstruct.to_string b) ) >>= fun () -> diff --git a/xen/static_website+ip/config.ml b/xen/static_website+ip/config.ml index ae3f3ec6..fe97bef6 100644 --- a/xen/static_website+ip/config.ml +++ b/xen/static_website+ip/config.ml @@ -22,7 +22,7 @@ let main = foreign "Dispatch.Main" (console @-> kv_ro @-> network @-> job) let () = - add_to_ocamlfind_libraries ["mirage-http";"tcpip.ethif"; "tcpip.tcpv4"; "tcpip.udpv4"; "tcpip.dhcpv4" ]; + add_to_ocamlfind_libraries ["mirage-http";"tcpip.ethif"; "tcpip.tcp"; "tcpip.udp"; "tcpip.dhcpv4" ]; add_to_opam_packages ["mirage-http"]; register "www" [ main $ default_console $ fs $ tap0 diff --git a/xen/static_website+ip/dispatch.ml b/xen/static_website+ip/dispatch.ml index 5c16e844..09cb2342 100644 --- a/xen/static_website+ip/dispatch.ml +++ b/xen/static_website+ip/dispatch.ml @@ -11,8 +11,8 @@ module Main (C:CONSOLE) (FS:KV_RO) (N:NETWORK) = struct module E = Ethif.Make(N) module I = Ipv4.Make(E) - module U = Udpv4.Make(I) - module T = Tcpv4.Flow.Make(I)(OS.Time)(Clock)(Random) + module U = Udp.Make(I) + module T = Tcp.Flow.Make(I)(OS.Time)(Clock)(Random) module CH = Channel.Make(T) module H = HTTP.Make(CH) @@ -20,7 +20,7 @@ module Main (C:CONSOLE) (FS:KV_RO) (N:NETWORK) = struct fn t >>= function | `Error e -> fail (Failure ("Error starting " ^ name)) - | `Ok t -> return t + | `Ok t -> return t let start c fs net = @@ -32,21 +32,21 @@ module Main (C:CONSOLE) (FS:KV_RO) (N:NETWORK) = struct let fields = Re_str.(split (regexp_string " ") cmd_line) in let bits = List.map (fun x -> - match Re_str.(split (regexp_string "=") x) with - | [a;b] -> (a,b) + match Re_str.(split (regexp_string "=") x) with + | [a;b] -> (a,b) | _ -> raise (Failure "malformed cmdline")) fields in let get x = List.assoc x bits in let ip = Ipaddr.V4.of_string_exn (get "ip") in let netmask = Ipaddr.V4.of_string_exn (get "netmask") in let gateway = Ipaddr.V4.of_string_exn (get "gateway") in - C.log_s c (sprintf "ip=%s netmask=%s gateway=%s" + C.log_s c (sprintf "ip=%s netmask=%s gateway=%s" (Ipaddr.V4.to_string ip) (Ipaddr.V4.to_string netmask) - (Ipaddr.V4.to_string gateway)) >>= fun () -> - I.set_ipv4 i ip >>= fun () -> - I.set_ipv4_netmask i netmask >>= fun () -> - I.set_ipv4_gateways i [gateway] >>= fun () -> + (Ipaddr.V4.to_string gateway)) >>= fun () -> + I.set_ip i ip >>= fun () -> + I.set_ip_netmask i netmask >>= fun () -> + I.set_ip_gateways i [gateway] >>= fun () -> or_error c "UDPv4" U.connect i >>= fun udp -> or_error c "TCPv4" T.connect i >>= fun tcp -> @@ -74,7 +74,7 @@ module Main (C:CONSOLE) (FS:KV_RO) (N:NETWORK) = struct (* dispatch non-file URLs *) let rec dispatcher = function - | [] | [""] -> dispatcher ["index.html"] + | [] | [""] -> dispatcher ["index.html"] | segments -> let path = String.concat "/" segments in try_lwt @@ -110,6 +110,7 @@ module Main (C:CONSOLE) (FS:KV_RO) (N:NETWORK) = struct N.listen net ( E.input + ~arpv4:(I.input_arpv4 i) ~ipv4:( I.input ~tcp:(