gazagnaire.org
APID-based virtual switch for SpaceOS inter-guest routing
1open Cmdliner
2open Space_net
3
4let log_src = Logs.Src.create "space-net"
5
6module Log = (val Logs.src_log log_src)
7
8(* ============================================================================
9 run — start the switch
10 ============================================================================ *)
11
12let v0_config socket_dir =
13 Config.
14 {
15 tenants =
16 [
17 {
18 name = "camera";
19 apids = apid_range 0x010 0x01F;
20 can_send_to = [ apid_range 0x020 0x02F ];
21 };
22 {
23 name = "processor";
24 apids = apid_range 0x020 0x02F;
25 can_send_to = [ apid_range 0x010 0x01F ];
26 };
27 { name = "spaceos"; apids = apid_range 0x030 0x03F; can_send_to = [] };
28 ];
29 socket_dir;
30 }
31
32let run socket_dir () =
33 Eio_main.run @@ fun env ->
34 Eio.Switch.run @@ fun sw ->
35 let net = Eio.Stdenv.net env in
36 let config = v0_config socket_dir in
37 let switch = Switch.v ~config () in
38 Log.app (fun m ->
39 m "space-net starting: %d tenants, socket_dir=%s"
40 (List.length config.tenants)
41 config.socket_dir);
42 Switch.run switch ~sw ~net
43
44let socket_dir_arg =
45 let doc = "Directory for per-guest Unix sockets." in
46 Arg.(
47 value & opt string "/tmp/space-net" & info [ "socket-dir" ] ~docv:"DIR" ~doc)
48
49let run_cmd =
50 let doc = "Start the APID virtual switch." in
51 let info = Cmd.info "run" ~doc in
52 Cmd.v info Term.(const run $ socket_dir_arg $ Vlog.setup "space-net")
53
54(* ============================================================================
55 inject — send a test frame
56 ============================================================================ *)
57
58let inject msg_type apid payload socket () =
59 Eio_main.run @@ fun _env ->
60 let typ =
61 match msg_type with
62 | "TM" | "tm" -> Space_wire.Msg.TM
63 | "TC" | "tc" -> Space_wire.Msg.TC
64 | "EVR" | "evr" -> Space_wire.Msg.EVR
65 | "DP" | "dp" -> Space_wire.Msg.DP
66 | "HEALTH" | "health" -> Space_wire.Msg.HEALTH
67 | "LOG" | "log" -> Space_wire.Msg.LOG
68 | s -> Fmt.failwith "unknown msg type: %s" s
69 in
70 let frame = Space_wire.Msg.v typ ~apid payload in
71 let buf = Bytes.make Space_wire.Msg.frame_size '\x00' in
72 Wire.Codec.encode Space_wire.Msg.codec frame buf 0;
73 let data = Bytes.unsafe_to_string buf in
74 let fd = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
75 (try
76 Unix.connect fd (Unix.ADDR_UNIX socket);
77 let _n = Unix.write_substring fd data 0 (String.length data) in
78 Fmt.pr "injected %a to %s@." Space_wire.Msg.pp frame socket
79 with Unix.Unix_error (e, _, _) ->
80 Fmt.epr "error: %s@." (Unix.error_message e);
81 exit 1);
82 Unix.close fd
83
84let msg_type_arg =
85 let doc = "Message type (TM, TC, EVR, DP, HEALTH, LOG)." in
86 Arg.(value & opt string "TM" & info [ "t"; "type" ] ~docv:"TYPE" ~doc)
87
88let apid_arg =
89 let doc = "APID (0-2047)." in
90 Arg.(value & opt int 0x010 & info [ "a"; "apid" ] ~docv:"APID" ~doc)
91
92let payload_arg =
93 let doc = "Frame payload string." in
94 Arg.(value & opt string "test" & info [ "p"; "payload" ] ~docv:"DATA" ~doc)
95
96let socket_arg =
97 let doc = "Path to guest Unix socket." in
98 Arg.(
99 required & opt (some string) None & info [ "s"; "socket" ] ~docv:"PATH" ~doc)
100
101let inject_cmd =
102 let doc = "Inject a test frame into a guest socket." in
103 let info = Cmd.info "inject" ~doc in
104 Cmd.v info
105 Term.(
106 const inject $ msg_type_arg $ apid_arg $ payload_arg $ socket_arg
107 $ Vlog.setup "space-net")
108
109(* ============================================================================
110 main
111 ============================================================================ *)
112
113let info =
114 let doc = "APID-based virtual switch for SpaceOS inter-guest routing" in
115 let man =
116 [
117 `S Manpage.s_description;
118 `P
119 "space-net is the APID virtual switch that routes 256-byte wire frames \
120 between guest VMs and space-dtn for uplink/downlink.";
121 `S Manpage.s_commands;
122 `P "$(b,space-net run) - Start the virtual switch";
123 `P "$(b,space-net inject) - Inject a test frame";
124 ]
125 in
126 Cmd.info "space-net" ~version:"0.1.0" ~doc ~man
127
128let default = Term.(ret (const (fun () -> `Help (`Pager, None)) $ const ()))
129
130let () =
131 let cmd = Cmd.group info ~default [ run_cmd; inject_cmd ] in
132 exit (Cmd.eval cmd)