Simple multi-client server in OCaml with Lwt

Category: OCaml

Lwt is a popular cooperative multitasking library for OCaml.

There are a number of Lwt tutorials and examples around, but for some reason I couldn't find any that would explain how to write a server that serves multiple connections concurrently (as opposed to sending a reply and terminating the connection, like HTTP servers do).

While it seems obvious once you figured it out, it took me a while to figure it out, so I wrote a simple example and a walkthrough.

The server from the example allows clients to increment a shared counter and read its value.

Download the file: counter-server.ml.

Prerequisites

We will need the Lwt package and also the Logs package for logging.

opam install lwt logs

Code walkthrough

We start with opening the Lwt module so we have easy access to bind, return, and other essential functions.

open Lwt

The server will keep a shared mutable counter. Clients will be able to read or increment it.

let counter = ref 0

We'll make the server listen on 127.0.0.1:9000.

let listen_address = Unix.inet_addr_loopback
let port = 9000
let backlog = 10

We accepts two commands from clients: read , that returns the current value of the counter; and inc , that increments it and sends a confirmation. Any other command will trigger Unknown command reply.

All context switches occur between Lwt binds, so we don't need to care about locking the counter explicitly.

let handle_message msg =
    match msg with
    | "read" -> string_of_int !counter
    | "inc"  -> counter := !counter + 1; "Counter has been incremented"
    | _      -> "Unknown command"

Threads that serve client connections need to read from the socket, process commands, and then read again. We'll make it a tail-recursive loop, essentially read >>= process >>= write >>= read .

We need to take care of closed connections though. Reading from a closed connection will raise an End_of_file exception. We could handle it, or we can use the Lwt_io.read_line_opt : input_channel -> string option Lwt.t function that returns None rather than raising an exception if the channel is closed.

Then we can terminate the thread if it returns None , and proceed otherwise.

let rec handle_connection ic oc () =
    Lwt_io.read_line_opt ic >>=
    (fun msg ->
        match msg with
        | Some msg -> 
            let reply = handle_message msg in
            Lwt_io.write_line oc reply >>= handle_connection ic oc
        | None -> Logs_lwt.info (fun m -> m "Connection closed") >>= return)

When a connection comes in, we need to start a handle_connection thread. We don't care about its result, but we should do something about errors that may occur, so we start it with Lwt.on_failure function that also takes a callback that is executed when exception occurs. We'll just make it log the exceptions.

let accept_connection conn =
    let fd, _ = conn in
    let ic = Lwt_io.of_fd Lwt_io.Input fd in
    let oc = Lwt_io.of_fd Lwt_io.Output fd in
    Lwt.on_failure (handle_connection ic oc ()) (fun e -> Logs.err (fun m -> m "%s" (Printexc.to_string e) ));
    Logs_lwt.info (fun m -> m "New connection") >>= return

We also need a thread that accepts connections in a loop. We'll store the socket in a closure. When a client connects, it will pass the file descriptor to the accept_connection function will start a thread that serves that client.

let create_server sock =
    let rec serve () =
        Lwt_unix.accept sock >>= accept_connection >>= serve
    in serve

Socket setup is straightforward.

let create_socket () =
    let open Lwt_unix in
    let sock = socket PF_INET SOCK_STREAM 0 in
    bind sock @@ ADDR_INET(listen_address, port);
    listen sock backlog;
    sock

Note: Lwt_unix.bind return type is unit Lwt.t rather than unit, so this is a bit sloppy and will cause a compiler warning.

Now we have everything we need. All we need to start working is to start the server thread with Lwt_main.run .

let () =
    let sock = create_socket () in
    let serve = create_server sock in
    Lwt_main.run @@ serve ()

Now we can build it with ocamlfind ocamlopt -package lwt,lwt.unix,logs,logs.lwt -linkpkg -o counter-server ./counter-server.ml, start the executable, and start a few telnet sessions to 127.0.0.1:9000 to test it.

Example of a telnet session:

$ telnet localhost 9000
Trying 127.0.0.1... Connected to localhost.
Escape character is '^]'.
read
0
inc
Counter has been incremented
read
1

This page was last modified: 2019-02-23