1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
open Functoria
open Action.Syntax
open Astring
module Key = Mirage_key
module Log = Mirage_impl_misc.Log
let solo5_manifest_path = Fpath.v "manifest.json"
type solo5_target = [ `Virtio | `Muen | `Hvt | `Genode | `Spt ]
type xen_target = [ `Xen | `Qubes ]
type t = [ solo5_target | xen_target ]
let cast = function #t as t -> t | _ -> invalid_arg "not a solo5 target."
let build_packages =
[ Functoria.package ~min:"0.8.0" ~scope:`Switch ~build:true "ocaml-solo5" ]
let runtime_packages target =
match target with
| #solo5_target ->
[ Functoria.package ~min:"0.8.0" ~max:"0.9.0" "mirage-solo5" ]
| #xen_target -> [ Functoria.package ~min:"7.1.0" ~max:"8.0.0" "mirage-xen" ]
let packages target = build_packages @ runtime_packages target
let context_name _i = "solo5"
let build_context ?build_dir:_ i =
let profile_release = Dune.stanza "(profile release)" in
let build_context =
Dune.stanzaf
{|
(context (default
(name %s)
(host default)
(toolchain solo5)
(disable_dynamically_linked_foreign_archives true)
))
|}
(context_name i)
in
[ profile_release; build_context ]
let generate_manifest_json with_devices () =
Log.info (fun m -> m "generating manifest");
let networks =
List.map (fun n -> (n, `Network)) !Mirage_impl_network.all_networks
in
let blocks =
Hashtbl.fold
(fun k _v acc -> (k, `Block) :: acc)
Mirage_impl_block.all_blocks []
in
let to_string (name, typ) =
Fmt.str {json|{ "name": %S, "type": %S }|json} name
(match typ with `Network -> "NET_BASIC" | `Block -> "BLOCK_BASIC")
in
let devices =
if with_devices then List.map to_string (networks @ blocks) else []
in
let s = String.concat ~sep:", " devices in
let* () =
Action.with_output ~path:solo5_manifest_path
~purpose:"Solo5 application manifest file" (fun fmt ->
Fmt.pf fmt
{|{
"type": "solo5.manifest",
"version": 1,
"devices": [ %s ]
}
|}
s)
in
Action.write_file (Fpath.v "manifest.ml") ""
let configure i =
let name = Info.name i in
let target = Info.get i Key.target in
let* () =
match target with
| #solo5_target -> generate_manifest_json true ()
| #xen_target -> generate_manifest_json false ()
| _ -> assert false
in
match target with
| `Xen ->
let* () = Xen.configure_main_xl ~ext:"xl" i in
let* () = Xen.configure_main_xl ~substitutions:[] ~ext:"xl.in" i in
Libvirt.configure_main ~name
| `Virtio -> Libvirt.configure_virtio ~name
| _ -> Action.ok ()
let ext = function
| `Virtio -> ".virtio"
| `Muen -> ".muen"
| `Hvt -> ".hvt"
| `Genode -> ".genode"
| `Spt -> ".spt"
| `Xen | `Qubes -> ".xen"
| _ -> invalid_arg "solo5 bindings only defined for solo5 targets"
let main i = Fpath.(base (rem_ext (Info.main i)))
let out i =
let target = Info.get i Key.target in
let public_name =
match Info.output i with None -> Info.name i | Some o -> o
in
public_name ^ ext target
let rename i =
let out = out i in
let main = Fpath.to_string (main i) in
Dune.stanzaf
{|
(rule
(target %s)
(enabled_if (= %%{context_name} "%s"))
(deps %s.exe)
(action
(copy %s.exe %%{target})))
|}
out (context_name i) main main
let manifest _i =
Dune.stanzaf
{|
(rule
(targets manifest.c)
(deps manifest.json)
(action
(run solo5-elftool gen-manifest manifest.json manifest.c)))
|}
let solo5_abi = function
| #Key.mode_unix -> assert false
| #Key.mode_xen -> "xen"
| `Virtio -> "virtio"
| `Hvt -> "hvt"
| `Muen -> "muen"
| `Genode -> "genode"
| `Spt -> "spt"
let main i =
let libraries = Info.libraries i in
let flags = Mirage_dune.flags i in
let main = Fpath.to_string (main i) in
let target = Info.get i Key.target in
let pp_list f = Dune.compact_list f in
Dune.stanzaf
{|
(executable
(enabled_if (= %%{context_name} "%s"))
(name %s)
(modes (native exe))
(libraries %a)
(link_flags %a -cclib "-z solo5-abi=%s")
(modules (:standard \ %a manifest))
(foreign_stubs (language c) (names manifest))
)
|}
(context_name i) main (pp_list "libraries") libraries (pp_list "link_flags")
flags (solo5_abi target) Fpath.pp
(Fpath.rem_ext (Fpath.base (Info.config_file i)))
let subdir name s = Dune.stanzaf "(subdir %s\n %a)\n" name Dune.pp (Dune.v s)
let alias_override i =
Dune.stanzaf
{|
(alias
(name default)
(enabled_if (= %%{context_name} "%s"))
(deps (alias_rec all))
)
|}
(context_name i)
let dune i = [ main i; manifest i; rename i; alias_override i ]
let install i =
let target = Info.get i Key.target in
let name = Info.name i in
let out = out i in
let open Fpath in
let additional_artifacts =
match target with
| `Xen -> [ v (name ^ ".xl"); v (name ^ ".xl.in") ]
| _ -> []
in
Install.v ~bin:[ (v out, v out) ] ~etc:additional_artifacts ()