robur/miou-solo5
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

.

Browse source
This commit is contained in:
Calascibetta Romain 2024-12-08 17:00:01 +01:00
parent 158205dc91
commit d12818ce05
7 changed files with 148 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
lib/miou_solo5.default.ml
View file

@ -11,7 +11,7 @@ module Json = struct
| In_object of (string * t) list * stack
| Empty
end
let encode ?minify ?(size_chunk = 0x800) ~output t =
let encoder = Jsonm.encoder ?minify `Manual in
let buf = Bytes.create size_chunk in
@ -51,9 +51,8 @@ end
let to_json = function
| `Block name ->
`O [ "name", `String name; "type", `String "BLOCK_BASIC" ]
| `Net name ->
`O [ "name", `String name; "type", `String "NET_BASIC" ]
`O [ ("name", `String name); ("type", `String "BLOCK_BASIC") ]
| `Net name -> `O [ ("name", `String name); ("type", `String "NET_BASIC") ]
module Net = struct
type t = int
@ -107,18 +106,24 @@ let const _ = Args []
type t = [ `Block of string | `Net of string ]
let collect devices =
let rec go : type k res. t list -> (k, res) devices -> t list = fun acc -> function
| [] -> List.rev acc
| Block name :: rest -> go (`Block name :: acc) rest
| Net name :: rest -> go (`Net name :: acc) rest
| Args vs :: rest -> go (go acc vs) rest in
let rec go : type k res. t list -> (k, res) devices -> t list =
fun acc -> function
| [] -> List.rev acc
| Block name :: rest -> go (`Block name :: acc) rest
| Net name :: rest -> go (`Net name :: acc) rest
| Args vs :: rest -> go (go acc vs) rest
in
go [] devices
let run ?g:_ args _fn =
let devices = collect args in
let v =
`O List.[ "type", `String "solo5.manifest"
; "version", `Float 1.0
; "devices", `A (List.map to_json devices) ] in
`O
List.
[
("type", `String "solo5.manifest"); ("version", `Float 1.0)
; ("devices", `A (List.map to_json devices))
]
in
let output str = output_string stdout str in
Json.encode ~output v; exit 0

80
lib/stubs.solo5.c
View file

