path: root/lib/transport.ml

module type TRANSPORT = sig
  include Configuration.CONFIGURABLE

  type t
  type connection

  val create : configuration -> t
  val listen : t -> unit
  val accept : t -> connection
  val input : connection -> in_channel
  val output : connection -> out_channel
end

module TCP : TRANSPORT = struct
  type configuration = {
    address_family : Unix.socket_domain;
    sockaddr : Unix.sockaddr;
  }

  type t = Unix.file_descr
  type connection = Unix.file_descr

  module Error = struct
    open Condition
    (* TODO: more structure *)
    let parse_error msg = condition "parse-error" msg empty
  end

  let sockaddr_of_fields = function
    | `Inet (addr, port) ->
        Ok
          {
            address_family = Unix.PF_INET;
            sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port);
          }
    | `Unix path ->
        Ok { address_family = Unix.PF_UNIX; sockaddr = Unix.ADDR_UNIX path }

  let parse sexp =
    let open Sexplib.Sexp in
    let errorf fmt = Printf.ksprintf (fun s -> Error s) fmt in
    let rec go addr port path = function
      | [] -> (
          match (addr, port, path) with
          | Some a, Some p, None -> sockaddr_of_fields (`Inet (a, p))
          | None, None, Some s -> sockaddr_of_fields (`Unix s)
          | None, None, None -> errorf "transport/tcp: no address fields"
          | _ ->
              errorf "transport/tcp: use (address + port) or (path), not both")
      | List [ Atom "address"; Atom a ] :: rest -> go (Some a) port path rest
      | List [ Atom "port"; Atom p ] :: rest -> (
          match int_of_string_opt p with
          | Some n -> go addr (Some n) path rest
          | None -> errorf "transport/tcp: invalid port: %s" p)
      | List [ Atom "path"; Atom p ] :: rest -> go addr port (Some p) rest
      | bad :: _ -> errorf "transport/tcp: unexpected: %s" (to_string bad)
    in
    match sexp with
    | List children -> go None None None children |> Result.map_error Error.parse_error
    | _ -> Error (Error.parse_error "transport/tcp: expected a list of fields")

  let string_of_sockaddr = function
    | Unix.ADDR_INET (host, port) ->
        Printf.sprintf "%s:%d" (Unix.string_of_inet_addr host) port
    | Unix.ADDR_UNIX path -> path

  let create { address_family; sockaddr } =
    let socket = Unix.socket address_family Unix.SOCK_STREAM 0 in
    Unix.setsockopt socket Unix.SO_REUSEADDR true;
    Unix.bind socket sockaddr;
    socket

  let listen fd =
    Unix.listen fd 5;
    Printf.printf "Listening on %s\n%!"
      (string_of_sockaddr (Unix.getsockname fd))

  let accept fd =
    let conn, _ = Unix.accept fd in
    conn

  let input = Unix.in_channel_of_descr
  let output = Unix.out_channel_of_descr
end