1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
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
|
