QEMU/KVM virtual machine management via QMP
feat(qemu,pid1,space): two-VM infrastructure with chardev, IPC, and cross-build
Add chardev/channel/socket-serial support to ocaml-qemu so QEMU VMs
can expose virtio-serial IPC ports and redirect consoles to Unix
sockets. Update pid1 init to read IPC frames from P0 and store them
as events in the block device. Add Block.of_file ?sectors override
for Linux block devices that report st_size=0. Wire up space build
and run commands for the two-partition (P0 flight + P1 SpaceOS) demo
with Docker cross-compilation of both binaries.
+44
-3
+37
-2
lib/vm.ml
+37
-2
lib/vm.ml
···
33
33
| Vnc of { port : int }
34
34
| Spice of { port : int }
35
35
36
+
type chardev_backend = Socket of { path : string; server : bool }
37
+
type chardev = { id : string; backend : chardev_backend }
38
+
type channel = { chardev_id : string; name : string }
39
+
36
40
type t = {
37
41
name : string;
38
42
arch : arch;
···
48
52
network : network;
49
53
display : display;
50
54
qmp_socket : string;
51
-
serial : [ `Stdio | `Pty | `None ];
55
+
serial : [ `Stdio | `Pty | `None | `Socket of string ];
56
+
chardevs : chardev list;
57
+
channels : channel list;
52
58
extra_args : string list;
53
59
}
54
60
···
92
98
display = None;
93
99
qmp_socket = Fmt.str "/tmp/qemu-%s.sock" name;
94
100
serial = `Stdio;
101
+
chardevs = [];
102
+
channels = [];
95
103
extra_args = [];
96
104
}
97
105
···
117
125
{ t with accel = (if enable_kvm then KVM else TCG) }
118
126
119
127
let with_serial serial t = { t with serial }
128
+
let with_chardev chardev t = { t with chardevs = t.chardevs @ [ chardev ] }
129
+
130
+
let with_channel ~chardev_id ~name t =
131
+
{ t with channels = t.channels @ [ { chardev_id; name } ] }
132
+
120
133
let with_extra_args extra_args t = { t with extra_args }
121
134
let with_qmp_socket qmp_socket t = { t with qmp_socket }
122
135
···
181
194
| Vnc { port } -> add2 "-vnc" (Fmt.str ":%d" port)
182
195
| Spice { port } ->
183
196
add2 "-spice" (Fmt.str "port=%d,disable-ticketing=on" port));
197
+
(* Chardevs *)
198
+
List.iter
199
+
(fun (cd : chardev) ->
200
+
match cd.backend with
201
+
| Socket { path; server } ->
202
+
let server_s = if server then ",server=on,wait=off" else "" in
203
+
add2 "-chardev"
204
+
(Fmt.str "socket,id=%s,path=%s%s" cd.id path server_s))
205
+
t.chardevs;
206
+
(* Virtio-serial bus + ports (only if channels present) *)
207
+
if t.channels <> [] then
208
+
add2 "-device" (Fmt.str "virtio-serial-%s" (virtio_suffix t));
209
+
List.iter
210
+
(fun (ch : channel) ->
211
+
add2 "-device"
212
+
(Fmt.str "virtserialport,chardev=%s,name=%s" ch.chardev_id ch.name))
213
+
t.channels;
184
214
(* Serial *)
185
215
(match t.serial with
186
216
| `Stdio -> add2 "-serial" "stdio"
187
217
| `Pty -> add2 "-serial" "pty"
188
-
| `None -> ());
218
+
| `None -> ()
219
+
| `Socket path ->
220
+
let id = "console" in
221
+
add2 "-chardev"
222
+
(Fmt.str "socket,id=%s,path=%s,server=on,wait=off" id path);
223
+
add2 "-serial" (Fmt.str "chardev:%s" id));
189
224
(* QMP socket *)
190
225
add2 "-qmp" (Fmt.str "unix:%s,server,nowait" t.qmp_socket);
191
226
(* Extra args *)
+7
-1
lib/vm.mli
+7
-1
lib/vm.mli
···
35
35
| Vnc of { port : int }
36
36
| Spice of { port : int }
37
37
38
+
type chardev_backend = Socket of { path : string; server : bool }
39
+
type chardev = { id : string; backend : chardev_backend }
40
+
type channel = { chardev_id : string; name : string }
41
+
38
42
type t
39
43
(** VM configuration *)
40
44
···
64
68
Use {!with_accel} instead. [with_kvm true] sets KVM, [with_kvm false]
65
69
sets TCG. *)
66
70
67
-
val with_serial : [ `Stdio | `Pty | `None ] -> t -> t
71
+
val with_serial : [ `Stdio | `Pty | `None | `Socket of string ] -> t -> t
72
+
val with_chardev : chardev -> t -> t
73
+
val with_channel : chardev_id:string -> name:string -> t -> t
68
74
val with_extra_args : string list -> t -> t
69
75
val with_qmp_socket : string -> t -> t
70
76