A simple test with a block device

lib/miou_solo5.ml

@@ -49,7 +49,7 @@ external miou_solo5_net_acquire :
   -> bytes
   -> bytes
   -> bytes
-  -> (int[@untagged]) = "unimplemented" "miou_solo5_net_acquire"
+  -> int = "unimplemented" "miou_solo5_net_acquire"
 [@@noalloc]
 
 external miou_solo5_net_read :
@@ -58,7 +58,7 @@ external miou_solo5_net_read :
   -> (int[@untagged])
   -> (int[@untagged])
   -> bytes
-  -> (int[@untagged]) = "unimplemented" "miou_solo5_net_read"
+  -> int = "unimplemented" "miou_solo5_net_read"
 [@@noalloc]
 
 external miou_solo5_net_write :
@@ -74,7 +74,7 @@ external miou_solo5_block_acquire :
   -> bytes
   -> bytes
   -> bytes
-  -> (int[@untagged]) = "unimplemented" "miou_solo5_block_acquire"
+  -> int = "unimplemented" "miou_solo5_block_acquire"
 [@@noalloc]
 
 external miou_solo5_block_read :
@@ -102,6 +102,8 @@ let error_msgf fmt = Format.kasprintf (fun msg -> Error (`Msg msg)) fmt
 module Block_direct = struct
   type t = { handle: int; pagesize: int }
 
+  let pagesize { pagesize; _ } = pagesize
+
   let connect name =
     let handle = Bytes.make 8 '\000' in
     let _len = Bytes.make 8 '\000' in
@@ -112,7 +114,7 @@ module Block_direct = struct
         let _len = Int64.to_int (Bytes.get_int64_ne _len 0) in
         let pagesize = Int64.to_int (Bytes.get_int64_ne pagesize 0) in
         Ok { handle; pagesize }
-    | _ -> error_msgf "Impossible to connect the block-device %s" name
+    | errno -> error_msgf "Impossible to connect the block-device %s (%d)" name errno
 
   let unsafe_read t ~off bstr =
     match miou_solo5_block_read t.handle off t.pagesize bstr with

lib/miou_solo5.mli

@@ -144,6 +144,7 @@ end
 module Block : sig
   type t
 
+  val pagesize : t -> int
   val atomic_read : t -> off:int -> bigstring -> unit
   val atomic_write : t -> off:int -> bigstring -> unit
   val read : t -> off:int -> bigstring -> unit

lib/stubs.solo5.c

@@ -22,7 +22,7 @@ extern void caml_leave_blocking_section(void);
  * solo5_handle_set_t, which can only contain file-descriptors with a value
  * between 0 and 63. */
 
-intnat 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;
@@ -59,7 +59,7 @@ intnat miou_solo5_block_write(intnat fd, intnat off, intnat len, value vbstr) {
   return result;
 }
 
-intnat 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;
@@ -82,7 +82,7 @@ intnat miou_solo5_net_acquire(value vname, value vhandle, value vmac, value vmtu
  * small buffer and, on the OCaml side, we just need to read it. It's a bit
  * like the poor man's C-style reference passage in OCaml. */
 
-intnat miou_solo5_net_read(intnat fd, intnat off, intnat len, value vread_size,
+value miou_solo5_net_read(intnat fd, intnat off, intnat len, value vread_size,
                            value vbstr) {
   CAMLparam1(vread_size);
   solo5_handle_t handle = fd;

test/block.json

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

test/block.ml

@@ -0,0 +1,24 @@
+external unsafe_get_char : Miou_solo5.bigstring -> int -> char = "%caml_ba_ref_1"
+
+let bigstring_to_string v =
+  let len = Bigarray.Array1.dim v in
+  let res = Bytes.create len in
+  for i = 0 to len - 1 do
+    Bytes.set res i (unsafe_get_char v i)
+  done;
+  Bytes.unsafe_to_string res
+
+let () = Miou_solo5.(run [ block "simple" ]) @@ fun blk () ->
+  let pagesize = Miou_solo5.Block.pagesize blk in
+  let bstr = Bigarray.(Array1.create char c_layout pagesize) in
+  let prm = Miou.async @@ fun () ->
+    Miou_solo5.Block.atomic_read blk ~off:0 bstr;
+    let str = bigstring_to_string bstr in
+    let hash = Digest.string str in
+    Fmt.pr "%08x: %s\n%!" 0 (Digest.to_hex hash)
+  in
+  Miou_solo5.Block.atomic_read blk ~off:pagesize bstr;
+  let str = bigstring_to_string bstr in
+  let hash = Digest.string str in
+  Fmt.pr "%08x: %s\n%!" pagesize (Digest.to_hex hash);
+  Miou.await_exn prm

test/dune

@@ -16,6 +16,15 @@
  (libraries miou-solo5)
  (foreign_stubs (language c) (names manifest.schedule)))
 
+(executable
+ (name block)
+ (modules block)
+ (modes native)
+ (link_flags :standard -cclib "-z solo5-abi=hvt")
+ (enabled_if (= %{context_name} "solo5"))
+ (libraries miou-solo5 fmt hxd.core hxd.string)
+ (foreign_stubs (language c) (names manifest.block)))
+
 (rule
  (targets manifest.sleep.c)
  (deps none.json)
@@ -26,6 +35,11 @@
  (deps none.json)
  (action (run solo5-elftool gen-manifest none.json manifest.schedule.c)))
 
+(rule
+ (targets manifest.block.c)
+ (deps block.json)
+ (action (run solo5-elftool gen-manifest block.json manifest.block.c)))
+
 (cram
  (enabled_if (= %{context_name} "solo5"))
- (deps sleep.exe schedule.exe))
+ (deps sleep.exe schedule.exe block.exe simple.txt))

test/run.t

@@ -29,3 +29,19 @@ Tests some simple unikernels
   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
+  00000200: 5e00b6c8f387deac083b9718e08a361b
+  00000000: 94a3b2375dd8aa75e3d2cdef54179909
+  Solo5: solo5_exit(0) called