Re: [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 _______________________________________________ Libguestfs mailing list Libguestfs(a)redhat.com https://listman.redhat.com/mailman/listinfo/libguestfs