Skip to content

Commit

Permalink
update unikernel to recent mirage (#522)
Browse files Browse the repository at this point in the history
* update unikernel to recent mirage

* Add `opam-pin: false` to GH action unikernel build

Co-authored-by: Sora Morimoto <[email protected]>

---------

Co-authored-by: Reynir Björnsson <[email protected]>
Co-authored-by: Sora Morimoto <[email protected]>
  • Loading branch information
3 people authored Aug 8, 2024
1 parent 82bad3a commit f03cd0d
Show file tree
Hide file tree
Showing 3 changed files with 21 additions and 21 deletions.
1 change: 1 addition & 0 deletions .github/workflows/main.yml
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ jobs:
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: 4
opam-pin: false

- run: opam install mirage
- run: opam exec -- mirage configure -t ${{ matrix.mode }}
Expand Down
11 changes: 5 additions & 6 deletions examples/unikernel/config.ml
Original file line number Diff line number Diff line change
@@ -1,12 +1,11 @@
(* mirage >= 4.6.0 & < 4.7.0 *)

open Mirage

let main =
let packages = [ package ~min:"2.9.0" "ipaddr" ] in
foreign ~packages "Services.Main" (stackv4 @-> job)
main ~packages "Services.Main" (stackv4v6 @-> job)

let stack = generic_stackv4 default_network
let stack = generic_stackv4v6 default_network

let () =
register "services" [
main $ stack
]
let () = register "services" [ main $ stack ]
30 changes: 15 additions & 15 deletions examples/unikernel/services.ml
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
open Lwt.Infix

module Main (S: Mirage_stack.V4) = struct
module Main (S: Tcpip.Stack.V4V6) = struct
let report_and_close flow pp e message =
let ip, port = S.TCPV4.dst flow in
let ip, port = S.TCP.dst flow in
Logs.warn
(fun m -> m "closing connection from %a:%d due to error %a while %s"
Ipaddr.V4.pp ip port pp e message);
S.TCPV4.close flow
Ipaddr.pp ip port pp e message);
S.TCP.close flow

let rec chargen flow how_many start_at =
let charpool =
Expand All @@ -17,38 +17,38 @@ module Main (S: Mirage_stack.V4) = struct
Cstruct.of_string output
in

S.TCPV4.write flow (make_chars how_many start_at) >>= function
S.TCP.write flow (make_chars how_many start_at) >>= function
| Ok () ->
chargen flow how_many ((start_at + 1) mod (String.length charpool))
| Error e -> report_and_close flow S.TCPV4.pp_write_error e "writing in Chargen"
| Error e -> report_and_close flow S.TCP.pp_write_error e "writing in Chargen"

let rec discard flow =
S.TCPV4.read flow >>= fun result -> (
S.TCP.read flow >>= fun result -> (
match result with
| Error e -> report_and_close flow S.TCPV4.pp_error e "reading in Discard"
| Error e -> report_and_close flow S.TCP.pp_error e "reading in Discard"
| Ok `Eof -> report_and_close flow Fmt.string "end of file" "reading in Discard"
| Ok (`Data _) -> discard flow
)


let rec echo flow =
S.TCPV4.read flow >>= function
| Error e -> report_and_close flow S.TCPV4.pp_error e "reading in Echo"
S.TCP.read flow >>= function
| Error e -> report_and_close flow S.TCP.pp_error e "reading in Echo"
| Ok `Eof -> report_and_close flow Fmt.string "end of file" "reading in Echo"
| Ok (`Data buf) ->
S.TCPV4.write flow buf >>= function
S.TCP.write flow buf >>= function
| Ok () -> echo flow
| Error e -> report_and_close flow S.TCPV4.pp_write_error e "writing in Echo"
| Error e -> report_and_close flow S.TCP.pp_write_error e "writing in Echo"

let start s =
(* RFC 862 - read payloads and repeat them back *)
S.TCPV4.listen (S.tcpv4 s) ~port:7 echo;
S.TCP.listen (S.tcp s) ~port:7 echo;

(* RFC 863 - discard all incoming data and never write a payload *)
S.TCPV4.listen (S.tcpv4 s) ~port:9 discard;
S.TCP.listen (S.tcp s) ~port:9 discard;

(* RFC 864 - write data without regard for input *)
S.TCPV4.listen (S.tcpv4 s) ~port:19 (fun flow -> chargen flow 75 0);
S.TCP.listen (S.tcp s) ~port:19 (fun flow -> chargen flow 75 0);

S.listen s

Expand Down

0 comments on commit f03cd0d

Please sign in to comment.