Richard W.M. Jones
2022-Nov-02 21:10 UTC
[Libguestfs] [PATCH libnbd] ocaml: Implement sockaddr type
This is pushed already, commit 50500aade9.
Richard W.M. Jones
2022-Nov-02 21:10 UTC
[Libguestfs] [PATCH libnbd] ocaml: Implement sockaddr type
Convert Unix.sockaddr to struct sockaddr. OCaml provides a function
to do this ('get_sockaddr' - not namespaced!) This function was
present at least as far back as RHEL 7 (OCaml 4.05).
This also adds a simple test.
---
generator/OCaml.ml | 8 ++--
ocaml/helpers.c | 23 ++++++++++
ocaml/nbd-c.h | 3 ++
ocaml/tests/Makefile.am | 1 +
ocaml/tests/test_580_aio_connect.ml | 67 +++++++++++++++++++++++++++++
5 files changed, 99 insertions(+), 3 deletions(-)
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 8711eab57c..6a280b6734 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -49,7 +49,7 @@ and
| Int _ -> "int"
| Int64 _ -> "int64"
| Path _ -> "string"
- | SockAddrAndLen _ -> "string" (* XXX not impl *)
+ | SockAddrAndLen _ -> "Unix.sockaddr"
| SizeT _ -> "int" (* OCaml int type is always sufficient for
counting *)
| String _ -> "string"
| StringList _ -> "string list"
@@ -702,9 +702,11 @@ let
| SizeT n ->
pr " size_t %s = Int_val (%sv);\n" n n
| SockAddrAndLen (n, len) ->
- pr " const struct sockaddr *%s;\n" n;
+ pr " struct sockaddr_storage %s_storage;\n" n;
+ pr " struct sockaddr *%s = (struct sockaddr *)
&%s_storage;\n" n n;
pr " socklen_t %s;\n" len;
- pr " abort ();\n" (* XXX *)
+ pr " nbd_internal_unix_sockaddr_to_sa (%sv, &%s_storage,
&%s);\n"
+ n n len
| StringList n ->
pr " char **%s = (char **) nbd_internal_ocaml_string_list
(%sv);\n" n n
| UInt n | UIntPtr n ->
diff --git a/ocaml/helpers.c b/ocaml/helpers.c
index aafb970ff9..2981135647 100644
--- a/ocaml/helpers.c
+++ b/ocaml/helpers.c
@@ -23,6 +23,8 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <sys/socket.h>
+#include <assert.h>
#include <caml/alloc.h>
#include <caml/callback.h>
@@ -30,6 +32,7 @@
#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <caml/printexc.h>
+#include <caml/socketaddr.h>
#include <caml/unixsupport.h>
#include <libnbd.h>
@@ -130,6 +133,26 @@ nbd_internal_ocaml_alloc_int64_from_uint32_array (uint32_t
*a, size_t len)
CAMLreturn (rv);
}
+/* Convert a Unix.sockaddr to a C struct sockaddr. */
+void
+nbd_internal_unix_sockaddr_to_sa (value sockaddrv,
+ struct sockaddr_storage *ss,
+ socklen_t *len)
+{
+ CAMLparam1 (sockaddrv);
+ union sock_addr_union sa_u;
+ socklen_param_type sl; /* this is really an int or socklen_t */
+
+ memset (ss, 0, sizeof *ss);
+
+ get_sockaddr (sockaddrv, &sa_u, &sl);
+ assert (sl <= sizeof *ss);
+ memcpy (ss, &sa_u, sl);
+ *len = sl;
+
+ CAMLreturn0;
+}
+
/* Common code when an exception is raised in an OCaml callback.
*
* We handle Assert_failure specially by abort()-ing. Other
diff --git a/ocaml/nbd-c.h b/ocaml/nbd-c.h
index 0bf044ca91..8b0c088da7 100644
--- a/ocaml/nbd-c.h
+++ b/ocaml/nbd-c.h
@@ -23,6 +23,7 @@
#include <stdint.h>
#include <string.h>
+#include <sys/socket.h>
#include <caml/alloc.h>
#include <caml/custom.h>
@@ -62,6 +63,8 @@ extern void nbd_internal_ocaml_raise_closed (const char *func)
Noreturn;
extern const char **nbd_internal_ocaml_string_list (value);
extern value nbd_internal_ocaml_alloc_int64_from_uint32_array (uint32_t *,
size_t);
+extern void nbd_internal_unix_sockaddr_to_sa (value, struct sockaddr_storage *,
+ socklen_t *);
extern void nbd_internal_ocaml_exception_in_wrapper (const char *, value);
/* Extract an NBD handle from an OCaml heap value. */
diff --git a/ocaml/tests/Makefile.am b/ocaml/tests/Makefile.am
index 328d53e543..2cd36eb067 100644
--- a/ocaml/tests/Makefile.am
+++ b/ocaml/tests/Makefile.am
@@ -42,6 +42,7 @@ ML_TESTS = \
test_500_aio_pread.ml \
test_505_aio_pread_structured_callback.ml \
test_510_aio_pwrite.ml \
+ test_580_aio_connect.ml \
test_590_aio_copy.ml \
test_600_debug_callback.ml \
test_610_exception.ml \
diff --git a/ocaml/tests/test_580_aio_connect.ml
b/ocaml/tests/test_580_aio_connect.ml
new file mode 100644
index 0000000000..95acc18c10
--- /dev/null
+++ b/ocaml/tests/test_580_aio_connect.ml
@@ -0,0 +1,67 @@
+(* hey emacs, this is OCaml code: -*- tuareg -*- *)
+(* libnbd OCaml test case
+ * Copyright (C) 2013-2022 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+open Unix
+open Printf
+
+let () + let nbd = NBD.create () in
+
+ (* Unlike other tests, we're going to run nbdkit as a subprocess
+ * by hand and have it listening on a randomly named socket
+ * that we create.
+ *)
+ let sock = Filename.temp_file "580-" ".sock" in
+ unlink sock;
+ let pidfile = Filename.temp_file "580-" ".pid" in
+ unlink pidfile;
+ let cmd + sprintf "nbdkit -U %s -P %s --exit-with-parent memory
size=512 &"
+ (Filename.quote sock) (Filename.quote pidfile) in
+ if Sys.command cmd <> 0 then
+ failwith "nbdkit command failed";
+ let rec loop i + if i > 60 then
+ failwith "nbdkit subcommand did not start up";
+ if not (Sys.file_exists pidfile) then (
+ sleep 1;
+ loop (i+1)
+ )
+ in
+ loop 0;
+
+ (* Connect to the subprocess using a Unix.sockaddr. *)
+ let sa = ADDR_UNIX sock in
+ NBD.aio_connect nbd sa;
+ while NBD.aio_is_connecting nbd do
+ ignore (NBD.poll nbd 1)
+ done;
+ assert (NBD.aio_is_ready nbd);
+ NBD.close nbd;
+
+ (* Kill the nbdkit subprocess. *)
+ let chan = open_in pidfile in
+ let pid = int_of_string (input_line chan) in
+ kill pid Sys.sigint;
+
+ (* Clean up files. *)
+ unlink sock;
+ unlink pidfile
+
+let () = Gc.compact ()
--
2.37.0.rc2