Materials for the LambdaNantes 4 workshop: An Introduction to Unikernels with OCaml!
A very Poor First Example
+187
+1
dune-project
+1
dune-project
+4
lib/dune
+4
lib/dune
+51
lib/util.ml
+51
lib/util.ml
···
1
+
let init_rng () =
2
+
Mkernel.map
3
+
(fun () ->
4
+
Mirage_crypto_rng_mkernel.initialize (module Mirage_crypto_rng.Fortuna))
5
+
[]
6
+
;;
7
+
8
+
let ( let@ ) finally fn = Fun.protect ~finally fn
9
+
let clean_rng rng () = Mirage_crypto_rng_mkernel.kill rng
10
+
let clean_stack stack () = Mnet.kill stack
11
+
12
+
let respond_file f req _server _state =
13
+
let open Vifu.Response.Syntax in
14
+
let source = Flux.Source.list f in
15
+
let* () = Vifu.Response.with_source req source in
16
+
Vifu.Response.respond `OK
17
+
;;
18
+
19
+
let respond_html f req server state =
20
+
let document = state |> f in
21
+
let open Vifu.Response.Syntax in
22
+
let* () = Vifu.Response.with_tyxml req document in
23
+
Vifu.Response.respond `OK
24
+
;;
25
+
26
+
let page ~doctitle content =
27
+
let open Tyxml_html in
28
+
html
29
+
~a:[ a_lang "en" ]
30
+
(head
31
+
(title (txt doctitle))
32
+
[ link ~rel:[ `Stylesheet ] ~href:"/style.css" () ])
33
+
(body content)
34
+
;;
35
+
36
+
let application
37
+
?(port = 80)
38
+
?(name = "service")
39
+
?(prefix = "10.0.0.2/24")
40
+
rng
41
+
routes
42
+
state
43
+
=
44
+
let ipv4 = Ipaddr.V4.Prefix.of_string_exn prefix in
45
+
Mkernel.run
46
+
[ rng; Mnet.stack ~name ipv4 ]
47
+
(fun rng (stack, tcp, _udp) () ->
48
+
let@ () = clean_rng rng in
49
+
let@ () = clean_stack stack in
50
+
Vifu.run ~cfg:(Vifu.Config.v port) tcp routes state)
51
+
;;
+41
lib/util.mli
+41
lib/util.mli
···
1
+
(** [init_rng ()] initializes the random number generator. *)
2
+
val init_rng : unit -> Mirage_crypto_rng_mkernel.rng Mkernel.arg
3
+
4
+
(** An helper for finalizing resources (because Miou, the Scheduler, ask
5
+
for every task to be terminated) *)
6
+
val ( let@ ) : (unit -> unit) -> (unit -> 'a) -> 'a
7
+
8
+
val clean_rng : Mirage_crypto_rng_mkernel.rng -> unit -> unit
9
+
val clean_stack : Mnet.stack -> unit -> unit
10
+
11
+
val respond_file
12
+
: string list
13
+
-> ('a, 'b) Vifu.Request.t
14
+
-> 'c
15
+
-> 'd
16
+
-> (Vifu.Response.empty, Vifu.Response.sent, unit) Vifu.Response.t
17
+
18
+
val respond_html
19
+
: ('a -> Tyxml_html.doc)
20
+
-> ('b, 'c) Vifu.Request.t
21
+
-> 'd
22
+
-> 'a
23
+
-> (Vifu.Response.empty, Vifu.Response.sent, unit) Vifu.Response.t
24
+
25
+
val page
26
+
: doctitle:string
27
+
-> [< Html_types.flow5 ] Tyxml_html.elt list
28
+
-> [> Html_types.html ] Tyxml_html.elt
29
+
30
+
val application
31
+
: ?port:int
32
+
-> ?name:string
33
+
-> ?prefix:string
34
+
-> Mirage_crypto_rng_mkernel.rng Mkernel.arg
35
+
-> (Vifu.Server.t
36
+
-> 'a
37
+
-> (Vifu.Response.empty, Vifu.Response.sent, unit) Vifu.Response.t)
38
+
Vifu.Route.t
39
+
list
40
+
-> 'a
41
+
-> unit
+1
unikernels.opam
+1
unikernels.opam
+31
unikernels/tinyred/dune
+31
unikernels/tinyred/dune
···
1
+
(executable
2
+
(name main)
3
+
(package unikernels)
4
+
(public_name unikernels.tinyred)
5
+
(link_flags :standard -cclib "-z solo5-abi=hvt")
6
+
(foreign_stubs
7
+
(language c)
8
+
(names tinyred_manifest))
9
+
(libraries mkernel mirage-crypto-rng-mkernel mnet gmp vifu tyxml unikernels.util)
10
+
(modules main documents))
11
+
12
+
(rule
13
+
(targets tinyred_manifest.c)
14
+
(deps tinyred_manifest.json)
15
+
(enabled_if
16
+
(= %{context_name} "solo5"))
17
+
(action
18
+
(run solo5-elftool gen-manifest tinyred_manifest.json tinyred_manifest.c)))
19
+
20
+
(rule
21
+
(targets tinyred_manifest.c)
22
+
(enabled_if
23
+
(= %{context_name} "default"))
24
+
(action
25
+
(write-file tinyred_manifest.c "")))
26
+
27
+
(rule
28
+
(targets documents.ml)
29
+
(deps style.css)
30
+
(action
31
+
(run mcrunch --list --file style_css:style.css -o documents.ml)))
+51
unikernels/tinyred/main.ml
+51
unikernels/tinyred/main.ml
···
1
+
open Util
2
+
3
+
let rng = init_rng ()
4
+
5
+
let index =
6
+
respond_html (fun _ ->
7
+
let open Tyxml_html in
8
+
page ~doctitle:"Tinyred" [ h1 [ txt "Tinyred" ]; p [ txt "Hello !" ] ])
9
+
;;
10
+
11
+
let store req id url _ table =
12
+
let open Vifu.Response.Syntax in
13
+
let () = Hashtbl.add table id url in
14
+
let* () = Vifu.Response.with_string req "Done" in
15
+
Vifu.Response.redirect_to req Vifu.Uri.(rel /?? any)
16
+
;;
17
+
18
+
let redirect req id server table =
19
+
match Hashtbl.find_opt table id with
20
+
| Some url ->
21
+
let open Vifu.Response.Syntax in
22
+
let* () = Vifu.Response.with_string req "Done" in
23
+
Vifu.Response.redirect_to req Vifu.Uri.(host ("http://" ^ url) /?? any)
24
+
| None ->
25
+
respond_html
26
+
(fun _ ->
27
+
let open Tyxml_html in
28
+
page
29
+
~doctitle:"Tinyred"
30
+
[ h1 [ txt "Tinyred" ]
31
+
; p [ txt @@ "The id " ^ id ^ " does not exists" ]
32
+
])
33
+
req
34
+
server
35
+
table
36
+
;;
37
+
38
+
let routes =
39
+
let open Vifu.Uri in
40
+
let open Vifu.Route in
41
+
[ get (rel /?? any) --> index
42
+
; get (rel / "new" /% string `Path /% string `Path /?? any) --> store
43
+
; get (rel / "u" /% string `Path /?? any) --> redirect
44
+
; get (rel / "style.css" /?? any) --> respond_file Documents.style_css
45
+
]
46
+
;;
47
+
48
+
let () =
49
+
let table = Hashtbl.create 10 in
50
+
application rng routes table
51
+
;;
+6
unikernels/tinyred/style.css
+6
unikernels/tinyred/style.css
+1
unikernels/tinyred/tinyred_manifest.json
+1
unikernels/tinyred/tinyred_manifest.json
···
1
+
{"type":"solo5.manifest","version":1,"devices":[{"type":"NET_BASIC","name":"service"}]}