gazagnaire.org
APID-based virtual switch for SpaceOS inter-guest routing
1open Space_wire
2
3let log_src = Logs.Src.create "space-net.switch"
4
5module Log = (val Logs.src_log log_src)
6
7type t = {
8 config : Config.t;
9 router : Router.t;
10 on_system : Msg.t -> Msg.t option;
11 on_uplink : Msg.t -> unit;
12 connections : (string, Connection.t) Hashtbl.t;
13 mutable running : bool;
14}
15
16let pp fmt t =
17 Fmt.pf fmt "Switch(%d tenants, %s)"
18 (List.length t.config.tenants)
19 t.config.socket_dir
20
21let default_on_system frame =
22 Log.info (fun m -> m "system frame: %a" Msg.pp frame);
23 None
24
25let default_on_uplink frame =
26 Log.info (fun m -> m "uplink frame: %a" Msg.pp frame)
27
28let v ~config ?(on_system = default_on_system) ?(on_uplink = default_on_uplink)
29 () =
30 let router = Router.of_config config in
31 {
32 config;
33 router;
34 on_system;
35 on_uplink;
36 connections = Hashtbl.create 16;
37 running = true;
38 }
39
40let connection t (tenant : Config.tenant) =
41 Hashtbl.find_opt t.connections tenant.name
42
43(** In v0, the frame carries a source APID in [frame.apid] and a destination
44 APID in [frame.reserved]. The source APID identifies the sending
45 application; the destination APID determines routing. *)
46
47let dest_apid (frame : Msg.t) = frame.reserved
48
49let handle_frame t conn frame =
50 let (frame : Msg.t) = frame in
51 let source = Connection.tenant conn in
52 (* 1. Validate version *)
53 if frame.version <> 0x01 then
54 Connection.write_error conn Unknown_version ~offending:frame
55 else
56 (* 2. Validate msg_type *)
57 match Msg.kind_of_int frame.msg_type with
58 | None -> Connection.write_error conn Unknown_type ~offending:frame
59 | Some _ -> (
60 (* 3. Validate source APID ownership *)
61 match Router.validate_source t.router ~source ~apid:frame.apid with
62 | Some (Apid_not_allocated _) ->
63 Connection.write_error conn Apid_not_allocated ~offending:frame
64 | Some (Policy_denied _) ->
65 Connection.write_error conn Apid_not_allocated ~offending:frame
66 | None -> (
67 (* 4. Route by destination APID (carried in reserved field) *)
68 let dest = dest_apid frame in
69 match Router.route t.router ~source ~dest_apid:dest with
70 | Error (Policy_denied { src_tenant; dest_apid }) ->
71 Log.warn (fun m ->
72 m "policy denied: %s -> APID %d" src_tenant dest_apid);
73 Connection.write_error conn Apid_not_allocated ~offending:frame
74 | Error (Apid_not_allocated { apid; tenant }) ->
75 Log.warn (fun m -> m "APID %d not allocated to %s" apid tenant);
76 Connection.write_error conn Apid_not_allocated ~offending:frame
77 | Ok (Router.Local dest_tenant) -> (
78 match connection t dest_tenant with
79 | Some dest_conn -> Connection.write_frame dest_conn frame
80 | None ->
81 Log.warn (fun m ->
82 m "dest %s not connected" dest_tenant.Config.name))
83 | Ok Router.System -> (
84 match t.on_system frame with
85 | Some response -> Connection.write_frame conn response
86 | None -> ())
87 | Ok Router.Uplink -> t.on_uplink frame
88 | Ok (Router.Drop reason) ->
89 Log.debug (fun m -> m "drop: %s (apid=%d)" reason dest)))
90
91let inject t frame =
92 let dest = dest_apid frame in
93 match Router.lookup t.router dest with
94 | Router.Local tenant -> (
95 match connection t tenant with
96 | Some conn -> Connection.write_frame conn frame
97 | None ->
98 Log.warn (fun m ->
99 m "inject: dest %s not connected" tenant.Config.name))
100 | Router.System -> ( match t.on_system frame with Some _ -> () | None -> ())
101 | Router.Uplink -> t.on_uplink frame
102 | Router.Drop reason ->
103 Log.debug (fun m -> m "inject drop: %s (apid=%d)" reason dest)
104
105let stop t = t.running <- false
106
107let run t ~sw ~net =
108 (try Unix.mkdir t.config.socket_dir 0o755
109 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
110 List.iter
111 (fun (tenant : Config.tenant) ->
112 let path = Config.socket_path t.config tenant in
113 Log.info (fun m -> m "listening for %s on %s" tenant.name path);
114 Connection.listen ~sw ~net ~path ~tenant
115 ~on_connect:(fun conn -> Hashtbl.replace t.connections tenant.name conn)
116 ~on_frame:(fun conn frame -> handle_frame t conn frame)
117 ~on_disconnect:(fun _conn ->
118 Log.info (fun m -> m "guest %s disconnected" tenant.name);
119 Hashtbl.remove t.connections tenant.name))
120 t.config.tenants
121
122let space_packet_uplink ~seq_count frame =
123 let apid = frame.Msg.apid in
124 if apid < 0 || apid > Space_packet.apid_max then None
125 else
126 let data =
127 let buf = Bytes.make Msg.frame_size '\x00' in
128 Wire.Codec.encode Msg.codec frame buf 0;
129 Bytes.unsafe_to_string buf
130 in
131 match
132 Space_packet.v ~packet_type:Telemetry ~apid ~sequence_flags:Unsegmented
133 ~sequence_count:(seq_count ()) data
134 with
135 | Ok pkt -> Some pkt
136 | Error _ -> None