@ -1,8 +1,8 @@
#include "solo5.h"
#include <caml/bigarray.h>
#include <caml/memory.h>
#include <caml/callback.h>
#include <caml/memory.h>
#include <string.h>
/* We currently have no need for these functions. They consist of releasing the
@ -22,7 +22,8 @@ extern void caml_leave_blocking_section(void);
* solo5_handle_set_t, which can only contain file-descriptors with a value
* between 0 and 63. */
value miou_solo5_block_acquire(value vname, value vhandle, value vlen, value vpage) {
value miou_solo5_block_acquire(value vname, value vhandle, value vlen,
value vpage) {
CAMLparam4(vname, vhandle, vlen, vpage);
solo5_result_t result;
solo5_handle_t handle;
@ -31,9 +32,9 @@ value miou_solo5_block_acquire(value vname, value vhandle, value vlen, value vpa
result = solo5_block_acquire(String_val(vname), &handle, &bi);
if (result == SOLO5_R_OK) {
memcpy(Bytes_val(vhandle), (uint64_t *) &handle, sizeof(uint64_t));
memcpy(Bytes_val(vlen), (uint64_t *) &bi.capacity, sizeof(uint64_t));
memcpy(Bytes_val(vpage), (uint64_t *) &bi.block_size, sizeof(uint64_t));
memcpy(Bytes_val(vhandle), (uint64_t *)&handle, sizeof(uint64_t));
memcpy(Bytes_val(vlen), (uint64_t *)&bi.capacity, sizeof(uint64_t));
memcpy(Bytes_val(vpage), (uint64_t *)&bi.block_size, sizeof(uint64_t));
}
CAMLreturn(Val_long(result));
@ -59,7 +60,8 @@ intnat miou_solo5_block_write(intnat fd, intnat off, intnat len, value vbstr) {
return result;
}
value miou_solo5_net_acquire(value vname, value vhandle, value vmac, value vmtu) {
value miou_solo5_net_acquire(value vname, value vhandle, value vmac,
value vmtu) {
CAMLparam3(vname, vmac, vmtu);
solo5_result_t result;
solo5_handle_t handle;
@ -68,9 +70,9 @@ value miou_solo5_net_acquire(value vname, value vhandle, value vmac, value vmtu)
result = solo5_net_acquire(String_val(vname), &handle, &ni);
if (result == SOLO5_R_OK) {
memcpy(Bytes_val(vhandle), (uint64_t *) &handle, sizeof(uint64_t));
memcpy(Bytes_val(vhandle), (uint64_t *)&handle, sizeof(uint64_t));
memcpy(Bytes_val(vmac), ni.mac_address, SOLO5_NET_ALEN);
memcpy(Bytes_val(vmtu), (uint64_t *) &ni.mtu, sizeof(uint64_t));
memcpy(Bytes_val(vmtu), (uint64_t *)&ni.mtu, sizeof(uint64_t));
}
CAMLreturn(Val_long(result));
@ -83,7 +85,7 @@ value miou_solo5_net_acquire(value vname, value vhandle, value vmac, value vmtu)
* like the poor man's C-style reference passage in OCaml. */
value miou_solo5_net_read(intnat fd, intnat off, intnat len, value vread_size,
value vbstr) {
value vbstr) {
CAMLparam1(vread_size);
solo5_handle_t handle = fd;
size_t size = len;
@ -112,31 +114,61 @@ intnat miou_solo5_yield(intnat ts) {
}
#ifndef __unused
# if defined(_MSC_VER) && _MSC_VER >= 1500
# define __unused(x) __pragma( warning (push) ) \
__pragma( warning (disable:4189 ) ) \
x \
__pragma( warning (pop))
# else
# define __unused(x) x __attribute__((unused))
# endif
#if defined(_MSC_VER) && _MSC_VER >= 1500
#define __unused(x) \
__pragma(warning(push)) __pragma(warning(disable : 4189)) x __pragma( \
warning(pop))
#else
#define __unused(x) x __attribute__((unused))
#endif
#endif
#define __unit() value __unused(unit)
intnat miou_solo5_clock_monotonic(__unit ()) {
intnat miou_solo5_clock_monotonic(__unit()) {
return (solo5_clock_monotonic());
}
intnat miou_solo5_clock_wall(__unit ()) {
return (solo5_clock_wall());
}
intnat miou_solo5_clock_wall(__unit()) { return (solo5_clock_wall()); }
extern void _nolibc_init(uintptr_t, size_t);
static char *unused_argv[] = { "uniker.ml", NULL };
static char *unused_argv[] = {"uniker.ml", NULL};
static const char *cmdline = "";
static char *strdup(const char *s) {
size_t l = strlen(s);
char *d = malloc(l + 1);
if (!d)
return NULL;
return memcpy(d, s, l + 1);
}
static char *split(const char *s, char *dst[], size_t len) {
int i = 0;
char *rem = strdup(s);
char *str = rem;
while (rem != NULL && *rem != '\0' && i < len) {
char *e = strstr(rem, " ");
dst[i++] = rem;
if (e != NULL) {
*e = '\0';
while (*(++e) == ' ')
;
}
rem = e;
}
return str;
}
int solo5_app_main(const struct solo5_start_info *si) {
char *cmdline[64] = {NULL};
cmdline[0] = "uniker.ml";
int solo5_app_main(const struct solo5_start_info *si) {
_nolibc_init(si->heap_start, si->heap_size);
caml_startup(unused_argv);
char *tmp = split(si->cmdline, cmdline + 1, 62);
caml_startup(cmdline);
free(tmp);
return (0);
}

4
test/block.ml
View file

@ -1,7 +1,9 @@
let cachet_of_block ~cachesize blk () =
let map blk ~pos len =
let bstr = Bigarray.(Array1.create char c_layout len) in
Miou_solo5.Block.read blk ~off:pos bstr; bstr in
Miou_solo5.Block.read blk ~off:pos bstr;
bstr
in
let pagesize = Miou_solo5.Block.pagesize blk in
Cachet.make ~cachesize ~pagesize ~map blk

30
test/cmdline.ml Normal file
View file

@ -0,0 +1,30 @@
let run foo bar =
Miou_solo5.(run []) @@ fun () ->
let argv = Array.to_list Sys.argv in
Fmt.pr "%s\n%!" (String.concat " " argv);
Fmt.pr "foo: %a\n%!" Fmt.(Dump.option (fmt "%S")) foo;
Fmt.pr "bar: %a\n%!" Fmt.(Dump.option (fmt "%S")) bar
open Cmdliner
let foo =
let doc = "Foo" in
let open Arg in
value & opt (some string) None & info [ "foo" ] ~doc
let bar =
let doc = "Bar" in
let open Arg in
value & opt (some string) None & info [ "bar" ] ~doc
let term =
let open Term in
const run $ foo $ bar
let cmd =
let doc = "A simple unikernel to test the command-line." in
let man = [] in
let info = Cmd.info "cmd" ~doc ~man in
Cmd.v info term
let () = Cmd.(exit @@ eval cmd)

36
test/dune
View file

@ -28,6 +28,16 @@
(language c)
(names manifest.block)))
(executable
(name cmdline)
(modules cmdline)
(modes native)
(link_flags :standard -cclib "-z solo5-abi=hvt")
(libraries miou-solo5 cmdliner fmt)
(foreign_stubs
(language c)
(names manifest.cmdline)))
(rule
(targets manifest.sleep.c)
(deps sleep.json)
@ -100,7 +110,31 @@
(action
(write-file manifest.block.c "")))
(rule
(targets manifest.cmdline.c)
(deps cmdline.json)
(enabled_if
(= %{context_name} "solo5"))
(action
(run solo5-elftool gen-manifest cmdline.json manifest.cmdline.c)))
(rule
(targets cmdline.json)
(enabled_if
(= %{context_name} "solo5"))
(action
(with-stdout-to
cmdline.json
(run %{exe:cmdline.exe}))))
(rule
(targets manifest.cmdline.c)
(enabled_if
(= %{context_name} "default"))
(action
(write-file manifest.cmdline.c "")))
(cram
(enabled_if
(= %{context_name} "solo5"))
(deps sleep.exe schedule.exe block.exe simple.txt))
(deps sleep.exe schedule.exe block.exe simple.txt cmdline.exe))

5
test/none.json
View file

@ -1,5 +0,0 @@
{
"type": "solo5.manifest",
"version": 1,
"devices": []
}

46
test/run.t
View file

@ -1,47 +1,15 @@
Tests some simple unikernels
$ solo5-hvt sleep.exe
| ___|
__| _ \ | _ \ __ \
\__ \ ( | | ( | ) |
____/\___/ _|\___/____/
Solo5: Bindings version v0.9.0
Solo5: Memory map: 512 MB addressable:
Solo5: reserved @ (0x0 - 0xfffff)
Solo5: text @ (0x100000 - 0x1bafff)
Solo5: rodata @ (0x1bb000 - 0x1eafff)
Solo5: data @ (0x1eb000 - 0x250fff)
Solo5: heap >= 0x251000 < stack < 0x20000000
$ solo5-hvt sleep.exe --solo5:quiet
Hello
World
Solo5: solo5_exit(0) called
$ solo5-hvt schedule.exe
| ___|
__| _ \ | _ \ __ \
\__ \ ( | | ( | ) |
____/\___/ _|\___/____/
Solo5: Bindings version v0.9.0
Solo5: Memory map: 512 MB addressable:
Solo5: reserved @ (0x0 - 0xfffff)
Solo5: text @ (0x100000 - 0x1bafff)
Solo5: rodata @ (0x1bb000 - 0x1eafff)
Solo5: data @ (0x1eb000 - 0x250fff)
Solo5: heap >= 0x251000 < stack < 0x20000000
$ solo5-hvt schedule.exe --solo5:quiet
Hello
World
Solo5: solo5_exit(0) called
$ chmod +w simple.txt
$ solo5-hvt-debug --block:simple=simple.txt --block-sector-size:simple=512 block.exe
| ___|
__| _ \ | _ \ __ \
\__ \ ( | | ( | ) |
____/\___/ _|\___/____/
Solo5: Bindings version v0.9.0
Solo5: Memory map: 512 MB addressable:
Solo5: reserved @ (0x0 - 0xfffff)
Solo5: text @ (0x100000 - 0x1c5fff)
Solo5: rodata @ (0x1c6000 - 0x1f7fff)
Solo5: data @ (0x1f8000 - 0x267fff)
Solo5: heap >= 0x268000 < stack < 0x20000000
$ solo5-hvt --block:simple=simple.txt --block-sector-size:simple=512 block.exe --solo5:quiet
00000000: 94a3b2375dd8aa75e3d2cdef54179909
00000200: 5e00b6c8f387deac083b9718e08a361b
Solo5: solo5_exit(0) called
$ solo5-hvt cmdline.exe --solo5:quiet --foo Foo --bar Bar
uniker.ml --foo Foo --bar Bar
foo: Some "Foo"
bar: Some "Bar"