UDP

libs/uv/uv.ml

@@ -200,10 +200,22 @@ type udp_read_cb = udp_message uv_result -> unit
 external udp_init : t_loop -> t_udp uv_result = "w_udp_init"
 external udp_bind_ipv4 : t_udp -> int -> int -> unit uv_result = "w_udp_bind_ipv4"
 external udp_bind_ipv6 : t_udp -> bytes -> int -> bool -> unit uv_result = "w_udp_bind_ipv6"
-external udp_send_ipv4 : t_udp -> bytes -> int -> int -> unit_cb -> unit uv_result = "w_udp_send_ipv4"
-external udp_send_ipv6 : t_udp -> bytes -> bytes -> int -> unit_cb -> unit uv_result = "w_udp_send_ipv6"
+external udp_send_ipv4 : t_udp -> bytes -> int -> int -> int -> int -> unit_cb -> unit uv_result = "w_udp_send_ipv4_bytecode" "w_udp_send_ipv4"
+external udp_send_ipv6 : t_udp -> bytes -> int -> int -> bytes -> int -> unit_cb -> unit uv_result = "w_udp_send_ipv6_bytecode" "w_udp_send_ipv6"
 external udp_recv_start : t_udp -> udp_read_cb -> unit uv_result = "w_udp_recv_start"
 external udp_recv_stop : t_udp -> unit uv_result = "w_udp_recv_stop"
+external udp_set_membership : t_udp -> string -> string -> bool -> unit uv_result = "w_udp_set_membership"
+external udp_close : t_udp -> unit_cb -> unit uv_result = "w_udp_close"
+external udp_getsockname : t_udp -> uv_ip_address_port uv_result = "w_udp_getsockname"
+external udp_set_broadcast : t_udp -> bool -> unit uv_result = "w_udp_set_broadcast"
+external udp_set_multicast_interface : t_udp -> string -> unit uv_result = "w_udp_set_multicast_interface"
+external udp_set_multicast_loopback : t_udp -> bool -> unit uv_result = "w_udp_set_multicast_loopback"
+external udp_set_multicast_ttl : t_udp -> int -> unit uv_result = "w_udp_set_multicast_ttl"
+external udp_set_ttl : t_udp -> int -> unit uv_result = "w_udp_set_ttl"
+external udp_get_recv_buffer_size : t_udp -> int = "w_udp_get_recv_buffer_size"
+external udp_get_send_buffer_size : t_udp -> int = "w_udp_get_send_buffer_size"
+external udp_set_recv_buffer_size : t_udp -> int -> int = "w_udp_set_recv_buffer_size"
+external udp_set_send_buffer_size : t_udp -> int -> int = "w_udp_set_send_buffer_size"
 
 (* ------------- DNS ------------------------------------------------ *)
 

libs/uv/uv_stubs.c

@@ -693,7 +693,7 @@ CAMLprim value w_tcp_connect_ipv6(value handle, value host, value port, value cb
 	UV_SUCCESS_UNIT;
 }
 
