36 lines
1.1 KiB
OCaml
36 lines
1.1 KiB
OCaml
|
open Lwt
|
||
|
|
open Lwt.Syntax
|
||
|
|
open Printf
|
||
|
|
|
||
|
|
let bind_sock addr port =
|
||
|
|
let open Lwt_unix in
|
||
|
|
|
||
|
|
let listener = socket PF_INET SOCK_STREAM 0 in
|
||
|
|
setsockopt listener SO_REUSEADDR true;
|
||
|
|
|
||
|
|
let* () = bind listener @@ ADDR_INET(Unix.inet_addr_of_string addr, port) in
|
||
|
|
listen listener 100;
|
||
|
|
return listener
|
||
|
|
|
||
|
|
let accept_connection (sock, addr) =
|
||
|
|
let (remote_ip, remote_port) = match addr with
|
||
|
|
| Unix.ADDR_INET (addr, port) -> Unix.string_of_inet_addr addr, port
|
||
|
|
| _ -> failwith "only ADDR_INET is supported"
|
||
|
|
in
|
||
|
|
|
||
|
|
let ic = Lwt_io.of_fd ~mode:Lwt_io.Input sock in
|
||
|
|
let oc = Lwt_io.of_fd ~mode:Lwt_io.Output sock in
|
||
|
|
on_failure (Connection.run ic oc) (fun err -> printf "error: %s\n%!" (Printexc.to_string err));
|
||
|
|
|
||
|
|
printf "new connection from %s:%d\n%!" remote_ip remote_port; return_unit
|
||
|
|
|
||
|
|
let accept_loop listener =
|
||
|
|
let rec accept () =
|
||
|
|
Lwt_unix.accept listener >>= accept_connection >>= accept
|
||
|
|
in accept
|
||
|
|
|
||
|
|
let listen addr port =
|
||
|
|
Lwt_main.run ((bind_sock addr port) >>= fun listener ->
|
||
|
|
printf "gateway is listening at %s:%d\n%!" addr port;
|
||
|
|
let accept = accept_loop listener in accept ())
|