On Wed, Nov 02, 2022 at 09:10:02PM +0000, Richard W.M. Jones wrote:
> 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).
The namespacing has actually been fixed upstream ('caml_unix_get_sockaddr').
There is a backwards compatible #define, but I guess we will need to
have some autoconf test to choose the right symbol. I don't have a
version of OCaml that has the namespaced symbol.
Rich.
> 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@redhat.com
> https://listman.redhat.com/mailman/listinfo/libguestfs
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines. Supports shell scripting,
bindings from many languages. http://libguestfs.org
_______________________________________________
Libguestfs mailing list
Libguestfs@redhat.com
https://listman.redhat.com/mailman/listinfo/libguestfs
