Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Added example with echo/discard/chargen services. #52

Merged
merged 3 commits into from

2 participants

@yomimono

Create an examples/ directory containing sample code for a unikernel with simple echo/discard/chargen TCP services running on ports 7, 9, and 19.

@avsm
Owner

Perfect. I can hook these into Travis to build-test as well. We'll need to replicate these to mirage-skeleton as well, but old-fashioned copying is probably better than messing around with git-submodules for now.

@avsm
Owner

Another thought: why don't we install these as actual libraries with the rest of the TCP/IP stack (off by default)? They do, after all, implement 3 RFCs, and are helpful to ensure basic functionality works.

examples/services.ml
((23 lines not shown))
+ let rec discard c flow =
+ S.TCPV4.read flow >>= fun result -> (
+ match result with
+ | `Eof -> report_and_close c flow "Discard connection closing normally."
+ | `Error _ -> report_and_close c flow "Discard connection read error;
+ closing."
+ | _ -> discard c flow
+ )
+
+
+ let rec echo c flow =
+ S.TCPV4.read flow >>= fun result -> (
+ match result with
+ | `Eof -> report_and_close c flow "Echo connection closure initiated."
+ | `Error e ->
+ let message = (
@avsm Owner
avsm added a note

minor style: no need for brackets here.

let message =
  match ... with
  | ... ->
  | ... ->
in

(you can use ocp-indent to help with this)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/services.ml
((31 lines not shown))
+
+
+ let rec echo c flow =
+ S.TCPV4.read flow >>= fun result -> (
+ match result with
+ | `Eof -> report_and_close c flow "Echo connection closure initiated."
+ | `Error e ->
+ let message = (
+ match e with
+ | `Timeout -> "Echo connection timed out; closing.\n"
+ | `Refused -> "Echo connection refused; closing.\n"
+ | `Unknown s -> (Printf.sprintf "Echo connection error: %s\n" s)
+ ) in
+ report_and_close c flow message
+ | `Ok buf ->
+ S.TCPV4.write flow buf >> echo c flow
@avsm Owner
avsm added a note

subjective style: the >> operator is actually a camlp4 extension that expands to >>= fun () ->

since camlp4 is slowly being deprecated, we've started to prefer not using >> in new code, and just doing the "raw" version instead (>>= fun () ->) even though it's more verbose.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
@yomimono

Thanks for the feedback - I implemented the style changes you mentioned. (I especially appreciate the note on >>; I'd noticed a lot of >>= fun () -> in the existing code but didn't realize the reason for it.)

Are the existing names OK if we move them to lib/? If so, I'll move 'em over.

@avsm
Owner

I can't think of a better name (these are "troubleshooting" protocols" I guess?). Installing them as a library but not hooked into the stack by default is best (but perhaps instantiate them in examples/ as is down now)

@avsm
Owner

I'm going ahead and merging these into 1.1.5 in examples, as they can be installed as libraries in a later release. They're useful to have as-is!

@avsm avsm merged commit 7a82935 into mirage:master

1 check passed

Details continuous-integration/travis-ci The Travis CI build passed
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
Showing with 90 additions and 0 deletions.
  1. +28 −0 examples/config.ml
  2. +62 −0 examples/services.ml
View
28 examples/config.ml
@@ -0,0 +1,28 @@
+open Mirage
+
+let main = foreign "Services.Main" (console @-> stackv4 @-> job)
+
+let net =
+ try match Sys.getenv "NET" with
+ | "direct" -> `Direct
+ | "socket" -> `Socket
+ | _ -> `Direct
+ with Not_found -> `Direct
+
+let dhcp =
+ try match Sys.getenv "ADDR" with
+ | "dhcp" -> `Dhcp
+ | "static" -> `Static
+ | _ -> `Dhcp
+ with Not_found -> `Dhcp
+
+let stack console =
+ match net, dhcp with
+ | `Direct, `Dhcp -> direct_stackv4_with_dhcp console tap0
+ | `Direct, `Static -> direct_stackv4_with_default_ipv4 console tap0
+ | `Socket, _ -> socket_stackv4 console [Ipaddr.V4.any]
+
+let () =
+ register "services" [
+ main $ default_console $ stack default_console
+ ]
View
62 examples/services.ml
@@ -0,0 +1,62 @@
+open Lwt
+open V1_LWT
+
+module Main (C: V1_LWT.CONSOLE) (S: V1_LWT.STACKV4) = struct
+ let report_and_close c flow message =
+ C.log c message;
+ S.TCPV4.close flow
+
+ let rec chargen flow how_many start_at =
+ let charpool =
+ "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~ "
+ in
+ let make_chars how_many start_at =
+ let buf = Io_page.(to_cstruct (get 1)) in
+ let output = (String.sub (charpool ^ charpool) start_at how_many) ^ "\n" in
+ Cstruct.blit_from_string output 0 buf 0 (String.length output);
+ Cstruct.set_len buf (String.length output)
+ in
+
+ S.TCPV4.write flow (make_chars how_many start_at) >>= fun () ->
+ chargen flow how_many ((start_at + 1) mod (String.length charpool))
+
+ let rec discard c flow =
+ S.TCPV4.read flow >>= fun result -> (
+ match result with
+ | `Eof -> report_and_close c flow "Discard connection closing normally."
+ | `Error _ -> report_and_close c flow "Discard connection read error;
+ closing."
+ | _ -> discard c flow
+ )
+
+
+ let rec echo c flow =
+ S.TCPV4.read flow >>= fun result -> (
+ match result with
+ | `Eof -> report_and_close c flow "Echo connection closure initiated."
+ | `Error e ->
+ let message =
+ match e with
+ | `Timeout -> "Echo connection timed out; closing.\n"
+ | `Refused -> "Echo connection refused; closing.\n"
+ | `Unknown s -> (Printf.sprintf "Echo connection error: %s\n" s)
+ in
+ report_and_close c flow message
+ | `Ok buf ->
+ S.TCPV4.write flow buf >>= fun () -> echo c flow
+ )
+
+ let start c s =
+ (* RFC 862 - read payloads and repeat them back *)
+ S.listen_tcpv4 s ~port:7 (echo c);
+
+ (* RFC 863 - discard all incoming data and never write a payload *)
+ S.listen_tcpv4 s ~port:9 (discard c);
+
+ (* RFC 864 - write data without regard for input *)
+ S.listen_tcpv4 s ~port:19 (fun flow -> chargen flow 75 0);
+
+ S.listen s
+
+end
+
Something went wrong with that request. Please try again.