-static value w_tcp_getname(struct sockaddr_storage *storage) {
+static value w_getname(struct sockaddr_storage *storage) {
 	CAMLparam0();
 	CAMLlocal3(res, addr, infostore);
 	res = caml_alloc(2, 0);
@@ -719,7 +719,7 @@ CAMLprim value w_tcp_getsockname(value handle) {
 	struct sockaddr_storage storage;
 	int dummy = sizeof(struct sockaddr_storage);
 	UV_ERROR_CHECK(uv_tcp_getsockname(Tcp_val(handle), (struct sockaddr *)&storage, &dummy));
-	CAMLreturn(w_tcp_getname(&storage));
+	CAMLreturn(w_getname(&storage));
 }
 
 CAMLprim value w_tcp_getpeername(value handle) {
@@ -727,7 +727,7 @@ CAMLprim value w_tcp_getpeername(value handle) {
 	struct sockaddr_storage storage;
 	int dummy = sizeof(struct sockaddr_storage);
 	UV_ERROR_CHECK(uv_tcp_getpeername(Tcp_val(handle), (struct sockaddr *)&storage, &dummy));
-	CAMLreturn(w_tcp_getname(&storage));
+	CAMLreturn(w_getname(&storage));
 }
 
 CAMLprim value w_tcp_shutdown(value handle, value cb) {
@@ -788,7 +788,9 @@ static void handle_udp_cb_recv(uv_udp_t *handle, long int nread, const uv_buf_t
 		Store_field(message, 1, message_addr);
 		Store_field(res, 0, message);
 	}
+	printf("here?\n"); fflush(stdout);
 	caml_callback(cb, res);
+	printf("after?\n"); fflush(stdout);
 	CAMLreturn0;
 }
 
@@ -816,27 +818,31 @@ CAMLprim value w_udp_bind_ipv6(value handle, value host, value port, value ipv6o
 	UV_SUCCESS_UNIT;
 }
 
-CAMLprim value w_udp_send_ipv4(value handle, value data, value host, value port, value cb) {
-	CAMLparam5(handle, data, host, port, cb);
+CAMLprim value w_udp_send_ipv4(value handle, value msg, value offset, value length, value host, value port, value cb) {
+	CAMLparam5(handle, msg, offset, length, host);
+	CAMLxparam2(port, cb);
 	UV_SOCKADDR_IPV4(addr, Int_val(host), Int_val(port));
 	UV_ALLOC_CHECK(req, uv_udp_send_t);
 	UV_REQ_DATA(UdpSend_val(req)) = (void *)cb;
 	caml_register_global_root(UV_REQ_DATA_A(UdpSend_val(req)));
-	uv_buf_t buf = uv_buf_init(&Byte(data, 0), caml_string_length(data));
+	uv_buf_t buf = uv_buf_init(&Byte(msg, Int_val(offset)), Int_val(length));
 	UV_ERROR_CHECK_C(uv_udp_send(UdpSend_val(req), Udp_val(handle), &buf, 1, (const struct sockaddr *)&addr, (void (*)(uv_udp_send_t *, int))handle_stream_cb), free(UdpSend_val(req)));
 	UV_SUCCESS_UNIT;
 }
+BC_WRAP7(w_udp_send_ipv4);
 
-CAMLprim value w_udp_send_ipv6(value handle, value data, value host, value port, value cb) {
-	CAMLparam5(handle, data, host, port, cb);
+CAMLprim value w_udp_send_ipv6(value handle, value msg, value offset, value length, value host, value port, value cb) {
+	CAMLparam5(handle, msg, offset, length, host);
+	CAMLxparam2(port, cb);
 	UV_SOCKADDR_IPV6(addr, &Byte(host, 0), Int_val(port));
 	UV_ALLOC_CHECK(req, uv_udp_send_t);
 	UV_REQ_DATA(UdpSend_val(req)) = (void *)cb;
 	caml_register_global_root(UV_REQ_DATA_A(UdpSend_val(req)));
-	uv_buf_t buf = uv_buf_init(&Byte(data, 0), caml_string_length(data));
+	uv_buf_t buf = uv_buf_init(&Byte(msg, Int_val(offset)), Int_val(length));
 	UV_ERROR_CHECK_C(uv_udp_send(UdpSend_val(req), Udp_val(handle), &buf, 1, (const struct sockaddr *)&addr, (void (*)(uv_udp_send_t *, int))handle_stream_cb), free(UdpSend_val(req)));
 	UV_SUCCESS_UNIT;
 }
+BC_WRAP7(w_udp_send_ipv6);
 
 CAMLprim value w_udp_recv_start(value handle, value cb) {
 	CAMLparam2(handle, cb);
@@ -851,6 +857,85 @@ CAMLprim value w_udp_recv_stop(value handle) {
 	UV_SUCCESS_UNIT;
 }
 
+CAMLprim value w_udp_set_membership(value handle, value address, value intfc, value join) {
+	CAMLparam4(handle, address, intfc, join);
+	const char *intfc_u = NULL;
+	if (caml_string_length(intfc) != 0)
+		intfc_u = String_val(intfc);
+	UV_ERROR_CHECK(uv_udp_set_membership(Udp_val(handle), String_val(address), intfc_u, Bool_val(join) ? UV_JOIN_GROUP : UV_LEAVE_GROUP));
+	UV_SUCCESS_UNIT;
+}
+
+CAMLprim value w_udp_close(value handle, value cb) {
+	return w_close(handle, cb);
+}
+
+CAMLprim value w_udp_getsockname(value handle) {
+	CAMLparam1(handle);
+	struct sockaddr_storage storage;
+	int dummy = sizeof(struct sockaddr_storage);
+	UV_ERROR_CHECK(uv_udp_getsockname(Udp_val(handle), (struct sockaddr *)&storage, &dummy));
+	CAMLreturn(w_getname(&storage));
+}
+
+CAMLprim value w_udp_set_broadcast(value handle, value flag) {
+	CAMLparam2(handle, flag);
+	UV_ERROR_CHECK(uv_udp_set_broadcast(Udp_val(handle), Bool_val(flag)));
+	UV_SUCCESS_UNIT;
+}
+
+CAMLprim value w_udp_set_multicast_interface(value handle, value intfc) {
+	CAMLparam2(handle, intfc);
+	UV_ERROR_CHECK(uv_udp_set_multicast_interface(Udp_val(handle), String_val(intfc)));
+	UV_SUCCESS_UNIT;
+}
+
+CAMLprim value w_udp_set_multicast_loopback(value handle, value flag) {
+	CAMLparam2(handle, flag);
+	UV_ERROR_CHECK(uv_udp_set_multicast_loop(Udp_val(handle), Bool_val(flag) ? 1 : 0));
+	UV_SUCCESS_UNIT;
+}
+
+CAMLprim value w_udp_set_multicast_ttl(value handle, value ttl) {
+	CAMLparam2(handle, ttl);
+	UV_ERROR_CHECK(uv_udp_set_multicast_ttl(Udp_val(handle), Int_val(ttl)));
+	UV_SUCCESS_UNIT;
+}
+
+CAMLprim value w_udp_set_ttl(value handle, value ttl) {
+	CAMLparam2(handle, ttl);
+	UV_ERROR_CHECK(uv_udp_set_ttl(Udp_val(handle), Int_val(ttl)));
+	UV_SUCCESS_UNIT;
+}
+
+CAMLprim value w_udp_get_recv_buffer_size(value handle) {
+	CAMLparam1(handle);
+	int size_u = 0;
+	int res = uv_recv_buffer_size(Handle_val(handle), &size_u);
+	CAMLreturn(Val_int(res));
+}
+
+CAMLprim value w_udp_get_send_buffer_size(value handle) {
+	CAMLparam1(handle);
+	int size_u = 0;
+	int res = uv_send_buffer_size(Handle_val(handle), &size_u);
+	CAMLreturn(Val_int(res));
+}
+
+CAMLprim value w_udp_set_recv_buffer_size(value handle, value size) {
+	CAMLparam2(handle, size);
+	int size_u = Int_val(size);
+	int res = uv_recv_buffer_size(Handle_val(handle), &size_u);
+	CAMLreturn(Val_int(res));
+}
+
+CAMLprim value w_udp_set_send_buffer_size(value handle, value size) {
+	CAMLparam2(handle, size);
+	int size_u = Int_val(size);
+	int res = uv_send_buffer_size(Handle_val(handle), &size_u);
+	CAMLreturn(Val_int(res));
+}
+
 // ------------- DNS ------------------------------------------------
 
 static void handle_dns_gai_cb(uv_getaddrinfo_t *req, int status, struct addrinfo *gai_res) {

src/macro/eval/evalHash.ml

@@ -45,6 +45,8 @@ let key_bytesWritten = hash "bytesWritten"
 let key_buffer = hash "buffer"
 let key_family = hash "family"
 let key_hints = hash "hints"
+let key_data = hash "data"
+let key_address = hash "address"
 let key_Array = hash "Array"
 let key_eval_Vector = hash "eval.Vector"
 let key_String = hash "String"
@@ -144,6 +146,7 @@ let key_eval_uv_Stat = hash "eval.uv.Stat"
 let key_nusys_io_File = hash "nusys.io.File"
 let key_nusys_io_AsyncFile = hash "nusys.io.AsyncFile"
 let key_eval_uv_Socket = hash "eval.uv.Socket"
+let key_eval_uv_UdpSocket = hash "eval.uv.UdpSocket"
 let key_nusys_net_Dns = hash "nusys.net.Dns"
 let key_nusys_net_Address = hash "nusys.net.Address"
 let key_nusys_net_SocketAddress = hash "nusys.net.SocketAddress"

src/macro/eval/evalStdLib.ml

@@ -3545,18 +3545,155 @@ module StdUv = struct
 		let getName fn = vifun0 (fun vthis ->
 			let this = this vthis in
 			let addr : Uv.uv_ip_address_port = wrap_sync (fn this) in
-			match addr with
-				| {address; port} ->
-					encode_enum_value key_nusys_net_SocketAddress 0 [|(match address with
-							| Uv.UvIpv4 raw -> encode_enum_value key_nusys_net_Address 0 [|VInt32 raw|] None
-							| Uv.UvIpv6 raw -> encode_enum_value key_nusys_net_Address 1 [|encode_bytes raw|] None
-						); vint port|] None
-				| _ -> assert false
+			match addr with {address; port} ->
+				encode_enum_value key_nusys_net_SocketAddress 0 [|(match address with
+						| Uv.UvIpv4 raw -> encode_enum_value key_nusys_net_Address 0 [|VInt32 raw|] None
+						| Uv.UvIpv6 raw -> encode_enum_value key_nusys_net_Address 1 [|encode_bytes raw|] None
+					); vint port|] None
 		)
 		let getSockName = getName Uv.tcp_getsockname
 		let getPeerName = getName Uv.tcp_getpeername
 	end
 
+	module UdpSocket = struct
+		let this vthis = match vthis with
+			| VInstance {ikind = IUv (UvUdp t)} -> t
+			| v -> unexpected_value v "UvUdp"
+		let new_ = (fun _ ->
+			let s = wrap_sync (Uv.udp_init (loop ())) in
+			encode_instance key_eval_uv_UdpSocket ~kind:(IUv (UvUdp s))
+		)
+		let addMembership = vifun2 (fun vthis address intfc ->
+			let this = this vthis in
+			let address = decode_string address in
+			let intfc = decode_string intfc in
+			wrap_sync (Uv.udp_set_membership this address intfc true);
+			vnull
+		)
+		let dropMembership = vifun2 (fun vthis address intfc ->
+			let this = this vthis in
+			let address = decode_string address in
+			let intfc = decode_string intfc in
+			wrap_sync (Uv.udp_set_membership this address intfc false);
+			vnull
+		)
+		let send = vfunction (fun vl -> match vl with
+			| [vthis; msg; offset; length; address; port; cb] ->
+				let this = this vthis in
+				let msg = decode_bytes msg in
+				let offset = decode_int offset in
+				let length = decode_int length in
+				let port = decode_int port in
+				wrap_sync (match address with
+					| VEnumValue {eindex = 0; eargs = [|ip|]} ->
+						let ip = decode_int ip in
+						Uv.udp_send_ipv4 this msg offset length ip port (wrap_cb_unit cb)
+					| VEnumValue {eindex = 1; eargs = [|ip|]} ->
+						let ip = decode_bytes ip in
+						Uv.udp_send_ipv6 this msg offset length ip port (wrap_cb_unit cb)
+					| _ -> assert false);
+				vnull
+			| _ -> assert false
+		)
+		let close = vifun1 (fun vthis cb ->
+			let this = this vthis in
+			wrap_sync (Uv.udp_close this (wrap_cb_unit cb));
+			vnull
+		)
+		let bindTcp = vifun3 (fun vthis host port ipv6only ->
+			let this = this vthis in
+			let port = decode_int port in
+			let ipv6only = decode_bool ipv6only in
+			wrap_sync (match host with
+				| VEnumValue {eindex = 0; eargs = [|ip|]} ->
+					let ip = decode_int ip in
+					Uv.udp_bind_ipv4 this ip port
+				| VEnumValue {eindex = 1; eargs = [|ip|]} ->
+					let ip = decode_bytes ip in
+					Uv.udp_bind_ipv6 this ip port ipv6only
+				| _ -> assert false
+			);
+			vnull
+		)
+		let startRead = vifun1 (fun vthis cb ->
+			let this = this vthis in
+			wrap_sync (Uv.udp_recv_start this (fun res ->
+				match res with
+					| Uv.UvError err -> ignore (call_value cb [wrap_error err; vnull])
+					| Uv.UvSuccess {data; address; port} ->
+						let address = (match address with
+								| Uv.UvIpv4 raw -> encode_enum_value key_nusys_net_Address 0 [|VInt32 raw|] None
+								| Uv.UvIpv6 raw -> encode_enum_value key_nusys_net_Address 1 [|encode_bytes raw|] None
+							) in
+						let msg = encode_obj [key_data, encode_bytes data; key_address, address; key_port, vint port] in
+						ignore (call_value cb [vnull; msg])
+				));
+			vnull
+		)
+		let stopRead = vifun0 (fun vthis ->
+			let this = this vthis in
+			wrap_sync (Uv.udp_recv_stop this);
+			vnull
+		)
+		let getSockName = vifun0 (fun vthis ->
+			let this = this vthis in
+			let addr : Uv.uv_ip_address_port = wrap_sync (Uv.udp_getsockname this) in
+			match addr with {address; port} ->
+				encode_enum_value key_nusys_net_SocketAddress 0 [|(match address with
+						| Uv.UvIpv4 raw -> encode_enum_value key_nusys_net_Address 0 [|VInt32 raw|] None
+						| Uv.UvIpv6 raw -> encode_enum_value key_nusys_net_Address 1 [|encode_bytes raw|] None
+					); vint port|] None
+		)
+		let setBroadcast = vifun1 (fun vthis flag ->
+			let this = this vthis in
+			let flag = decode_bool flag in
+			wrap_sync (Uv.udp_set_broadcast this flag);
+			vnull
+		)
+		let setMulticastInterface = vifun1 (fun vthis intfc ->
+			let this = this vthis in
+			let intfc = decode_string intfc in
+			wrap_sync (Uv.udp_set_multicast_interface this intfc);
+			vnull
+		)
+		let setMulticastLoopback = vifun1 (fun vthis flag ->
+			let this = this vthis in
+			let flag = decode_bool flag in
+			wrap_sync (Uv.udp_set_multicast_loopback this flag);
+			vnull
+		)
+		let setMulticastTTL = vifun1 (fun vthis ttl ->
+			let this = this vthis in
+			let ttl = decode_int ttl in
+			wrap_sync (Uv.udp_set_multicast_ttl this ttl);
+			vnull
+		)
+		let setTTL = vifun1 (fun vthis ttl ->
+			let this = this vthis in
+			let ttl = decode_int ttl in
+			wrap_sync (Uv.udp_set_ttl this ttl);
+			vnull
+		)
+		let getRecvBufferSize = vifun0 (fun vthis ->
+			let this = this vthis in
+			vint (Uv.udp_get_recv_buffer_size this)
+		)
+		let getSendBufferSize = vifun0 (fun vthis ->
+			let this = this vthis in
+			vint (Uv.udp_get_send_buffer_size this)
+		)
+		let setRecvBufferSize = vifun1 (fun vthis size ->
+			let this = this vthis in
+			let size = decode_int size in
+			vint (Uv.udp_set_recv_buffer_size this size)
+		)
+		let setSendBufferSize = vifun1 (fun vthis size ->
+			let this = this vthis in
+			let size = decode_int size in
+			vint (Uv.udp_set_send_buffer_size this size)
+		)
+	end
+
 	module Dns = struct
 		let lookup_native = vfun3 (fun hostname options cb ->
 			let hostname = decode_string hostname in
@@ -3803,6 +3940,7 @@ let init_constructors builtins =
 			encode_instance key_sys_net_Deque ~kind:(IDeque (Deque.create()))
 		);
 	add key_eval_uv_Socket StdUv.Socket.new_;
+	add key_eval_uv_UdpSocket StdUv.UdpSocket.new_;
 	add key_eval_uv_Timer StdUv.Timer.new_
 
 let init_empty_constructors builtins =
@@ -4329,6 +4467,25 @@ let init_standard_library builtins =
 		"getSockName",StdUv.Socket.getSockName;
 		"getPeerName",StdUv.Socket.getPeerName;
 	];
+	init_fields builtins (["eval";"uv"],"UdpSocket") [] [
+		"addMembership",StdUv.UdpSocket.addMembership;
+		"dropMembership",StdUv.UdpSocket.dropMembership;
+		"send",StdUv.UdpSocket.send;
+		"close",StdUv.UdpSocket.close;
+		"bindTcp",StdUv.UdpSocket.bindTcp;
+		"startRead",StdUv.UdpSocket.startRead;
+		"stopRead",StdUv.UdpSocket.stopRead;
+		"getSockName",StdUv.UdpSocket.getSockName;
+		"setBroadcast",StdUv.UdpSocket.setBroadcast;
+		"setMulticastInterface",StdUv.UdpSocket.setMulticastInterface;
+		"setMulticastLoopback",StdUv.UdpSocket.setMulticastLoopback;
+		"setMulticastTTL",StdUv.UdpSocket.setMulticastTTL;
+		"setTTL",StdUv.UdpSocket.setTTL;
+		"getRecvBufferSize",StdUv.UdpSocket.getRecvBufferSize;
+		"getSendBufferSize",StdUv.UdpSocket.getSendBufferSize;
+		"setRecvBufferSize",StdUv.UdpSocket.setRecvBufferSize;
+		"setSendBufferSize",StdUv.UdpSocket.setSendBufferSize;
+	];
 	init_fields builtins (["nusys";"net"],"Dns") [
 		"lookup_native",StdUv.Dns.lookup_native;
 		"reverse",StdUv.Dns.reverse;

src/macro/eval/evalValue.ml

@@ -100,6 +100,7 @@ type vuv_value =
 	| UvStat of Uv.t_stat
 	| UvDirent of (string * int)
 	| UvTcp of Uv.t_tcp
+	| UvUdp of Uv.t_udp
 	| UvTimer of Uv.t_timer
 
 type value =