alloc_sockaddr: handle abstract paths (v2)

Changes

@@ -212,6 +212,10 @@ OCaml 4.08.0
 - GPR#1525: Make function set_max_indent respect documentation
   (Pierre Weis, Richard Bonichon, review by Florian Angeletti)
 
+- GPR#2233: Unix: fix handling of Linux abstract socket paths when receiving a
+  Unix socket address from the operating system.
+  (Tim Cuthbertson, review by Jérémie Dimino)
+
 ### Other libraries:
 
 - GPR#1061: Add ?follow parameter to Unix.link. This allows hardlinking

otherlibs/unix/socketaddr.c

@@ -111,10 +111,23 @@ value alloc_sockaddr(union sock_addr_union * adr /*in*/,
   case AF_UNIX:
     { value n;
       /* Based on recommendation in section BUGS of Linux unix(7). See
-         http://man7.org/linux/man-pages/man7/unix.7.html */
-      mlsize_t path_length =
-        strnlen(adr->s_unix.sun_path,
-                adr_len - offsetof(struct sockaddr_un, sun_path));
+         http://man7.org/linux/man-pages/man7/unix.7.html. */
+      mlsize_t struct_offset = offsetof(struct sockaddr_un, sun_path);
+      mlsize_t path_length = 0;
+      if (adr_len > struct_offset) {
+        // adr_len is 0 when sent from an unbound socket
+        path_length = adr_len - struct_offset;
+
+        /* paths _may_ be null-terminated, but Linux abstract sockets
+         * start with a null, and may contain internal nulls. */
+        path_length = (
+#ifdef __linux__
+          (adr->s_unix.sun_path[0] == '\0') ? path_length :
+#endif
+          strnlen(adr->s_unix.sun_path, path_length)
+        );
+      }
+
       n = caml_alloc_initialized_string(path_length,
                                         (char *)adr->s_unix.sun_path);
       Begin_root (n);

testsuite/tests/lib-unix/unix-socket/is-linux.sh

@@ -0,0 +1,21 @@
+#!/bin/sh
+
+# This script is related to the 'recvfrom_linux.ml' test.
+
+uname="$(uname -s)"
+if [ "$uname" = "Linux" ]; then
+
+# Workaround: the tests that come after this script
+# (bytecode and native) depend on stdout redirection, but
+# running a script sets both of those to the empty string.
+# See https://caml.inria.fr/mantis/view.php?id=7910
+  cat > "$ocamltest_response" <<EOF
+-stdout
+-stderr
+EOF
+
+  exit ${TEST_PASS}
+else
+  echo "$uname" > "$ocamltest_response"
+  exit ${TEST_SKIP}
+fi

testsuite/tests/lib-unix/unix-socket/ocamltests

@@ -0,0 +1,2 @@
+recvfrom_unix.ml
+recvfrom_linux.ml

testsuite/tests/lib-unix/unix-socket/recvfrom.ml

@@ -0,0 +1,33 @@
+open Unix
+
+let path_of_addr = function
+  | ADDR_UNIX path -> path
+  | _ -> assert false
+;;
+
+let test_sender ~client_socket ~server_socket ~server_addr ~client_addr =
+  Printf.printf "%S" (path_of_addr client_addr);
+  let byte = Bytes.make 1 't' in
+  let sent_len = sendto client_socket byte 0 1 [] server_addr in
+  assert (sent_len = 1);
+  let buf = Bytes.make 1024 '\x00' in
+  let (recv_len, sender) = recvfrom server_socket buf 0 1024 [] in
+
+  Printf.printf " as %S: " (path_of_addr sender);
+  assert (sender = client_addr);
+  assert (Bytes.sub_string buf 0 recv_len = "t");
+  print_endline "OK";;
+
+let ensure_no_file path =
+  try unlink path with Unix_error (ENOENT, _, _) -> ();;
+
+let with_socket fn =
+  let s = socket PF_UNIX SOCK_DGRAM 0 in
+  Fun.protect ~finally:(fun () -> close s) (fun () -> fn s)
+
+let with_bound_socket path fn =
+  with_socket (fun s ->
+    let addr = ADDR_UNIX path in
+    bind s addr;
+    fn addr s
+  )

testsuite/tests/lib-unix/unix-socket/recvfrom_linux.ml

@@ -0,0 +1,21 @@
+(* TEST
+include unix
+modules = "recvfrom.ml"
+script = "sh ${test_source_directory}/is-linux.sh"
+* hasunix
+** script
+*** bytecode
+*** native
+*)
+open Recvfrom
+
+let () =
+  let server_path = "ocaml-test-socket-linux" in
+  ensure_no_file server_path;
+  at_exit (fun () -> ensure_no_file server_path);
+  with_bound_socket server_path (fun server_addr server_socket ->
+    (* abstract socket *)
+    with_bound_socket "\x00ocaml-abstract-socket" (fun client_addr client_socket ->
+      test_sender ~client_socket ~server_socket ~server_addr ~client_addr
+    );
+  )

testsuite/tests/lib-unix/unix-socket/recvfrom_linux.reference

@@ -0,0 +1 @@
+"\000ocaml-abstract-socket" as "\000ocaml-abstract-socket": OK

testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml

@@ -0,0 +1,23 @@
+(* TEST
+include unix
+modules = "recvfrom.ml"
+* not-windows
+** bytecode
+** native
+*)
+open Recvfrom
+
+let () =
+  let server_path = "ocaml-test-socket-unix" in
+  ensure_no_file server_path;
+  at_exit (fun () -> ensure_no_file server_path);
+  with_bound_socket server_path (fun server_addr server_socket ->
+    (* path socket, just reuse server addr *)
+    test_sender ~client_socket:server_socket ~server_socket ~server_addr ~client_addr:server_addr;
+
+    (* unnamed socket *)
+    with_socket (fun client_socket ->
+      (* unbound socket should be treated as empty path *)
+      test_sender ~client_socket ~server_socket ~server_addr ~client_addr:(ADDR_UNIX "")
+    )
+  )

testsuite/tests/lib-unix/unix-socket/recvfrom_unix.reference

@@ -0,0 +1,2 @@
+"ocaml-test-socket-unix" as "ocaml-test-socket-unix": OK
+"" as "": OK