From 8c45c7ce0b24676e06b14737d8afe4e63487d9d1 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Sat, 29 Nov 2014 22:55:39 +0000 Subject: [PATCH 1/7] Update to work with the latest signatures --- conduit_server_manual/unikernel.ml | 6 +++--- ethifv4/config.ml | 6 +++--- ethifv4/unikernel.ml | 11 ++++++----- ping/unikernel.ml | 7 ++++--- stackv4/unikernel.ml | 10 +++++----- xen/static_website+ip/config.ml | 2 +- xen/static_website+ip/dispatch.ml | 23 ++++++++++++----------- 7 files changed, 34 insertions(+), 31 deletions(-) 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 8386f473..e8196b3c 100644 --- a/ethifv4/config.ml +++ b/ethifv4/config.ml @@ -5,13 +5,13 @@ let main = foreign "Unikernel.Main" (console @-> network @-> 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 - | `Unix -> ["mirage-clock-unix"] + match get_mode () with + | `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 diff --git a/ethifv4/unikernel.ml b/ethifv4/unikernel.ml index 9e7904ea..4aea4f4e 100644 --- a/ethifv4/unikernel.ml +++ b/ethifv4/unikernel.ml @@ -10,8 +10,8 @@ module Main (C: CONSOLE) (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 D = Dhcp_clientv4.Make(C)(OS.Time)(Random)(E)(I)(U) let or_error c name fn t = @@ -27,11 +27,11 @@ module Main (C: CONSOLE) (N: NETWORK) = struct 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/ping/unikernel.ml b/ping/unikernel.ml index f2ac5b4e..83c2667f 100644 --- a/ping/unikernel.ml +++ b/ping/unikernel.ml @@ -26,9 +26,9 @@ 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 -> @@ -37,6 +37,7 @@ module Main (C:CONSOLE) (N:NETWORK) = struct in N.listen n (E.input + ~arpv4:(I.input_arpv4 i) ~ipv4:(I.input ~tcp:(handler "TCP") ~udp:(handler "UDP") 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:( From 5750fcfc14437075b176385a8ffff14fe775c342 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Thu, 11 Dec 2014 01:24:04 -0300 Subject: [PATCH 2/7] Add `MacOSX match case to some config.ml's --- conduit_server/config.ml | 2 +- conduit_server_manual/config.ml | 2 +- dns/config.ml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/conduit_server/config.ml b/conduit_server/config.ml index 670e7e72..2f9febb8 100644 --- a/conduit_server/config.ml +++ b/conduit_server/config.ml @@ -12,7 +12,7 @@ let socket = let c = default_console in match get_mode () with | `Xen -> [] - | `Unix -> [ handler $ c $ conduit_direct (socket_stackv4 c [Ipaddr.V4.any]) ] + | `Unix | `MacOSX -> [ handler $ c $ conduit_direct (socket_stackv4 c [Ipaddr.V4.any]) ] let () = add_to_ocamlfind_libraries ["mirage-http"]; diff --git a/conduit_server_manual/config.ml b/conduit_server_manual/config.ml index a7d7bd5e..fc2b3ce0 100644 --- a/conduit_server_manual/config.ml +++ b/conduit_server_manual/config.ml @@ -11,7 +11,7 @@ let socket = let c = default_console in match get_mode () with | `Xen -> [] - | `Unix -> [ handler $ c $ socket_stackv4 c [Ipaddr.V4.any] ] + | `Unix | `MacOSX -> [ handler $ c $ socket_stackv4 c [Ipaddr.V4.any] ] let () = add_to_ocamlfind_libraries ["mirage-http"; "vchan"]; diff --git a/dns/config.ml b/dns/config.ml index 88876572..82a8008d 100644 --- a/dns/config.ml +++ b/dns/config.ml @@ -14,7 +14,7 @@ let socket = let c = default_console in match get_mode () with | `Xen -> [] - | `Unix -> [ handler $ c $ data $ socket_stackv4 c [Ipaddr.V4.any] ] + | `Unix | `MacOSX -> [ handler $ c $ data $ socket_stackv4 c [Ipaddr.V4.any] ] let () = add_to_ocamlfind_libraries ["dns.lwt-core"]; From f1bdc1a3d0c34ef177d249a6a1facc6e44506379 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Thu, 11 Dec 2014 01:24:45 -0300 Subject: [PATCH 3/7] Fix Clock, Dhcp functor applications --- ethifv4/config.ml | 4 ++-- ethifv4/unikernel.ml | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/ethifv4/config.ml b/ethifv4/config.ml index e8196b3c..6f5d355b 100644 --- a/ethifv4/config.ml +++ b/ethifv4/config.ml @@ -1,6 +1,6 @@ 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) *) @@ -14,5 +14,5 @@ let () = ([ "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 4aea4f4e..c083f145 100644 --- a/ethifv4/unikernel.ml +++ b/ethifv4/unikernel.ml @@ -6,13 +6,13 @@ 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 = Udp.Make(I) module T = Tcp.Flow.Make(I)(OS.Time)(Clock)(Random) - module D = Dhcp_clientv4.Make(C)(OS.Time)(Random)(E)(I)(U) + module D = Dhcp_clientv4.Make(C)(OS.Time)(Random)(U) let or_error c name fn t = fn t @@ -20,7 +20,7 @@ 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 -> @@ -36,7 +36,7 @@ module Main (C: CONSOLE) (N: NETWORK) = struct or_error c "UDPv4" U.connect i >>= fun udp -> - let dhcp, offers = D.create c i udp in + let dhcp, offers = D.create c (E.mac e) udp in or_error c "TCPv4" T.connect i >>= fun tcp -> From 237dcc9c3f741f9f037e5e1bf2ef1f8f59937198 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Thu, 11 Dec 2014 01:30:50 -0300 Subject: [PATCH 4/7] Add one more missing `MacOSX match case --- kv_ro/config.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From 9db647883461d334d87506e0b3b03a4f7ad43c0e Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Sat, 13 Dec 2014 11:28:16 -0300 Subject: [PATCH 5/7] ping: fix debug output --- ping/unikernel.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ping/unikernel.ml b/ping/unikernel.ml index 83c2667f..7fbc3f73 100644 --- a/ping/unikernel.ml +++ b/ping/unikernel.ml @@ -32,8 +32,8 @@ module Main (C:CONSOLE) (N:NETWORK) = struct >>= 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 From 9fc5c81d51d484112593357cb8ec304b85767d60 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Sat, 13 Dec 2014 11:29:42 -0300 Subject: [PATCH 6/7] Add Ipv6 version of `ping` --- ping6/config.ml | 8 ++++++++ ping6/unikernel.ml | 51 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+) create mode 100644 ping6/config.ml create mode 100644 ping6/unikernel.ml 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 From f0292da11ea73f46b7cc37dfbba266ca5b0d6536 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Sat, 13 Dec 2014 11:37:34 -0300 Subject: [PATCH 7/7] ping: add `tcpip` as opam dependency --- ping/config.ml | 1 + 1 file changed, 1 insertion(+) 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 ]