diff --git a/.github/opam/liquidsoap-core-windows.opam b/.github/opam/liquidsoap-core-windows.opam index 1c4fe41ab6..56743f4143 100644 --- a/.github/opam/liquidsoap-core-windows.opam +++ b/.github/opam/liquidsoap-core-windows.opam @@ -118,7 +118,7 @@ conflicts: [ "shine-windows" {< "0.2.0"} "soundtouch-windows" {< "0.1.9"} "speex-windows" {< "0.4.0"} - "srt-windows" {< "0.3.2"} + "srt-windows" {< "0.3.3"} "ssl-windows" {< "0.5.2"} "sdl-liquidsoap-windows" {< "2"} "tsdl-image-windows" {< "0.3.2"} diff --git a/.github/opam/packages/posix-base-windows/posix-base-windows.2.2.0/opam b/.github/opam/packages/posix-base-windows/posix-base-windows.2.2.0/opam new file mode 100644 index 0000000000..734ae9c068 --- /dev/null +++ b/.github/opam/packages/posix-base-windows/posix-base-windows.2.2.0/opam @@ -0,0 +1,33 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Bindings for posix sockets" +description: + "posix-socket provides the types and bindings of posix sockets APIs available on both unix and windows." +maintainer: ["romain.beauxis@gmail.com"] +authors: ["Romain Beauxis"] +license: "MIT" +homepage: "https://github.com/savonet/ocaml-posix" +bug-reports: "https://github.com/savonet/ocaml-posix/issues" +depends: [ + "dune" {>= "2.9"} + "ocaml-windows" + "ctypes" + "ctypes-windows" +] +build: [ + [ + "dune" + "build" + "-p" + "posix-base" + "-x" + "windows" + "-j" + jobs + "@install" + ] +] +dev-repo: "git+https://github.com/savonet/ocaml-posix.git" +url { + src: "https://github.com/savonet/ocaml-posix/archive/main.tar.gz" +} diff --git a/.github/opam/packages/posix-socket/posix-socket-windows.2.2.0/opam b/.github/opam/packages/posix-socket/posix-socket-windows.2.2.0/opam new file mode 100644 index 0000000000..b589e6b3dd --- /dev/null +++ b/.github/opam/packages/posix-socket/posix-socket-windows.2.2.0/opam @@ -0,0 +1,33 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Bindings for posix sockets" +description: + "posix-socket provides the types and bindings of posix sockets APIs available on both unix and windows." +maintainer: ["romain.beauxis@gmail.com"] +authors: ["Romain Beauxis"] +license: "MIT" +homepage: "https://github.com/savonet/ocaml-posix" +bug-reports: "https://github.com/savonet/ocaml-posix/issues" +depends: [ + "dune" {>= "2.9"} + "ocaml-windows" + "ctypes" + "ctypes-windows" +] +build: [ + [ + "dune" + "build" + "-p" + "posix-socket" + "-x" + "windows" + "-j" + jobs + "@install" + ] +] +dev-repo: "git+https://github.com/savonet/ocaml-posix.git" +url { + src: "https://github.com/savonet/ocaml-posix/archive/main.tar.gz" +} diff --git a/.github/opam/packages/srt-windows/srt-windows.0.3.3/opam b/.github/opam/packages/srt-windows/srt-windows.0.3.3/opam new file mode 100644 index 0000000000..5201c6ae37 --- /dev/null +++ b/.github/opam/packages/srt-windows/srt-windows.0.3.3/opam @@ -0,0 +1,43 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Binding for the Secure, Reliable, Transport protocol library" +description: """ +Secure Reliable Transport (SRT) is an open source transport technology +that optimizes streaming performance across unpredictable networks, such +as the Internet. +This package provides OCaml bindings to the C implementation library. +""" +maintainer: ["The Savonet Team "] +authors: ["The Savonet Team "] +license: "GPL-2.0-only" +homepage: "https://github.com/savonet/ocaml-srt" +bug-reports: "https://github.com/savonet/ocaml-srt/issues" +depends: [ + "conf-pkg-config" {build} + "dune" {> "2.0"} + "dune-configurator" {build} + "ctypes-foreign-windows" + "integers-windows" + "posix-socket-windows" {>= "2.2.0"} + "posix-socket" +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + "srt" + "-x" + "windows" + "-j" + jobs + "@install" + ] +] +depexts: [ + ["libsrt"] {os-distribution = "mxe"} +] +url { + src: "https://github.com/savonet/ocaml-srt/archive/main.tar.gz" +} diff --git a/.github/scripts/build-win32.sh b/.github/scripts/build-win32.sh index 70aaef12c6..79f274a27e 100755 --- a/.github/scripts/build-win32.sh +++ b/.github/scripts/build-win32.sh @@ -45,8 +45,16 @@ echo "::group::Installing deps" eval "$(opam config env)" opam repository set-url windows https://github.com/ocaml-cross/opam-cross-windows.git -opam update -opam install -y srt-windows.0.3.2 +opam update windows + +cd /tmp +rm -rf ocaml-posix +git clone https://github.com/savonet/ocaml-posix.git +cd ocaml-posix +opam pin -ny . +opam install -y posix-socket.2.2.0 posix-base.2.2.0 + +opam install -y srt-windows.0.3.3 echo "::endgroup::" diff --git a/CHANGES.md b/CHANGES.md index d73994e98f..6aac1ae208 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -27,6 +27,8 @@ Changed: option (#3906) - Add full explicit support for `ipv4` vs. `ipv6` resolution in SRT inputs and outputs, add global `settings.srt.prefer_address` and `settings.icecast.prefer_address` (#4317) +- Added generic SRT socket get/set API. Added new socket options, including `latency` + and `ipv6only`. Fixed: diff --git a/src/core/builtins/builtins_srt.ml b/src/core/builtins/builtins_srt.ml index 9a2cafe0a3..f2d83d4f17 100644 --- a/src/core/builtins/builtins_srt.ml +++ b/src/core/builtins/builtins_srt.ml @@ -28,18 +28,37 @@ exception Done exception Not_connected module Socket_value = struct - let read_only_socket_options_specs = [("read_data", `Int Srt.rcvdata)] + let read_only_socket_options_specs = [("rcvdata", `Int Srt.rcvdata)] + + let write_only_socket_options_specs = + [ + ("messageapi", `Bool Srt.messageapi); + ("payloadsize", `Int Srt.payloadsize); + ("conntimeo", `Int Srt.conntimeo); + ("passphrase", `String Srt.passphrase); + ("enforced_encryption", `Bool Srt.enforced_encryption); + ] let read_write_socket_options_specs = [ - ("read_timeout", `Int Srt.rcvtimeo); - ("write_timeout", `Int Srt.sndtimeo); + ("rcvsyn", `Bool Srt.rcvsyn); + ("sndsyn", `Bool Srt.sndsyn); + ("rcvtimeout", `Int Srt.rcvtimeo); + ("sndtimeout", `Int Srt.sndtimeo); + ("reuseaddr", `Bool Srt.reuseaddr); + ("rcvbuf", `Int Srt.rcvbuf); + ("sndbuf", `Int Srt.sndbuf); + ("udp_rcvbuf", `Int Srt.udp_rcvbuf); + ("udp_sndbuf", `Int Srt.udp_sndbuf); ("streamid", `String Srt.streamid); ("pbkeylen", `Int Srt.pbkeylen); - ("read_latency", `Int Srt.rcvlatency); + ("ipv6only", `Bool Srt.ipv6only); + ("rcvlatency", `Int Srt.rcvlatency); + ("peerlatency", `Int Srt.peerlatency); + ("latency", `Int Srt.latency); ] - let mk_socket_option name socket_opt = + let mk_read_socket_option name socket_opt = let t = match socket_opt with | `Int _ -> Lang.int_t @@ -61,12 +80,52 @@ module Socket_value = struct let bt = Printexc.get_raw_backtrace () in Lang.raise_as_runtime ~bt ~kind:"srt" exn) ) + let mk_write_socket_option name socket_opt = + let t = + match socket_opt with + | `Int _ -> Lang.int_t + | `Bool _ -> Lang.bool_t + | `String _ -> Lang.string_t + in + ( "set_" ^ name, + ([], Lang.fun_t [(false, "", t)] Lang.unit_t), + "Set " ^ name ^ " option", + fun s -> + Lang.val_fun + [("", "", None)] + (fun p -> + let v = List.assoc "" p in + try + (match socket_opt with + | `Int socket_opt -> + Srt.setsockflag s socket_opt (Lang.to_int v) + | `Bool socket_opt -> + Srt.setsockflag s socket_opt (Lang.to_bool v) + | `String socket_opt -> + Srt.setsockflag s socket_opt (Lang.to_string v)); + Lang.unit + with exn -> + let bt = Printexc.get_raw_backtrace () in + Lang.raise_as_runtime ~bt ~kind:"srt" exn) ) + let socket_options_meths = + let read_meths = + List.fold_left + (fun cur (name, socket_opt) -> + mk_read_socket_option name socket_opt :: cur) + (List.fold_left + (fun cur (name, socket_opt) -> + mk_read_socket_option name socket_opt :: cur) + [] read_only_socket_options_specs) + read_write_socket_options_specs + in List.fold_left - (fun cur (name, socket_opt) -> mk_socket_option name socket_opt :: cur) + (fun cur (name, socket_opt) -> + mk_write_socket_option name socket_opt :: cur) (List.fold_left - (fun cur (name, socket_opt) -> mk_socket_option name socket_opt :: cur) - [] read_only_socket_options_specs) + (fun cur (name, socket_opt) -> + mk_write_socket_option name socket_opt :: cur) + read_meths write_only_socket_options_specs) read_write_socket_options_specs let stats_specs = @@ -263,6 +322,10 @@ module Socket_value = struct let meths = socket_options_meths @ [ + ( "id", + ([], Lang.int_t), + "Socket ID", + fun s -> Lang.int (Srt.socket_id s) ); ( "status", ([], Lang.fun_t [] Lang.string_t), "Socket status", @@ -327,9 +390,22 @@ module Socket_value = struct (List.map (fun (n, _, fn) -> (n, fn stats)) stats_specs)) ); ] + let base_t = t + let t = Lang.method_t t (List.map (fun (lbl, t, descr, _) -> (lbl, t, descr)) meths) + let to_base_value = to_value + let to_value s = Lang.meth (to_value s) (List.map (fun (lbl, _, _, m) -> (lbl, m s)) meths) end + +let srt = Lang.add_module "srt" + +let clock = + Lang.add_builtin "socket" ~base:srt ~category:`Liquidsoap + ~descr:"Decorate a srt socket with all its methods." + [("", Socket_value.base_t, None, None)] + Socket_value.t + (fun p -> Socket_value.(to_value (of_value (List.assoc "" p)))) diff --git a/src/core/io/srt_io.ml b/src/core/io/srt_io.ml index 5e8ebbdfa2..2b17037dc9 100644 --- a/src/core/io/srt_io.ml +++ b/src/core/io/srt_io.ml @@ -26,6 +26,7 @@ exception Done exception Not_connected type prefer_address = [ `System_default | `Ipv4 | `Ipv6 ] +type socket_mode = [ `Connect | `Listen | `Incoming | `Close ] let conf_srt = Dtools.Conf.void ~p:(Configure.conf#plug "srt") "SRT configuration" @@ -134,7 +135,7 @@ let common_options ~mode = (false, "hs_version", Lang.int_t); (false, "peeraddr", Lang.string_t); (false, "streamid", Lang.nullable_t Lang.string_t); - (false, "", Builtins_srt.Socket_value.t); + (false, "", Builtins_srt.Socket_value.base_t); ] Lang.bool_t), Some Lang.null, @@ -191,13 +192,22 @@ let common_options ~mode = "Preferred address type when resolving hostnames. One of: \ `\"system\"`, `\"ipv4\"` or `\"ipv6\"`. Defaults to global \ `srt.prefer_connection` settings when `null`." ); - ( "ipv6only", - Lang.nullable_t Lang.bool_t, + ( "on_socket", + Lang.nullable_t + (Lang.fun_t + [ + (false, "mode", Lang.string_t); + (false, "", Builtins_srt.Socket_value.base_t); + ] + Lang.unit_t), Some Lang.null, Some - "If `true`, binding to the ipv6 wildcard address `::` will bind to \ - both IPv6 and IPv4 wildcard address. Defaults to system default when \ - `null`." ); + "Callback executed when a new SRT socket is created to set additional \ + options, add monitoring, etc. `mode` should be one of: `\"connect\"` \ + (socket created before connecting to a remote address), `\"listen\"` \ + (socket created before binding for receiving new incoming \ + connections), `\"incoming\"` (socket received as incoming connection) \ + or `\"close\"` (socket is about to closed)." ); ( "polling_delay", Lang.float_t, Some (Lang.float 2.), @@ -239,7 +249,7 @@ let meth () = ( [], Lang.fun_t [] (Lang.list_t - (Lang.product_t Lang.string_t Builtins_srt.Socket_value.t)) ), + (Lang.product_t Lang.string_t Builtins_srt.Socket_value.base_t)) ), "List of `(connected_address, connected_socket)`", fun s -> Lang.val_fun [] (fun _ -> @@ -248,7 +258,7 @@ let meth () = (fun (origin, s) -> Lang.product (Lang.string (Utils.name_of_sockaddr origin)) - (Builtins_srt.Socket_value.to_value s)) + (Builtins_srt.Socket_value.to_base_value s)) s#get_sockets)) ); ] @@ -258,7 +268,7 @@ type common_options = { port : int; bind_address : string; prefer_address : [ `System_default | `Ipv4 | `Ipv6 ]; - ipv6only : bool option; + on_socket : mode:socket_mode -> Srt.socket -> unit; listen_callback : Srt.listen_callback option; streamid : string option; pbkeylen : int option; @@ -290,7 +300,25 @@ let parse_common_options p = (Error.Invalid_value (v, "Valid values are: `\"system\"`, `\"ipv4\"` or `\"ipv6\"`.")) in - let ipv6only = Lang.to_valued_option Lang.to_bool (List.assoc "ipv6only" p) in + let on_socket = + match Lang.to_option (List.assoc "on_socket" p) with + | None -> fun ~mode:_ _ -> () + | Some fn -> + fun ~mode s -> + let mode = + match mode with + | `Connect -> "connect" + | `Listen -> "listen" + | `Incoming -> "incoming" + | `Close -> "close" + in + ignore + (Lang.apply fn + [ + ("mode", Lang.string mode); + ("", Builtins_srt.Socket_value.to_base_value s); + ]) + in let passphrase_v = List.assoc "passphrase" p in let passphrase = Lang.to_valued_option Lang.to_string passphrase_v in (match passphrase with @@ -323,7 +351,7 @@ let parse_common_options p = match streamid with | None -> Lang.null | Some s -> Lang.string s ); - ("", Builtins_srt.Socket_value.to_value socket); + ("", Builtins_srt.Socket_value.to_base_value socket); ])) (Lang.to_option fn) in @@ -351,7 +379,7 @@ let parse_common_options p = port = Lang.to_int (List.assoc "port" p); bind_address; prefer_address; - ipv6only; + on_socket; listen_callback; pbkeylen; enforced_encryption; @@ -472,18 +500,19 @@ let string_of_address = function | Unix.ADDR_INET (addr, port) -> Printf.sprintf "%s:%d" (Unix.string_of_inet_addr addr) port -let mk_socket ~payload_size ~ipv6only ~messageapi () = +let mk_socket ~mode ~on_socket ~payload_size ~messageapi () = let s = Srt.create_socket () in Srt.setsockflag s Srt.payloadsize payload_size; Srt.setsockflag s Srt.transtype `Live; Srt.setsockflag s Srt.messageapi messageapi; Srt.setsockflag s Srt.enforced_encryption conf_enforced_encryption#get; - (match ipv6only with - | None -> () - | Some v -> Srt.setsockflag s Srt.ipv6only v); + on_socket ~mode s; s -let close_socket s = Srt.close s +let close_socket ~on_socket s = + on_socket ~mode:`Close s; + Srt.close s + let shutdown = Atomic.make false let () = @@ -542,8 +571,9 @@ let () = ToDisconnect.iter (fun s -> s#disconnect) to_disconnect) class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid - ~polling_delay ~payload_size ~messageapi ~hostname ~port ~prefer_address - ~connection_timeout ~read_timeout ~write_timeout ~on_connect ~on_disconnect = + ~polling_delay ~payload_size ~messageapi ~on_socket ~hostname ~port + ~prefer_address ~connection_timeout ~read_timeout ~write_timeout ~on_connect + ~on_disconnect = object (self) method virtual id : string method virtual should_stop : bool @@ -566,8 +596,10 @@ class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid self#log#important "Connecting to srt://%s:%d.." hostname port; (match Atomic.exchange socket None with | None -> () - | Some (_, s) -> close_socket s); - let s = mk_socket ~ipv6only:None ~payload_size ~messageapi () in + | Some (_, s) -> close_socket ~on_socket s); + let s = + mk_socket ~mode:`Connect ~on_socket ~payload_size ~messageapi () + in try Srt.setsockflag s Srt.sndsyn true; Srt.setsockflag s Srt.rcvsyn true; @@ -621,7 +653,7 @@ class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid (match Atomic.exchange socket None with | None -> () | Some (_, socket) -> - close_socket socket; + close_socket ~on_socket socket; !on_disconnect ()); Atomic.set task_should_stop true; match connect_task with @@ -633,7 +665,7 @@ class virtual caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid class virtual listener ~enforced_encryption ~pbkeylen ~passphrase ~max_clients ~listen_callback ~payload_size ~messageapi ~bind_address ~port ~prefer_address - ~ipv6only ~read_timeout ~write_timeout ~on_connect ~on_disconnect () = + ~on_socket ~read_timeout ~write_timeout ~on_connect ~on_disconnect () = object (self) val mutable client_sockets = [] method virtual id : string @@ -652,7 +684,9 @@ class virtual listener ~enforced_encryption ~pbkeylen ~passphrase ~max_clients match Atomic.get listening_socket with | Some s -> s | None -> ( - let s = mk_socket ~payload_size ~ipv6only ~messageapi () in + let s = + mk_socket ~mode:`Listen ~on_socket ~payload_size ~messageapi () + in try Srt.bind_posix_socket s (getaddrinfo ~log:self#log ~prefer_address bind_address port); @@ -717,8 +751,9 @@ class virtual listener ~enforced_encryption ~pbkeylen ~passphrase ~max_clients Utils.optional_apply (fun v -> Srt.(setsockflag client rcvtimeo v)) read_timeout; + on_socket ~mode:`Incoming client; if self#should_stop then ( - close_socket client; + close_socket ~on_socket client; raise Done); self#mutexify (fun () -> @@ -742,12 +777,12 @@ class virtual listener ~enforced_encryption ~pbkeylen ~passphrase ~max_clients let should_stop = self#should_stop in self#mutexify (fun () -> - List.iter (fun (_, s) -> close_socket s) client_sockets; + List.iter (fun (_, s) -> close_socket ~on_socket s) client_sockets; client_sockets <- []; (match (should_stop, Atomic.get listening_socket) with | true, Some s -> Poll.remove_socket s; - close_socket s; + close_socket ~on_socket s; Atomic.set listening_socket None | _ -> ()); !on_disconnect ()) @@ -872,7 +907,7 @@ class virtual input_base ~max ~self_sync ~on_connect ~on_disconnect end class input_listener ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback - ~bind_address ~port ~prefer_address ~ipv6only ~max ~payload_size ~self_sync + ~bind_address ~port ~prefer_address ~on_socket ~max ~payload_size ~self_sync ~on_connect ~on_disconnect ~read_timeout ~write_timeout ~messageapi ~dump ~on_start ~on_stop ~autostart format = object (self) @@ -884,7 +919,7 @@ class input_listener ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback inherit listener ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback - ~max_clients:(Some 1) ~bind_address ~port ~prefer_address ~ipv6only + ~max_clients:(Some 1) ~bind_address ~port ~prefer_address ~on_socket ~payload_size ~read_timeout ~write_timeout ~messageapi ~on_connect ~on_disconnect () @@ -898,7 +933,7 @@ class input_listener ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback class input_caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid ~polling_delay ~hostname ~port ~prefer_address ~max ~payload_size ~self_sync ~on_connect ~on_disconnect ~read_timeout ~write_timeout ~connection_timeout - ~messageapi ~dump ~on_start ~on_stop ~autostart format = + ~messageapi ~dump ~on_socket ~on_start ~on_stop ~autostart format = object (self) inherit input_base @@ -910,7 +945,7 @@ class input_caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid ~enforced_encryption ~pbkeylen ~passphrase ~streamid ~polling_delay ~hostname ~port ~prefer_address ~payload_size ~read_timeout ~write_timeout ~connection_timeout ~messageapi ~on_connect - ~on_disconnect + ~on_disconnect ~on_socket method get_sockets = match self#get_socket with s -> [s] | exception Not_found -> [] @@ -959,7 +994,7 @@ let _ = pbkeylen; passphrase; bind_address; - ipv6only; + on_socket; listen_callback; polling_delay; read_timeout; @@ -993,7 +1028,7 @@ let _ = | `Listener -> (new input_listener ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback - ~bind_address ~port ~prefer_address ~ipv6only ~read_timeout + ~bind_address ~port ~prefer_address ~on_socket ~read_timeout ~write_timeout ~payload_size ~self_sync ~on_connect ~on_disconnect ~messageapi ~max ~dump ~on_start ~on_stop ~autostart format @@ -1005,7 +1040,7 @@ let _ = ~polling_delay ~hostname ~port ~prefer_address ~payload_size ~self_sync ~on_connect ~read_timeout ~write_timeout ~connection_timeout ~on_disconnect ~messageapi ~max ~dump - ~on_start ~on_stop ~autostart format + ~on_start ~on_socket ~on_stop ~autostart format :> < Start_stop.active_source ; get_sockets : (Unix.sockaddr * Srt.socket) list >)) @@ -1102,9 +1137,9 @@ class virtual output_base ~payload_size ~messageapi ~on_start ~on_stop class output_caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid ~polling_delay ~payload_size ~messageapi ~on_start ~on_stop ~infallible - ~register_telnet ~autostart ~on_connect ~on_disconnect ~prefer_address ~port - ~hostname ~read_timeout ~write_timeout ~connection_timeout ~encoder_factory - source = + ~register_telnet ~autostart ~on_socket ~on_connect ~on_disconnect + ~prefer_address ~port ~hostname ~read_timeout ~write_timeout + ~connection_timeout ~encoder_factory source = object (self) inherit output_base @@ -1116,7 +1151,7 @@ class output_caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid ~enforced_encryption ~pbkeylen ~passphrase ~streamid ~polling_delay ~hostname ~port ~prefer_address ~payload_size ~read_timeout ~write_timeout ~connection_timeout ~messageapi ~on_connect - ~on_disconnect + ~on_disconnect ~on_socket method private get_sockets = try [self#get_socket] with Not_connected -> [] @@ -1133,7 +1168,7 @@ class output_caller ~enforced_encryption ~pbkeylen ~passphrase ~streamid class output_listener ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback ~max_clients ~payload_size ~messageapi ~on_start ~on_stop ~infallible ~register_telnet ~autostart ~on_connect ~on_disconnect - ~bind_address ~port ~prefer_address ~ipv6only ~read_timeout ~write_timeout + ~bind_address ~port ~prefer_address ~on_socket ~read_timeout ~write_timeout ~encoder_factory source = object (self) inherit @@ -1143,7 +1178,7 @@ class output_listener ~enforced_encryption ~pbkeylen ~passphrase inherit listener - ~bind_address ~port ~prefer_address ~ipv6only ~payload_size + ~bind_address ~port ~prefer_address ~on_socket ~payload_size ~read_timeout ~write_timeout ~messageapi ~on_connect ~on_disconnect ~enforced_encryption ~pbkeylen ~passphrase ~listen_callback ~max_clients () @@ -1155,7 +1190,7 @@ class output_listener ~enforced_encryption ~pbkeylen ~passphrase (Printexc.to_string exn)); self#mutexify (fun () -> - close_socket socket; + close_socket ~on_socket socket; client_sockets <- List.filter (fun (_, s) -> s <> socket) client_sockets) () @@ -1192,7 +1227,7 @@ let _ = pbkeylen; passphrase; bind_address; - ipv6only; + on_socket; listen_callback; polling_delay; read_timeout; @@ -1236,13 +1271,13 @@ let _ = ~polling_delay ~hostname ~port ~prefer_address ~payload_size ~autostart ~on_start ~on_stop ~read_timeout ~write_timeout ~connection_timeout ~infallible ~register_telnet ~messageapi - ~encoder_factory ~on_connect ~on_disconnect source + ~encoder_factory ~on_socket ~on_connect ~on_disconnect source :> < Output.output ; get_sockets : (Unix.sockaddr * Srt.socket) list >) | `Listener -> (new output_listener ~enforced_encryption ~pbkeylen ~passphrase ~bind_address ~port - ~prefer_address ~ipv6only ~read_timeout ~write_timeout + ~prefer_address ~on_socket ~read_timeout ~write_timeout ~payload_size ~autostart ~on_start ~on_stop ~infallible ~register_telnet ~messageapi ~encoder_factory ~on_connect ~on_disconnect ~listen_callback ~max_clients source