From 2acdc29f9d5f0b8a8df099f895b30c26b5b304ef Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 17 Aug 2022 14:11:42 +0100 Subject: [PATCH 01/75] xenopsd: use uuid instead of deprecated uuidm functions Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/service.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 7ca0969b046..8a00f6ef8fd 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -456,7 +456,7 @@ module Vgpu = struct } -> (* The VGPU UUID is not available. Create a fresh one; xapi will deal with it. *) - let uuid = Uuidm.to_string (Uuidm.create `V4) in + let uuid = Uuidx.(to_string (make ())) in debug "NVidia vGPU config: using config file %s and uuid %s" config_file uuid ; make addr From e833182474e22eb415556fa139d9e970d23d739a Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 17 Aug 2022 14:12:18 +0100 Subject: [PATCH 02/75] message-switch: conform to new APIs in jst libs Signed-off-by: Pau Ruiz Safont --- ocaml/message-switch/async/protocol_async.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/message-switch/async/protocol_async.ml b/ocaml/message-switch/async/protocol_async.ml index 9d8684f64fd..e4fb209a166 100644 --- a/ocaml/message-switch/async/protocol_async.ml +++ b/ocaml/message-switch/async/protocol_async.ml @@ -56,7 +56,7 @@ module M = struct Monitor.try_with ~extract_exn:true connect >>= function | Error (Unix.Unix_error - (Core.(Unix.ECONNREFUSED | Unix.ECONNABORTED | Unix.ENOENT), _, _) + (Core_unix.(ECONNREFUSED | ECONNABORTED | ENOENT), _, _) ) -> let delay = Float.min maximum_delay delay in Clock.after (Time.Span.of_sec delay) >>= fun () -> From 80ee829cf1030a7d94e94da16434f5dda9f36ec5 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 18 Aug 2022 17:00:04 +0100 Subject: [PATCH 03/75] xapi-storage-script: conform to new APIs in jst libs Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-storage-script/main.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 892d7103203..5851006be5c 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -1709,12 +1709,10 @@ let main ~root_dir ~state_path ~switch_path = Attached_SRs.reload state_path >>= fun () -> let datapath_root = Filename.concat root_dir "datapath" in Async_inotify.create ~recursive:false ~watch_new_dirs:false datapath_root - >>= fun (watch, _) -> - let datapath = Async_inotify.pipe watch in + >>= fun (_, _, datapath) -> let volume_root = Filename.concat root_dir "volume" in Async_inotify.create ~recursive:false ~watch_new_dirs:false volume_root - >>= fun (watch, _) -> - let volume = Async_inotify.pipe watch in + >>= fun (_, _, volume) -> let rec loop () = Monitor.try_with (fun () -> Deferred.all_unit From 2ee0819f439370c2b3d5a27e2cf90b41d42d9fba Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 6 Oct 2022 15:05:05 +0100 Subject: [PATCH 04/75] xen-api-client: conform to new APIs in jst libs Signed-off-by: Pau Ruiz Safont --- ocaml/xen-api-client/async_examples/event_test.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xen-api-client/async_examples/event_test.ml b/ocaml/xen-api-client/async_examples/event_test.ml index a381c0484e8..7489fd7ac7e 100644 --- a/ocaml/xen-api-client/async_examples/event_test.ml +++ b/ocaml/xen-api-client/async_examples/event_test.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Core_kernel +open Core open Async open Xen_api_async_unix From 0604f314b17944ad9ddaaa66baba84b249cc1500 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 19 Aug 2022 11:13:49 +0100 Subject: [PATCH 05/75] stream_vdi, import: conform to new APIs in tar Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/import.ml | 25 ++++++++++++------------- ocaml/xapi/stream_vdi.ml | 30 ++++++++++++++---------------- 2 files changed, 26 insertions(+), 29 deletions(-) diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index 2ff1363d725..202d7b420c3 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -1936,13 +1936,13 @@ let handle_all __context config rpc session_id (xs : obj list) = (** Read the next file in the archive as xml *) let read_xml hdr fd = - Unixext.really_read_string fd (Int64.to_int hdr.Tar_unix.Header.file_size) + Unixext.really_read_string fd (Int64.to_int hdr.Tar.Header.file_size) let assert_filename_is hdr = let expected = Xapi_globs.ova_xml_filename in - let actual = hdr.Tar_unix.Header.file_name in + let actual = hdr.Tar.Header.file_name in if expected <> actual then ( - let hex = Tar_unix.Header.to_hex in + let hex = Tar.Header.to_hex in error "import expects the next file in the stream to be [%s]; got [%s]" (hex expected) (hex actual) ; raise (IFailure (Unexpected_file (expected, actual))) @@ -1953,17 +1953,17 @@ let assert_filename_is hdr = the lot through an appropriate decompressor and try again *) let with_open_archive fd ?length f = (* Read the first header's worth into a buffer *) - let buffer = Cstruct.create Tar_unix.Header.length in + let buffer = Cstruct.create Tar.Header.length in let retry_with_compression = ref true in try Tar_unix.really_read fd buffer ; (* we assume the first block is not all zeroes *) - let hdr = Option.get (Tar_unix.Header.unmarshal buffer) in + let hdr = Option.get (Tar.Header.unmarshal buffer) in assert_filename_is hdr ; (* successfully opened uncompressed stream *) retry_with_compression := false ; let xml = read_xml hdr fd in - Tar_helpers.skip fd (Tar_unix.Header.compute_zero_padding_length hdr) ; + Tar_helpers.skip fd (Tar.Header.compute_zero_padding_length hdr) ; f xml fd with e -> if not !retry_with_compression then raise e ; @@ -1994,11 +1994,11 @@ let with_open_archive fd ?length f = Tar_unix.really_write compressed_in buffer ; let limit = Option.map - (fun x -> Int64.sub x (Int64.of_int Tar_unix.Header.length)) + (fun x -> Int64.sub x (Int64.of_int Tar.Header.length)) length in let n = Unixext.copy_file ?limit fd compressed_in in - debug "Written a total of %d + %Ld bytes" Tar_unix.Header.length n + debug "Written a total of %d + %Ld bytes" Tar.Header.length n ) ) (fun () -> ignore_exn (fun () -> Unix.close pipe_in)) @@ -2006,11 +2006,10 @@ let with_open_archive fd ?length f = let consumer pipe_out feeder_t = finally (fun () -> - let hdr = Tar_unix.Header.get_next_header pipe_out in + let hdr = Tar_unix.get_next_header pipe_out in assert_filename_is hdr ; let xml = read_xml hdr pipe_out in - Tar_helpers.skip pipe_out - (Tar_unix.Header.compute_zero_padding_length hdr) ; + Tar_helpers.skip pipe_out (Tar.Header.compute_zero_padding_length hdr) ; f xml pipe_out ) (fun () -> @@ -2103,7 +2102,7 @@ let with_error_handling f = (Api_errors.import_error_attached_disks_not_found, []) ) | Unexpected_file (expected, actual) -> - let hex = Tar_unix.Header.to_hex in + let hex = Tar.Header.to_hex in error "Invalid XVA file: import expects the next file in the stream to \ be \"%s\" [%s]; got \"%s\" [%s]" @@ -2159,7 +2158,7 @@ let metadata_handler (req : Request.t) s _ = (fun metadata s -> debug "Got XML" ; (* Skip trailing two zero blocks *) - Tar_helpers.skip s (Tar_unix.Header.length * 2) ; + Tar_helpers.skip s (Tar.Header.length * 2) ; let header = metadata |> Xmlrpc.of_string |> header_of_rpc in assert_compatible ~__context header.version ; if full_restore then diff --git a/ocaml/xapi/stream_vdi.ml b/ocaml/xapi/stream_vdi.ml index f70940f1964..64b1da93eee 100644 --- a/ocaml/xapi/stream_vdi.ml +++ b/ocaml/xapi/stream_vdi.ml @@ -372,8 +372,8 @@ exception Invalid_checksum of string (* Rio GA and later only *) let verify_inline_checksum ifd checksum_table hdr = - let file_name = hdr.Tar_unix.Header.file_name in - let length = hdr.Tar_unix.Header.file_size in + let file_name = hdr.Tar.Header.file_name in + let length = hdr.Tar.Header.file_size in if not (List.exists @@ -394,7 +394,7 @@ let verify_inline_checksum ifd checksum_table hdr = let csum = Bytes.make length' ' ' in Unixext.really_read ifd csum 0 length' ; let csum = Bytes.unsafe_to_string csum in - Tar_helpers.skip ifd (Tar_unix.Header.compute_zero_padding_length hdr) ; + Tar_helpers.skip ifd (Tar.Header.compute_zero_padding_length hdr) ; (* Look up the relevant file_name in the checksum_table *) let original_file_name = Filename.remove_extension file_name in let csum' = List.assoc original_file_name !checksum_table in @@ -434,9 +434,9 @@ let recv_all_vdi refresh_session ifd (__context : Context.t) rpc session_id refresh_session () ; let remaining = Int64.sub size offset in if remaining > 0L then ( - let hdr = Tar_unix.Header.get_next_header ifd in - let file_name = hdr.Tar_unix.Header.file_name in - let length = hdr.Tar_unix.Header.file_size in + let hdr = Tar_unix.get_next_header ifd in + let file_name = hdr.Tar.Header.file_name in + let length = hdr.Tar.Header.file_size in (* First chunk will always be there *) if !firstchunklength < 0 then ( firstchunklength := Int64.to_int length ; @@ -487,9 +487,9 @@ let recv_all_vdi refresh_session ifd (__context : Context.t) rpc session_id Unixext.really_read ifd buffer 0 (Int64.to_int length) ; Unix.write ofd buffer 0 (Int64.to_int length) |> ignore ; let buffer_string = Bytes.unsafe_to_string buffer in - let csum_hdr = Tar_unix.Header.get_next_header ifd in + let csum_hdr = Tar_unix.get_next_header ifd in (* Header of the checksum file *) - let csum_file_name = csum_hdr.Tar_unix.Header.file_name in + let csum_file_name = csum_hdr.Tar.Header.file_name in let csum = (* Infer checksum algorithm from the file extension *) match Filename.extension csum_file_name with @@ -505,8 +505,7 @@ let recv_all_vdi refresh_session ifd (__context : Context.t) rpc session_id error "%s" msg ; raise (Failure msg) in checksum_table := (file_name, csum) :: !checksum_table ; - Tar_helpers.skip ifd - (Tar_unix.Header.compute_zero_padding_length hdr) ; + Tar_helpers.skip ifd (Tar.Header.compute_zero_padding_length hdr) ; made_progress __context progress (Int64.add skipped_size length) ; ( if has_inline_checksums then try verify_inline_checksum ifd checksum_table csum_hdr @@ -542,8 +541,8 @@ let recv_all_zurich refresh_session ifd (__context : Context.t) rpc session_id let hdr = ref None in let next () = hdr := - try Some (Tar_unix.Header.get_next_header ifd) with - | Tar_unix.Header.End_of_stream -> + try Some (Tar_unix.get_next_header ifd) with + | Tar.Header.End_of_stream -> None | e -> raise e @@ -558,8 +557,8 @@ let recv_all_zurich refresh_session ifd (__context : Context.t) rpc session_id match !hdr with | Some hdr -> refresh_session () ; - let file_name = hdr.Tar_unix.Header.file_name in - let length = hdr.Tar_unix.Header.file_size in + let file_name = hdr.Tar.Header.file_name in + let length = hdr.Tar.Header.file_size in if Astring.String.is_prefix ~affix:prefix file_name then ( let suffix = String.sub file_name (String.length prefix) @@ -576,8 +575,7 @@ let recv_all_zurich refresh_session ifd (__context : Context.t) rpc session_id Gzip.Default.decompress ofd (fun zcat_in -> Tar_helpers.copy_n ifd zcat_in length ) ; - Tar_helpers.skip ifd - (Tar_unix.Header.compute_zero_padding_length hdr) ; + Tar_helpers.skip ifd (Tar.Header.compute_zero_padding_length hdr) ; (* XXX: this is totally wrong: *) made_progress __context progress length ; next () ; From 2ce76458c218f8a1e90a39f343ce7bf39009f8b6 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 19 Aug 2022 14:01:17 +0100 Subject: [PATCH 06/75] gencert: conform to new APIs in x509 Now keys using elliptical curve cryptography need to be taken into account. Keep the same behaviour as previously by rejecting them Signed-off-by: Pau Ruiz Safont --- ocaml/gencert/lib.ml | 7 +++++-- ocaml/gencert/selfcert.ml | 8 +++----- ocaml/gencert/test_lib.ml | 11 +++++------ 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/ocaml/gencert/lib.ml b/ocaml/gencert/lib.ml index 612c0b4f374..b4ea8885ec8 100644 --- a/ocaml/gencert/lib.ml +++ b/ocaml/gencert/lib.ml @@ -22,7 +22,7 @@ type t_certificate = Leaf | Chain let () = Mirage_crypto_rng_unix.initialize () let validate_private_key pkcs8_private_key = - let ensure_key_length = function + let ensure_rsa_key_length = function | `RSA priv -> let length = Mirage_crypto_pk.Rsa.priv_bits priv in if length < 2048 || length > 4096 then @@ -34,6 +34,9 @@ let validate_private_key pkcs8_private_key = ) else Ok (`RSA priv) + | key -> + let key_type = X509.(Key_type.to_string (Private_key.key_type key)) in + Error (`Msg (server_certificate_key_algorithm_not_supported, [key_type])) in let raw_pem = Cstruct.of_string pkcs8_private_key in X509.Private_key.decode_pem raw_pem @@ -55,7 +58,7 @@ let validate_private_key pkcs8_private_key = `Msg (server_certificate_key_invalid, []) ) ) - >>= ensure_key_length + >>= ensure_rsa_key_length let pem_of_string x ~error_invalid = let raw_pem = Cstruct.of_string x in diff --git a/ocaml/gencert/selfcert.ml b/ocaml/gencert/selfcert.ml index 212bcbacd1d..0f488ee80a9 100644 --- a/ocaml/gencert/selfcert.ml +++ b/ocaml/gencert/selfcert.ml @@ -118,16 +118,14 @@ let generate_pub_priv_key length = |> X509.Private_key.decode_pem |> R.reword_error (fun _ -> R.msg "decoding private key failed") in - let* rsa = - try match privkey with `RSA x -> Ok x - with _ -> R.error_msg "generated private key does not use RSA" - in + let err_not_rsa = R.error_msg "generated private key does not use RSA" in + let* rsa = match privkey with `RSA x -> Ok x | _ -> err_not_rsa in let pubkey = `RSA (Rsa.pub_of_priv rsa) in Ok (privkey, pubkey) let selfsign' issuer extensions key_length expiration = let* privkey, pubkey = generate_pub_priv_key key_length in - let req = X509.Signing_request.create issuer privkey in + let* req = X509.Signing_request.create issuer privkey in let* cert = sign expiration privkey pubkey issuer req extensions in let key_pem = X509.Private_key.encode_pem privkey in let cert_pem = X509.Certificate.encode_pem cert in diff --git a/ocaml/gencert/test_lib.ml b/ocaml/gencert/test_lib.ml index 7c8804eefd9..7f61e0ecf4d 100644 --- a/ocaml/gencert/test_lib.ml +++ b/ocaml/gencert/test_lib.ml @@ -5,6 +5,8 @@ open Gencertlib.Lib open Api_errors open Rresult.R.Infix +let ( let* ) = Rresult.R.bind + (* Initialize RNG for testing certificates *) let () = Mirage_crypto_rng_unix.initialize () @@ -36,10 +38,7 @@ let invalid_private_keys = ("pkey_rsa_1024", server_certificate_key_rsa_length_not_supported, ["1024"]) ; ("pkey_rsa_8192", server_certificate_key_rsa_length_not_supported, ["8192"]) ; ("pkey_rsa_n3_2048", server_certificate_key_rsa_multi_not_supported, []) - ; ( "pkey_ed25519" - , server_certificate_key_algorithm_not_supported - , ["1.3.101.112"] - ) + ; ("pkey_ed25519", server_certificate_key_algorithm_not_supported, ["ed25519"]) ; ("pkey_bogus", server_certificate_key_invalid, []) ] @@ -194,9 +193,9 @@ let load_pkcs8 name = ) let sign_cert host_name ~pkey_sign digest pkey_leaf = - let csr = X509.Signing_request.create [host_name] ~digest pkey_leaf in + let* csr = X509.Signing_request.create [host_name] ~digest pkey_leaf in X509.Signing_request.sign csr ~valid_from ~valid_until ~digest - ~hash_whitelist:[digest] pkey_sign [host_name] + ~allowed_hashes:[digest] pkey_sign [host_name] |> Rresult.R.error_to_msg ~pp_error:X509.Validation.pp_signature_error let sign_leaf_cert host_name digest pkey_leaf = From 8b4d02662543e47919fa0382e2a600f0372ec9ef Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 19 Aug 2022 14:43:02 +0100 Subject: [PATCH 07/75] xapi-guard, xen-api-client: conform to new APIs in conduit The context is now is lazy-loaded, so force it's loading. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-guard/lib/varstored_interface.ml | 3 ++- ocaml/xen-api-client/lwt_examples/watch_metrics.ml | 4 +--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi-guard/lib/varstored_interface.ml b/ocaml/xapi-guard/lib/varstored_interface.ml index 9f4ee22584b..6ba2839fbd8 100644 --- a/ocaml/xapi-guard/lib/varstored_interface.ml +++ b/ocaml/xapi-guard/lib/varstored_interface.ml @@ -154,7 +154,8 @@ let with_xapi ~cache f = let rec wait_connectable path = let* res = Lwt_result.catch - (Conduit_lwt_unix.connect ~ctx:Conduit_lwt_unix.default_ctx + (Conduit_lwt_unix.connect + ~ctx:(Lazy.force Conduit_lwt_unix.default_ctx) (`Unix_domain_socket (`File path)) ) in diff --git a/ocaml/xen-api-client/lwt_examples/watch_metrics.ml b/ocaml/xen-api-client/lwt_examples/watch_metrics.ml index 05c85c77985..0f5151d3a54 100644 --- a/ocaml/xen-api-client/lwt_examples/watch_metrics.ml +++ b/ocaml/xen-api-client/lwt_examples/watch_metrics.ml @@ -55,9 +55,7 @@ let main () = Client.call ~headers `GET uri >>= fun (res, body) -> let headers = Response.headers res in - Cohttp.Header.iter - (fun k v -> List.iter (Printf.eprintf "%s: %s\n%!" k) v) - headers ; + Cohttp.Header.iter (fun k v -> Printf.eprintf "%s: %s\n%!" k v) headers ; Cohttp_lwt.Body.to_string body >>= fun s -> let update = Xen_api_metrics.Updates.parse s in Printf.eprintf "%s\n%!" (Rrd_updates.string_of update) ; From bb1e9ec30793e8c7a34a73777b875d0baa463181 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 16 Sep 2022 10:14:01 +0100 Subject: [PATCH 08/75] message-switch, vhd-tool: drop io-page-unix Now io-page is compiled using dune and it's not split into two. Signed-off-by: Pau Ruiz Safont --- message-switch.opam | 2 +- ocaml/message-switch/switch/dune | 2 +- ocaml/vhd-tool/src/dune | 2 +- ocaml/xcp-rrdd/lib/transport/page/dune | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/message-switch.opam b/message-switch.opam index a79ad87c4c1..7267b4725fb 100644 --- a/message-switch.opam +++ b/message-switch.opam @@ -18,7 +18,7 @@ depends: [ "cmdliner" "cohttp-async" {with-test} "cohttp-lwt-unix" - "io-page-unix" + "io-page" {>= "2.4.0"} "lwt_log" "message-switch-async" {with-test} "message-switch-lwt" diff --git a/ocaml/message-switch/switch/dune b/ocaml/message-switch/switch/dune index 6bd7df7f5a9..d05877491d2 100644 --- a/ocaml/message-switch/switch/dune +++ b/ocaml/message-switch/switch/dune @@ -8,7 +8,7 @@ cohttp-lwt-unix conduit-lwt-unix cstruct - io-page-unix + io-page lwt lwt.unix lwt_log diff --git a/ocaml/vhd-tool/src/dune b/ocaml/vhd-tool/src/dune index 31a8b24a41a..0d8436915ae 100644 --- a/ocaml/vhd-tool/src/dune +++ b/ocaml/vhd-tool/src/dune @@ -11,7 +11,7 @@ cohttp cohttp-lwt cstruct - io-page.unix + io-page lwt lwt.unix lwt_ssl diff --git a/ocaml/xcp-rrdd/lib/transport/page/dune b/ocaml/xcp-rrdd/lib/transport/page/dune index 7e396f2da29..b61de41c8bf 100644 --- a/ocaml/xcp-rrdd/lib/transport/page/dune +++ b/ocaml/xcp-rrdd/lib/transport/page/dune @@ -5,7 +5,7 @@ (libraries bigarray-compat cstruct - io-page.unix + io-page rrd_transport_lib threads.posix xen-gnt From 661d68245d218a0530f38c6e77d01311ac07d6ff Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 6 Oct 2022 14:58:49 +0100 Subject: [PATCH 09/75] nbd: change ocaml-nbd usage Signed-off-by: Pau Ruiz Safont --- ocaml/nbd/src/main.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/nbd/src/main.ml b/ocaml/nbd/src/main.ml index 3379679ee93..2ac49e9b84a 100644 --- a/ocaml/nbd/src/main.ml +++ b/ocaml/nbd/src/main.ml @@ -84,7 +84,7 @@ let init_tls_get_server_ctx ~certfile = Some (Nbd_unix.TlsServer (Nbd_unix.init_tls_get_ctx ~curve:"secp384r1" ~certfile - ~ciphersuites:Constants.good_ciphersuites + ~ciphersuites:Constants.good_ciphersuites () ) ) From efe565492dced538780224a510a30cd10b83c84e Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 4 Nov 2022 09:46:55 +0000 Subject: [PATCH 10/75] session_check: add action name in the error returned Makes it easier to spot which call failed this check when triaging related issues Signed-off-by: Pau Ruiz Safont --- ocaml/idl/ocaml_backend/gen_server.ml | 15 ++++++++------- ocaml/xapi/session_check.ml | 23 +++++++++++------------ ocaml/xapi/session_check.mli | 9 +++++++++ quality-gate.sh | 2 +- 4 files changed, 29 insertions(+), 20 deletions(-) create mode 100644 ocaml/xapi/session_check.mli diff --git a/ocaml/idl/ocaml_backend/gen_server.ml b/ocaml/idl/ocaml_backend/gen_server.ml index fe14e698e20..88d8996c99b 100644 --- a/ocaml/idl/ocaml_backend/gen_server.ml +++ b/ocaml/idl/ocaml_backend/gen_server.ml @@ -300,8 +300,9 @@ let operation (obj : obj) (x : message) = let session_check_exp = if x.msg_session then [ - Printf.sprintf "Session_check.check ~intra_pool_only:%b ~session_id;" - x.msg_pool_internal + Printf.sprintf + {|Session_check.check ~intra_pool_only:%b ~session_id ~action:"%s";|} + x.msg_pool_internal wire_name ] else [] @@ -528,19 +529,19 @@ let gen_module api : O.Module.t = ^ debug "This is not a built-in rpc \"%s\"" ["__call"] ; " begin match __params with" ; " | session_id_rpc :: _->" + ; " (* based on the Host.call_extension call *)" + ; " let action = \"Host.call_extension\" in" ; " let session_id = ref_session_of_rpc session_id_rpc in" ; " Session_check.check ~intra_pool_only:false \ - ~session_id;" - ; " (* based on the Host.call_extension call *)" + ~session_id ~action;" ; " let call_rpc = Rpc.String __call in " ; " let arg_names_values =" ; " [(\"session_id\", session_id_rpc); (__call, \ call_rpc)]" ; " in" ; " let key_names = [] in" - ; " let rbac __context fn = Rbac.check session_id \ - \"Host.call_extension\" ~args:arg_names_values \ - ~keys:key_names ~__context ~fn in" + ; " let rbac __context fn = Rbac.check session_id action \ + ~args:arg_names_values ~keys:key_names ~__context ~fn in" ; " Server_helpers.forward_extension ~__context rbac { \ call with Rpc.name = __call }" ; " | _ ->" diff --git a/ocaml/xapi/session_check.ml b/ocaml/xapi/session_check.ml index 324e8de46a8..16fef1ac30b 100644 --- a/ocaml/xapi/session_check.ml +++ b/ocaml/xapi/session_check.ml @@ -28,7 +28,7 @@ let is_local_session __context session_id = !check_local_session_hook (* intra_pool_only is true iff the call that's invoking this check can only be called from host<->host intra-pool communication *) -let check ~intra_pool_only ~session_id = +let check ~intra_pool_only ~session_id ~action = Server_helpers.exec_with_new_task ~quiet:true "session_check" (fun __context -> (* First see if this is a "local" session *) @@ -40,17 +40,16 @@ let check ~intra_pool_only ~session_id = Db_actions.DB_Action.Session.get_pool ~__context ~self:session_id in (* If the session is not a pool login, but this call is only supported for pool logins then fail *) - if (not pool) && intra_pool_only then - raise - (Api_errors.Server_error - ( Api_errors.internal_error - , [ - "Internal API call attempted with non-pool (external) \ - session" - ] - ) - ) ; - (* If the session isn't a pool login, and we're a slave, fail *) + ( if (not pool) && intra_pool_only then + let msg = + Printf.sprintf + {|Internal API "%s" call attempted with non-pool (external) session|} + action + in + raise Api_errors.(Server_error (internal_error, [msg])) + ) ; + + (* If the session isn't a pool login, and we're a supporter, fail *) if (not pool) && not (Pool_role.is_master ()) then raise Non_master_login_on_slave ; if Pool_role.is_master () then diff --git a/ocaml/xapi/session_check.mli b/ocaml/xapi/session_check.mli new file mode 100644 index 00000000000..73c8bcf282f --- /dev/null +++ b/ocaml/xapi/session_check.mli @@ -0,0 +1,9 @@ +exception Non_master_login_on_slave + +val check_local_session_hook : + (__context:Context.t -> session_id:[`session] Ref.t -> bool) option ref + +val is_local_session : Context.t -> [`session] Ref.t -> bool + +val check : + intra_pool_only:bool -> session_id:[`session] Ref.t -> action:string -> unit diff --git a/quality-gate.sh b/quality-gate.sh index 0e4377eaf3a..1fcb1d2e88d 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=512 + N=511 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) From d30d352378f2bb69bcb25330da65f57737226a41 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 10 Jan 2023 09:24:23 +0000 Subject: [PATCH 11/75] xenctrlext_stubs: fix xfm_open parameter mismatch The parameter open_flags was missing from the definition. Since it's actually unused by the underlying implementation its meaning is undefined. Remove the parameter and pass 0 to it. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 20844ea14f7..b28bb31b361 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -443,9 +443,9 @@ CAMLprim value stub_xenctrlext_cputopoinfo(value xch) CAMLreturn(result); } -CAMLprim value stub_xenforeignmemory_open(value logger, value open_flags) +CAMLprim value stub_xenforeignmemory_open(value logger) { - CAMLparam2(logger, open_flags); + CAMLparam1(logger); struct xentoollog_logger *log_handle = NULL; struct xenforeignmemory_handle *fmem; CAMLlocal1(result); @@ -458,7 +458,7 @@ CAMLprim value stub_xenforeignmemory_open(value logger, value open_flags) // handle fails the ocaml GC will collect this abstract tag result = caml_alloc(1, Abstract_tag); - fmem = xenforeignmemory_open(log_handle, Int_val(open_flags)); + fmem = xenforeignmemory_open(log_handle, 0); if(fmem == NULL) { caml_failwith("Error when opening foreign memory handle"); From c61d2ad82db0e9428fca1fb14b9475bdc1c4e23e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 09:36:45 +0000 Subject: [PATCH 12/75] vhd-tool/direct_copy_stubs: fix setting of O_DIRECT flag MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit If a file descriptor is open in the normal way then its flags will be 0, and the code here that attempts to enable O_DIRECT will do nothing. This appears to have been an incorrect way of inverting an error condition `ret < 0`, the negation of which is `ret >= 0`, and not `ret > 0`. We open the file with O_DIRECT elsewhere though (in vhd-format), but fix this code to avoid confusion. Signed-off-by: Edwin Török --- ocaml/vhd-tool/src/direct_copy_stubs.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/vhd-tool/src/direct_copy_stubs.c b/ocaml/vhd-tool/src/direct_copy_stubs.c index 7af50877cc2..5214c6d64fa 100644 --- a/ocaml/vhd-tool/src/direct_copy_stubs.c +++ b/ocaml/vhd-tool/src/direct_copy_stubs.c @@ -86,7 +86,7 @@ CAMLprim value stub_init(value in_fd, value out_fd) we might get on setting the flag. */ flags = fcntl(c_out_fd, F_GETFL, NULL); - if (flags > 0 && !(flags & O_DIRECT)) + if (flags >= 0 && !(flags & O_DIRECT)) fcntl(c_out_fd, F_SETFL, flags | O_DIRECT); #endif @@ -141,7 +141,7 @@ CAMLprim value stub_direct_copy(value handle, value len){ rc = TRIED_AND_FAILED; bytes = 0; - + remaining = c_len; while (remaining > 0) { ssize_t bread; From e72966bc8dd83d5666c93fe91282fde88929094d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 09:41:27 +0000 Subject: [PATCH 13/75] Makefile: add a rule to write out a compile_flags.txt MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit compile_flags.txt (or compile_commands.json) can be used by C language servers, like 'clangd' to provide in-editor feedback about C code compile warnings/errors (similar to ocaml-lsp). By default it wouldn't know where to find the OCaml includes and show a lot of warnings/errors when editing C stubs, and with this file it works. Signed-off-by: Edwin Török --- Makefile | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Makefile b/Makefile index 3d0f4498adb..007369d4460 100644 --- a/Makefile +++ b/Makefile @@ -214,3 +214,10 @@ uninstall: message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt \ message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-log \ xapi-open-uri + +compile_flags.txt: Makefile + (ocamlc -config-var ocamlc_cflags;\ + ocamlc -config-var ocamlc_cppflags;\ + echo -I$(shell ocamlc -where);\ + echo -Wall -Wextra -Wstrict-prototypes -D_FORTIFY_SOURCE=2\ + ) | xargs -n1 echo >$@ From b49a2b4a337ac9d9b7830ace68679fb3f8cddb17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 09:43:40 +0000 Subject: [PATCH 14/75] direct_copy_stubs.c: uerror is available in caml/unixsupport.h MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit There is no need to declare it by hand (it also has a slightly different prototype taking a 'const char*' as argument). Signed-off-by: Edwin Török --- ocaml/vhd-tool/src/direct_copy_stubs.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/ocaml/vhd-tool/src/direct_copy_stubs.c b/ocaml/vhd-tool/src/direct_copy_stubs.c index 5214c6d64fa..579df243e8e 100644 --- a/ocaml/vhd-tool/src/direct_copy_stubs.c +++ b/ocaml/vhd-tool/src/direct_copy_stubs.c @@ -32,10 +32,7 @@ #include #include #include - -/* ocaml/ocaml/unixsupport.c */ -extern void uerror(char *cmdname, value cmdarg); -#define Nothing ((value) 0) +#include enum direct_copy_rc { OK = 0, From 4390fabad9b11d7c027d86a49fe7d6a1f4098395 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:01:03 +0000 Subject: [PATCH 15/75] add .editorconfig: use spaces instead of tabs in C files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- .editorconfig | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 .editorconfig diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 00000000000..b468891f6be --- /dev/null +++ b/.editorconfig @@ -0,0 +1,20 @@ +# See ./CODING_STYLE +root = true + +[*] +end_of_line = lf +indent_style = space +charset = utf-8 +max_line_length = 79 +trim_trailing_whitespace = true +insert_final_newline = true + +# Makefiles must use tabs, otherwise they don't work +[Makefile] +indent_style = tabs + +[*.{c,h}] +indent_size = 4 + +[*.{ml,mli}] +indent_size = 2 From d8b7031458e652e2bc5cfa4cf1dda437c0a248e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:02:09 +0000 Subject: [PATCH 16/75] tuntap_stubs.c: raise Unix.error instead of failwith MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- ocaml/xenopsd/c_stubs/tuntap_stubs.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/ocaml/xenopsd/c_stubs/tuntap_stubs.c b/ocaml/xenopsd/c_stubs/tuntap_stubs.c index 6da44f5e338..f5c4a97cd23 100644 --- a/ocaml/xenopsd/c_stubs/tuntap_stubs.c +++ b/ocaml/xenopsd/c_stubs/tuntap_stubs.c @@ -1,5 +1,5 @@ /* - * (c) Citrix + * (c) Citrix * * This could be replaced by https://github.com/mirage/ocaml-tuntap * if more features are required. @@ -11,12 +11,14 @@ #include #include #include +#include - +#include #include #include #include #include +#include #define PATH_NET_TUN "/dev/net/tun" @@ -26,6 +28,7 @@ CAMLprim value stub_tap_open(value ocaml_ifname) { CAMLparam1(ocaml_ifname); + CAMLlocal1(path_net_tun); unsigned int features; struct ifreq ifr; const char *ifname = String_val(ocaml_ifname); @@ -41,20 +44,23 @@ CAMLprim value stub_tap_open(value ocaml_ifname) } strncpy(ifr.ifr_name, ifname, IFNAMSIZ); + path_net_tun = caml_copy_string(PATH_NET_TUN); int fd = open(PATH_NET_TUN, O_RDWR); if (fd < 0) { - caml_failwith("open(" PATH_NET_TUN ") failed in " __FILE__); + uerror("open", path_net_tun); } if (ioctl(fd, TUNGETFEATURES, &features) == -1) { + int saved_errno = errno; close(fd); - caml_failwith("TUNGETFEATURES failed in " __FILE__); + unix_error(saved_errno, "ioctl/TUNGETFEATURES", path_net_tun); } ifr.ifr_flags = IFF_TAP | IFF_NO_PI | (features & IFF_ONE_QUEUE); if (ioctl(fd, TUNSETIFF, (void *) &ifr) != 0) { + int saved_errno = errno; close(fd); - caml_failwith("ioctl failed in " __FILE__); + unix_error(saved_errno,"ioctl/TUNSETIFF", path_net_tun); } fcntl(fd, F_SETFL, O_NONBLOCK); From 4a7eec66226adb0a89ee0cc773efa51e9cc4ba21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:04:16 +0000 Subject: [PATCH 17/75] xenctrlext_stubs.c: xc_get_last_error is not thread safe, use just errno which is MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It is usually set to XC_INTERNAL_ERROR, except in xenguest, but we have no bindings for that. This API might get deleted in upstream Xen too: the error code is stored in the xenctrl handle, but we made that global per process, and shared among all threads. Which means that xenctrl calls from different threads can overwrite each-others' error code. Signed-off-by: Edwin Török --- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 26 ++++++++---------------- 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index b28bb31b361..f236bc8ff58 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -77,24 +77,14 @@ static void raise_unix_errno_msg(int err_code, const char *err_msg) static void failwith_xc(xc_interface *xch) { - static char error_str[XC_MAX_ERROR_MSG_LEN + 6]; - int real_errno = -1; - if (xch) { - const xc_error *error = xc_get_last_error(xch); - if (error->code == XC_ERROR_NONE) { - real_errno = errno; - snprintf(error_str, sizeof(error_str), "%d: %s", errno, strerror(errno)); - } else { - real_errno = error->code; - snprintf(error_str, sizeof(error_str), "%d: %s: %s", - error->code, - xc_error_code_to_desc(error->code), - error->message); - } - } else { - snprintf(error_str, sizeof(error_str), "Unable to open XC interface"); - } - raise_unix_errno_msg(real_errno, error_str); + static char error_str[XC_MAX_ERROR_MSG_LEN + 6]; + int real_errno = errno; + if (xch) { + snprintf(error_str, sizeof(error_str), "%d: %s", errno, strerror(errno)); + } else { + snprintf(error_str, sizeof(error_str), "Unable to open XC interface"); + } + raise_unix_errno_msg(real_errno, error_str); } CAMLprim value stub_xenctrlext_interface_open(void) From 7987d713fc6ed40d4a152634085f38bdddb03da4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:19:03 +0000 Subject: [PATCH 18/75] xa_auth_stubs.c: move free inside the blocking section MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is a C call, and might benefit from a bit more parallelism if it inside the blocking section. Signed-off-by: Edwin Török --- ocaml/auth/xa_auth_stubs.c | 18 ++++++++---------- ocaml/libs/log/syslog_stubs.c | 4 ++-- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/ocaml/auth/xa_auth_stubs.c b/ocaml/auth/xa_auth_stubs.c index 1c438a0ebc8..78dfb131eaf 100644 --- a/ocaml/auth/xa_auth_stubs.c +++ b/ocaml/auth/xa_auth_stubs.c @@ -32,19 +32,18 @@ CAMLprim value stub_XA_mh_authorize(value username, value password){ CAMLparam2(username, password); CAMLlocal1(ret); ret = Val_unit; - + char *c_username = strdup(String_val(username)); char *c_password = strdup(String_val(password)); const char *error = NULL; int rc; - + caml_enter_blocking_section(); rc = XA_mh_authorize(c_username, c_password, &error); - caml_leave_blocking_section(); - free(c_username); free(c_password); - + caml_leave_blocking_section(); + if (rc != XA_SUCCESS) caml_failwith(error ? error : "Unknown error"); CAMLreturn(ret); @@ -54,19 +53,18 @@ CAMLprim value stub_XA_mh_chpasswd(value username, value new_password){ CAMLparam2(username, new_password); CAMLlocal1(ret); ret = Val_unit; - + char *c_username = strdup(String_val(username)); char *c_new_password = strdup(String_val(new_password)); const char *error = NULL; int rc; - + caml_enter_blocking_section(); rc = XA_mh_chpasswd (c_username, c_new_password, &error); - caml_leave_blocking_section(); - free(c_username); free(c_new_password); - + caml_leave_blocking_section(); + if (rc != XA_SUCCESS) caml_failwith(error ? error : "Unknown error"); CAMLreturn(ret); diff --git a/ocaml/libs/log/syslog_stubs.c b/ocaml/libs/log/syslog_stubs.c index 3cca2186372..1a8a777dcd3 100644 --- a/ocaml/libs/log/syslog_stubs.c +++ b/ocaml/libs/log/syslog_stubs.c @@ -59,9 +59,9 @@ value stub_syslog(value facility, value level, value msg) caml_enter_blocking_section(); syslog(c_facility, "%s", c_msg); - caml_leave_blocking_section(); - free(c_msg); + caml_leave_blocking_section(); + CAMLreturn(Val_unit); } From 1e02ea21a05f561605f41701471dfba04a56e60d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:20:01 +0000 Subject: [PATCH 19/75] xenctrlext_stubs.c: add missing enter/leave blocking section MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Most of these calls pass only integers or pointers allocated in C, so it is safe to release the OCaml runtime lock. Replace direct passing of Xfm_val/Caml_ba_data_val with storing in a temporary local variable (the result of Xfm_val or Caml_ba_data_val won't move since they are C pointers, but the OCaml value passed in as params to these macros might!) Signed-off-by: Edwin Török --- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 48 +++++++++++++++++++++--- 1 file changed, 42 insertions(+), 6 deletions(-) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index f236bc8ff58..868fbbf9c7f 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -114,7 +114,9 @@ CAMLprim value stub_xenctrlext_get_runstate_info(value xch, value domid) xc_runstate_info_t info; int retval; + caml_enter_blocking_section(); retval = xc_get_runstate_info(_H(xch), _D(domid), &info); + caml_leave_blocking_section(); if (retval < 0) failwith_xc(_H(xch)); @@ -149,7 +151,9 @@ CAMLprim value stub_xenctrlext_get_boot_cpufeatures(value xch) uint32_t a, b, c, d, e, f, g, h; int ret; + caml_enter_blocking_section(); ret = xc_get_boot_cpufeatures(_H(xch), &a, &b, &c, &d, &e, &f, &g, &h); + caml_leave_blocking_section(); if (ret < 0) failwith_xc(_H(xch)); @@ -186,7 +190,9 @@ CAMLprim value stub_xenctrlext_domain_get_acpi_s_state(value xch, value domid) unsigned long v; int ret; + caml_enter_blocking_section(); ret = xc_get_hvm_param(_H(xch), _D(domid), HVM_PARAM_ACPI_S_STATE, &v); + caml_leave_blocking_section(); if (ret != 0) failwith_xc(_H(xch)); @@ -196,7 +202,9 @@ CAMLprim value stub_xenctrlext_domain_get_acpi_s_state(value xch, value domid) CAMLprim value stub_xenctrlext_domain_send_s3resume(value xch, value domid) { CAMLparam2(xch, domid); + caml_enter_blocking_section(); xcext_domain_send_s3resume(_H(xch), _D(domid)); + caml_leave_blocking_section(); CAMLreturn(Val_unit); } @@ -205,7 +213,9 @@ CAMLprim value stub_xenctrlext_domain_set_timer_mode(value xch, value id, value CAMLparam3(xch, id, mode); int ret; + caml_enter_blocking_section(); ret = xcext_domain_set_timer_mode(_H(xch), _D(id), Int_val(mode)); + caml_leave_blocking_section(); if (ret < 0) failwith_xc(_H(xch)); CAMLreturn(Val_unit); @@ -233,7 +243,9 @@ CAMLprim value stub_xenctrlext_domain_set_target(value xch, { CAMLparam3(xch, domid, target); + caml_enter_blocking_section(); int retval = xc_domain_set_target(_H(xch), _D(domid), _D(target)); + caml_leave_blocking_section(); if (retval) failwith_xc(_H(xch)); CAMLreturn(Val_unit); @@ -311,7 +323,9 @@ CAMLprim value stub_xenctrlext_domain_update_channels(value xch, value domid, static int get_cpumap_len(value xch, value cpumap) { int ml_len = Wosize_val(cpumap); + caml_enter_blocking_section(); int xc_len = xc_get_max_cpus(_H(xch)); + caml_leave_blocking_section(); return (ml_len < xc_len ? ml_len : xc_len); } @@ -324,7 +338,9 @@ CAMLprim value stub_xenctrlext_vcpu_setaffinity_soft(value xch, value domid, xc_cpumap_t c_cpumap; int retval; + caml_enter_blocking_section(); c_cpumap = xc_cpumap_alloc(_H(xch)); + caml_leave_blocking_section(); if (c_cpumap == NULL) failwith_xc(_H(xch)); @@ -332,11 +348,13 @@ CAMLprim value stub_xenctrlext_vcpu_setaffinity_soft(value xch, value domid, if (Bool_val(Field(cpumap, i))) c_cpumap[i/8] |= 1 << (i&7); } + caml_enter_blocking_section(); retval = xc_vcpu_setaffinity(_H(xch), _D(domid), Int_val(vcpu), NULL, c_cpumap, XEN_VCPUAFFINITY_SOFT); free(c_cpumap); + caml_leave_blocking_section(); if (retval < 0) failwith_xc(_H(xch)); @@ -353,7 +371,9 @@ CAMLprim value stub_xenctrlext_numainfo(value xch) unsigned i, j; int retval; + caml_enter_blocking_section(); retval = xc_numainfo(_H(xch), &max_nodes, NULL, NULL); + caml_leave_blocking_section(); if (retval < 0) failwith_xc(_H(xch)); @@ -365,7 +385,9 @@ CAMLprim value stub_xenctrlext_numainfo(value xch) caml_raise_out_of_memory(); } + caml_enter_blocking_section(); retval = xc_numainfo(_H(xch), &max_nodes, meminfo, distance); + caml_leave_blocking_section(); if (retval < 0) { free(meminfo); free(distance); @@ -406,7 +428,9 @@ CAMLprim value stub_xenctrlext_cputopoinfo(value xch) unsigned max_cpus, i; int retval; + caml_enter_blocking_section(); retval = xc_cputopoinfo(_H(xch), &max_cpus, NULL); + caml_leave_blocking_section(); if (retval < 0) failwith_xc(_H(xch)); @@ -414,7 +438,9 @@ CAMLprim value stub_xenctrlext_cputopoinfo(value xch) if (!cputopo) caml_raise_out_of_memory(); + caml_enter_blocking_section(); retval = xc_cputopoinfo(_H(xch), &max_cpus, cputopo); + caml_leave_blocking_section(); if (retval < 0) { free(cputopo); failwith_xc(_H(xch)); @@ -448,7 +474,9 @@ CAMLprim value stub_xenforeignmemory_open(value logger) // handle fails the ocaml GC will collect this abstract tag result = caml_alloc(1, Abstract_tag); + caml_enter_blocking_section(); fmem = xenforeignmemory_open(log_handle, 0); + caml_leave_blocking_section(); if(fmem == NULL) { caml_failwith("Error when opening foreign memory handle"); @@ -463,13 +491,16 @@ CAMLprim value stub_xenforeignmemory_close(value fmem) { CAMLparam1(fmem); int retval; + struct xenforeignmemory_handle *handle = Xfm_val(fmem); - if(Xfm_val(fmem) == NULL) { + if(handle == NULL) { caml_invalid_argument( "Error: cannot close NULL foreign memory handle"); } - retval = xenforeignmemory_close(Xfm_val(fmem)); + caml_enter_blocking_section(); + retval = xenforeignmemory_close(handle); + caml_leave_blocking_section(); if(retval < 0) { caml_failwith("Error when closing foreign memory handle"); @@ -490,6 +521,7 @@ CAMLprim value stub_xenforeignmemory_map(value fmem, value dom, xen_pfn_t *arr; int prot, the_errno; void *retval; + struct xenforeignmemory_handle *handle = Xfm_val(fmem); if (Field(prot_flags, 0) == Val_false && Field(prot_flags, 1) == Val_false && @@ -526,11 +558,12 @@ CAMLprim value stub_xenforeignmemory_map(value fmem, value dom, cell = Field(cell, 1); } + caml_enter_blocking_section(); retval = xenforeignmemory_map - (Xfm_val(fmem), _D(dom), prot, pages_length, arr, NULL); + (handle, _D(dom), prot, pages_length, arr, NULL); the_errno = errno; - free(arr); + caml_leave_blocking_section(); if(retval == NULL) { raise_unix_errno_msg(the_errno, @@ -549,12 +582,15 @@ CAMLprim value stub_xenforeignmemory_unmap(value fmem, value mapping) CAMLparam2(fmem, mapping); size_t pages; int retval, the_errno; + struct xenforeignmemory_handle *handle = Xfm_val(fmem); + void *data = Caml_ba_data_val(mapping); // convert mapping to pages and addr pages = Caml_ba_array_val(mapping)->dim[0] / 4096; - retval = xenforeignmemory_unmap(Xfm_val(fmem), - Caml_ba_data_val(mapping), pages); + caml_enter_blocking_section(); + retval = xenforeignmemory_unmap(handle, data, pages); + caml_leave_blocking_section(); the_errno = errno; if(retval < 0) { From ed21d97725f1414a7c1583ad761a680a71ba57c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:46:08 +0000 Subject: [PATCH 20/75] unixpwd_stubs.c: factor out common code and use enter/leave blocking section where possible MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit unshadow is not thread safe, but the other ones should be. TODO: double check all C API calls in unixpwd.c with the MT-safe portion of the manpage Signed-off-by: Edwin Török --- unixpwd/c/unixpwd_stubs.c | 118 +++++++++++++++++--------------------- 1 file changed, 52 insertions(+), 66 deletions(-) diff --git a/unixpwd/c/unixpwd_stubs.c b/unixpwd/c/unixpwd_stubs.c index 1b173e1d439..69de7894faa 100644 --- a/unixpwd/c/unixpwd_stubs.c +++ b/unixpwd/c/unixpwd_stubs.c @@ -20,24 +20,30 @@ #include #include #include +#include +#include #include "unixpwd.h" - -CAMLprim value -caml_unixpwd_getpwd(value caml_user) +static CAMLprim value caml_unixpwd_get_(value caml_user, const char *fname, char*(*f)(const char*)) { CAMLparam1(caml_user); - const char *user; - char *passwd; + char *user; + char *passwd; + int saved_errno; CAMLlocal1(pw); - user = String_val(caml_user); - passwd = unixpwd_getpwd(user); - if (passwd == NULL && errno != 0) - caml_failwith(strerror(errno)); - if (passwd == NULL) - caml_failwith("unspecified error in caml_unixpwd_getpwd()"); + user = caml_stat_strdup(String_val(caml_user)); + caml_enter_blocking_section(); + errno = 0; + passwd = f(user); + saved_errno = errno; + caml_stat_free(user); user = NULL; + caml_leave_blocking_section(); + errno = saved_errno; + + if (passwd == NULL) /* errno of 0 will be mapped to `EUNKNOWNERR of 0` */ + uerror(fname, caml_user); pw = caml_copy_string(passwd); free(passwd); @@ -45,79 +51,59 @@ caml_unixpwd_getpwd(value caml_user) } CAMLprim value -caml_unixpwd_getspw(value caml_user) +caml_unixpwd_getpwd(value caml_user) { - CAMLparam1(caml_user); - const char *user; - char *passwd; - CAMLlocal1(pw); - - user = String_val(caml_user); - passwd = unixpwd_getspw(user); - if (passwd == NULL && errno != 0) - caml_failwith(strerror(errno)); - if (passwd == NULL) - caml_failwith("unspecified error in caml_unixpwd_getspw()"); - - pw = caml_copy_string(passwd); - free(passwd); - CAMLreturn(pw); + return caml_unixpwd_get_(caml_user, "unixpwd_getpwd", unixpwd_getpwd); } - +CAMLprim value +caml_unixpwd_getspw(value caml_user) +{ + return caml_unixpwd_get_(caml_user, "unixpwd_getspw", unixpwd_getspw); +} CAMLprim value caml_unixpwd_get(value caml_user) { - CAMLparam1(caml_user); - const char *user; - char *passwd; - CAMLlocal1(pw); - - user = String_val(caml_user); - passwd = unixpwd_get(user); - if (passwd == NULL && errno != 0) - caml_failwith(strerror(errno)); - if (passwd == NULL) - caml_failwith("unspecified error in caml_unixpwd_get()"); - - pw = caml_copy_string(passwd); - free(passwd); - CAMLreturn(pw); + return caml_unixpwd_get_(caml_user, "unixpwd_get", unixpwd_get); } -CAMLprim value -caml_unixpwd_setpwd(value caml_user, value caml_password) +static CAMLprim value caml_unixpwd_set_(value caml_user, value caml_password, const char *fname, int(*f)(const char*, char*)) { CAMLparam2(caml_user, caml_password); - const char *user; - char *password; - int rc; + char *user; + char *password; + int saved_errno; + int rc; - user = String_val(caml_user); + user = caml_stat_strdup(String_val(caml_user)); password = caml_stat_strdup(String_val(caml_password)); - rc = unixpwd_setpwd(user, password); + caml_enter_blocking_section(); + errno = 0; + rc = f(user, password); + saved_errno = errno; + caml_stat_free(user); caml_stat_free(password); + caml_leave_blocking_section(); + errno = saved_errno; + if (rc != 0) - caml_failwith(strerror(rc)); + uerror(fname, caml_user); /* only raise with user not pass */ CAMLreturn(Val_unit); } CAMLprim value -caml_unixpwd_setspw(value caml_user, value caml_password) +caml_unixpwd_setpwd(value caml_user, value caml_password) { - CAMLparam2(caml_user, caml_password); - const char *user; - char *password; - int rc; + return caml_unixpwd_set_(caml_user, caml_password, "unix_setpwd", + unixpwd_setpwd); +} - user = String_val(caml_user); - password = caml_stat_strdup(String_val(caml_password)); - rc = unixpwd_setspw(user, password); - caml_stat_free(password); - if (rc != 0) - caml_failwith(strerror(rc)); - CAMLreturn(Val_unit); +CAMLprim value +caml_unixpwd_setspw(value caml_user, value caml_password) +{ + return caml_unixpwd_set_(caml_user, caml_password, "unix_setpwd", + unixpwd_setspw); } CAMLprim value @@ -127,11 +113,11 @@ caml_unixpwd_unshadow(void) char *passwords; CAMLlocal1(str); + /* NOT thread safe, retain runtime lock for now, it uses setpwent/endpwent, + * this should be replaced by fopen/fpwgetent_r/etc. */ passwords = unixpwd_unshadow(); - if (passwords == NULL && errno != 0) - caml_failwith(strerror(errno)); if (passwords == NULL) - caml_failwith("unspecified error in caml_unixpwd_unshadow()"); + uerror("unixpwd_unshadow", Nothing); str = caml_copy_string(passwords); free(passwords); From 57c6d2be4cc6d210bb5e8d1718a0d7576a07aed1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 7 Dec 2022 10:47:42 +0000 Subject: [PATCH 21/75] C stubs: add and use .clang-format MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We may intend to upstream the xenctrlext stubs to Xen, so it should follow the Xen CODING_STYLE. the .clang-format here is based on the version I sent upstream that tries to follow that coding style. Signed-off-by: Edwin Török --- .clang-format | 9 + Makefile | 1 + ocaml/auth/xa_auth.c | 85 +- ocaml/auth/xa_auth.h | 8 +- ocaml/auth/xa_auth_stubs.c | 21 +- ocaml/libs/log/syslog_stubs.c | 82 +- .../c/autogen/include/xen/api/xen_common.h | 139 +- .../autogen/include/xen/api/xen_event_batch.h | 14 +- .../c/autogen/include/xen/api/xen_int_set.h | 18 +- .../autogen/include/xen/api/xen_string_set.h | 18 +- .../include/xen/api/xen_string_set_set.h | 18 +- ocaml/sdk-gen/c/autogen/src/xen_common.c | 1422 +++++++---------- ocaml/sdk-gen/c/autogen/src/xen_event_batch.c | 51 +- ocaml/sdk-gen/c/autogen/src/xen_int_set.c | 20 +- ocaml/sdk-gen/c/autogen/src/xen_string_set.c | 25 +- .../c/autogen/src/xen_string_set_set.c | 23 +- ocaml/sdk-gen/c/autogen/test/test_enumerate.c | 255 +-- .../c/autogen/test/test_event_handling.c | 114 +- ocaml/sdk-gen/c/autogen/test/test_failures.c | 23 +- .../sdk-gen/c/autogen/test/test_get_records.c | 164 +- .../c/autogen/test/test_vm_async_migrate.c | 149 +- ocaml/sdk-gen/c/autogen/test/test_vm_ops.c | 489 +++--- ocaml/vhd-tool/src/direct_copy_stubs.c | 335 ++-- ocaml/xenopsd/c_stubs/sockopt_stubs.c | 67 +- ocaml/xenopsd/c_stubs/tuntap_stubs.c | 34 +- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 776 ++++----- unixpwd/c/main.c | 70 +- unixpwd/c/unixpwd.c | 196 +-- unixpwd/c/unixpwd.h | 12 +- unixpwd/c/unixpwd_stubs.c | 58 +- 30 files changed, 2236 insertions(+), 2460 deletions(-) create mode 100644 .clang-format diff --git a/.clang-format b/.clang-format new file mode 100644 index 00000000000..7ff88ee0430 --- /dev/null +++ b/.clang-format @@ -0,0 +1,9 @@ +BasedOnStyle: GNU +IndentWidth: 4 + +# override GNU to match Xen ../../CODING_STYLE more closely +AlwaysBreakAfterDefinitionReturnType: None +AlwaysBreakAfterReturnType: None +SpacesInConditionalStatement: true +SpaceBeforeParens: ControlStatements +BreakBeforeBraces: Allman diff --git a/Makefile b/Makefile index 007369d4460..92f09c02cf3 100644 --- a/Makefile +++ b/Makefile @@ -82,6 +82,7 @@ doc-json: format: dune build @fmt --auto-promote + git ls-files '*.c' '*.h' | xargs clang-format -i .PHONY: quality-gate quality-gate: diff --git a/ocaml/auth/xa_auth.c b/ocaml/auth/xa_auth.c index 09adccb053e..290bbd82f8e 100644 --- a/ocaml/auth/xa_auth.c +++ b/ocaml/auth/xa_auth.c @@ -22,7 +22,8 @@ #define XA_LOG_AUTH "authhelper" /* Adapted from xenagentd.hg:src/xa_auth.c */ -struct xa_auth_info { +struct xa_auth_info +{ const char *username; const char *password; }; @@ -34,98 +35,109 @@ static int xa_auth_conv(int num_msg, const struct pam_message **msg, struct pam_response *response; int i, j; - if (msg == NULL || resp == NULL || app_data == NULL) + if ( msg == NULL || resp == NULL || app_data == NULL ) return PAM_CONV_ERR; - - response = calloc (num_msg, sizeof (struct pam_response)); - if (response == NULL) + + response = calloc(num_msg, sizeof(struct pam_response)); + if ( response == NULL ) return PAM_CONV_ERR; - - for (i = 0; i < num_msg; i++) { - switch(msg[i]->msg_style) { + + for ( i = 0; i < num_msg; i++ ) + { + switch ( msg[i]->msg_style ) + { case PAM_PROMPT_ECHO_ON: response[i].resp = strdup(auth_info->username); - if (response[i].resp == NULL) - goto resperr; + if ( response[i].resp == NULL ) + goto resperr; break; case PAM_PROMPT_ECHO_OFF: response[i].resp = strdup(auth_info->password); - if (response[i].resp == NULL) - goto resperr; + if ( response[i].resp == NULL ) + goto resperr; break; default: goto resperr; } } - + *resp = response; return PAM_SUCCESS; resperr: - for (j = 0; j < i; j++) + for ( j = 0; j < i; j++ ) free(response[j].resp); free(response); return PAM_CONV_ERR; } -int XA_mh_authorize (const char *username, const char *password, - const char **error) +int XA_mh_authorize(const char *username, const char *password, + const char **error) { - struct xa_auth_info auth_info = {username, password}; - struct pam_conv xa_conv = {xa_auth_conv, &auth_info}; + struct xa_auth_info auth_info = { username, password }; + struct pam_conv xa_conv = { xa_auth_conv, &auth_info }; pam_handle_t *pamh; int rc = XA_SUCCESS; - if ((rc = pam_start(SERVICE_NAME, username, &xa_conv, &pamh)) - != PAM_SUCCESS) { + if ( (rc = pam_start(SERVICE_NAME, username, &xa_conv, &pamh)) + != PAM_SUCCESS ) + { goto exit; } - if ((rc = pam_authenticate(pamh, PAM_DISALLOW_NULL_AUTHTOK)) - != PAM_SUCCESS) { + if ( (rc = pam_authenticate(pamh, PAM_DISALLOW_NULL_AUTHTOK)) + != PAM_SUCCESS ) + { goto exit; } rc = pam_acct_mgmt(pamh, PAM_DISALLOW_NULL_AUTHTOK); - exit: +exit: pam_end(pamh, rc); - if (rc != PAM_SUCCESS) { - if (error) *error = pam_strerror(pamh, rc); + if ( rc != PAM_SUCCESS ) + { + if ( error ) + *error = pam_strerror(pamh, rc); rc = XA_ERR_EXTERNAL; } - else { + else + { rc = XA_SUCCESS; } return rc; } -int XA_mh_chpasswd (const char *username, const char *new_passwd, const char **error) +int XA_mh_chpasswd(const char *username, const char *new_passwd, + const char **error) { - struct xa_auth_info auth_info = {username, new_passwd}; - struct pam_conv xa_conv = {xa_auth_conv, &auth_info}; + struct xa_auth_info auth_info = { username, new_passwd }; + struct pam_conv xa_conv = { xa_auth_conv, &auth_info }; pam_handle_t *pamh; int rc = XA_SUCCESS; - if ((rc = pam_start(SERVICE_NAME, username, &xa_conv, &pamh)) - != PAM_SUCCESS) { + if ( (rc = pam_start(SERVICE_NAME, username, &xa_conv, &pamh)) + != PAM_SUCCESS ) + { goto exit; } rc = pam_chauthtok(pamh, 0); - exit: - if (rc != PAM_SUCCESS) { - if (error) *error = pam_strerror(pamh, rc); +exit: + if ( rc != PAM_SUCCESS ) + { + if ( error ) + *error = pam_strerror(pamh, rc); pam_end(pamh, rc); rc = XA_ERR_EXTERNAL; } - else { + else + { pam_end(pamh, rc); rc = XA_SUCCESS; } return rc; } - /* * Local variables: * mode: C @@ -135,4 +147,3 @@ int XA_mh_chpasswd (const char *username, const char *new_passwd, const char **e * indent-tabs-mode: nil * End: */ - diff --git a/ocaml/auth/xa_auth.h b/ocaml/auth/xa_auth.h index faa8ada4b3b..50e1e429940 100644 --- a/ocaml/auth/xa_auth.h +++ b/ocaml/auth/xa_auth.h @@ -17,10 +17,10 @@ #define XA_SUCCESS 0 #define XA_ERR_EXTERNAL 1 -extern int XA_mh_authorize (const char *username, const char *password, - const char **error); +extern int XA_mh_authorize(const char *username, const char *password, + const char **error); -extern int XA_mh_chpasswd (const char *username, const char *new_passwd, - const char **error); +extern int XA_mh_chpasswd(const char *username, const char *new_passwd, + const char **error); #endif /* _XA_AUTH_H_ */ diff --git a/ocaml/auth/xa_auth_stubs.c b/ocaml/auth/xa_auth_stubs.c index 78dfb131eaf..b3c6da723fc 100644 --- a/ocaml/auth/xa_auth_stubs.c +++ b/ocaml/auth/xa_auth_stubs.c @@ -14,21 +14,22 @@ /* */ -#include #include #include +#include -#include -#include #include +#include #include #include -#include +#include +#include #include #include "xa_auth.h" -CAMLprim value stub_XA_mh_authorize(value username, value password){ +CAMLprim value stub_XA_mh_authorize(value username, value password) +{ CAMLparam2(username, password); CAMLlocal1(ret); ret = Val_unit; @@ -44,12 +45,13 @@ CAMLprim value stub_XA_mh_authorize(value username, value password){ free(c_password); caml_leave_blocking_section(); - if (rc != XA_SUCCESS) + if ( rc != XA_SUCCESS ) caml_failwith(error ? error : "Unknown error"); CAMLreturn(ret); } -CAMLprim value stub_XA_mh_chpasswd(value username, value new_password){ +CAMLprim value stub_XA_mh_chpasswd(value username, value new_password) +{ CAMLparam2(username, new_password); CAMLlocal1(ret); ret = Val_unit; @@ -60,12 +62,12 @@ CAMLprim value stub_XA_mh_chpasswd(value username, value new_password){ int rc; caml_enter_blocking_section(); - rc = XA_mh_chpasswd (c_username, c_new_password, &error); + rc = XA_mh_chpasswd(c_username, c_new_password, &error); free(c_username); free(c_new_password); caml_leave_blocking_section(); - if (rc != XA_SUCCESS) + if ( rc != XA_SUCCESS ) caml_failwith(error ? error : "Unknown error"); CAMLreturn(ret); } @@ -79,4 +81,3 @@ CAMLprim value stub_XA_mh_chpasswd(value username, value new_password){ * indent-tabs-mode: nil * End: */ - diff --git a/ocaml/libs/log/syslog_stubs.c b/ocaml/libs/log/syslog_stubs.c index 1a8a777dcd3..b0222c86848 100644 --- a/ocaml/libs/log/syslog_stubs.c +++ b/ocaml/libs/log/syslog_stubs.c @@ -12,62 +12,72 @@ * GNU Lesser General Public License for more details. */ -#include -#include -#include -#include #include #include +#include +#include #include +#include +#include -static int __syslog_level_table[] = { - LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, - LOG_NOTICE, LOG_INFO, LOG_DEBUG -}; +static int __syslog_level_table[] + = { LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, + LOG_WARNING, LOG_NOTICE, LOG_INFO, LOG_DEBUG }; -static int __syslog_facility_table[] = { - LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, - LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, - LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7, - LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP -}; +static int __syslog_facility_table[] + = { LOG_AUTH, + LOG_AUTHPRIV, + LOG_CRON, + LOG_DAEMON, + LOG_FTP, + LOG_KERN, + LOG_LOCAL0, + LOG_LOCAL1, + LOG_LOCAL2, + LOG_LOCAL3, + LOG_LOCAL4, + LOG_LOCAL5, + LOG_LOCAL6, + LOG_LOCAL7, + LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP }; /* According to the openlog manpage the 'openlog' call may take a reference - to the 'ident' string and keep it long-term. This means we cannot just pass in - an ocaml string which is under the control of the GC. Since we aren't actually - calling this function we can just comment it out for the time-being. */ + to the 'ident' string and keep it long-term. This means we cannot just pass + in an ocaml string which is under the control of the GC. Since we aren't + actually calling this function we can just comment it out for the + time-being. */ /* value stub_openlog(value ident, value option, value facility) { - CAMLparam3(ident, option, facility); - int c_option; - int c_facility; + CAMLparam3(ident, option, facility); + int c_option; + int c_facility; - c_option = caml_convert_flag_list(option, __syslog_options_table); - c_facility = __syslog_facility_table[Int_val(facility)]; - openlog(String_val(ident), c_option, c_facility); - CAMLreturn(Val_unit); + c_option = caml_convert_flag_list(option, __syslog_options_table); + c_facility = __syslog_facility_table[Int_val(facility)]; + openlog(String_val(ident), c_option, c_facility); + CAMLreturn(Val_unit); } */ value stub_syslog(value facility, value level, value msg) { - CAMLparam3(facility, level, msg); - char *c_msg = strdup(String_val(msg)); - int c_facility = __syslog_facility_table[Int_val(facility)] - | __syslog_level_table[Int_val(level)]; + CAMLparam3(facility, level, msg); + char *c_msg = strdup(String_val(msg)); + int c_facility = __syslog_facility_table[Int_val(facility)] + | __syslog_level_table[Int_val(level)]; - caml_enter_blocking_section(); - syslog(c_facility, "%s", c_msg); - free(c_msg); - caml_leave_blocking_section(); + caml_enter_blocking_section(); + syslog(c_facility, "%s", c_msg); + free(c_msg); + caml_leave_blocking_section(); - CAMLreturn(Val_unit); + CAMLreturn(Val_unit); } value stub_closelog(value unit) { - CAMLparam1(unit); - closelog(); - CAMLreturn(Val_unit); + CAMLparam1(unit); + closelog(); + CAMLreturn(Val_unit); } diff --git a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_common.h b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_common.h index 43882a5d7b1..abd546a51f2 100644 --- a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_common.h +++ b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_common.h @@ -31,7 +31,6 @@ #ifndef XEN_COMMON_H #define XEN_COMMON_H - #include #include #include @@ -53,22 +52,19 @@ #endif #endif -#include "xen_api_version.h" #include "xen/api/xen_host_decl.h" -#include "xen/api/xen_task_decl.h" #include "xen/api/xen_string_set.h" - +#include "xen/api/xen_task_decl.h" +#include "xen_api_version.h" typedef bool (*xen_result_func)(const void *data, size_t len, void *result_handle); - /** * len does not include a terminating \0. */ typedef int (*xen_call_func)(const void *, size_t len, void *user_handle, - void *result_handle, - xen_result_func result_func); + void *result_handle, xen_result_func result_func); typedef struct { @@ -81,7 +77,6 @@ typedef struct xen_api_version api_version; } xen_session; - typedef struct xen_session_record { char *uuid; @@ -90,33 +85,26 @@ typedef struct xen_session_record time_t last_active; } xen_session_record; - /** * Allocate a xen_session_record. */ -extern xen_session_record * -xen_session_record_alloc(void); - +extern xen_session_record *xen_session_record_alloc(void); /** * Free the given xen_session_record, and all referenced values. The * given record must have been allocated by this library. */ -extern void -xen_session_record_free(xen_session_record *record); - +extern void xen_session_record_free(xen_session_record *record); struct xen_task_; -typedef struct xen_task_ * xen_task_id; - +typedef struct xen_task_ *xen_task_id; typedef struct { int progress; long eta; /* !!! RESULT */ -} xen_task_status; - +} xen_task_status; typedef struct { @@ -126,13 +114,11 @@ typedef struct char *extraversion; } xen_version; - /** * Free the given xen_version, and all referenced values. */ extern void xen_version_free(xen_version *version); - /** * Return the version of this client-side library. This will be the major, * minor, and extraversion of the Xen release with which it was released, @@ -140,147 +126,118 @@ extern void xen_version_free(xen_version *version); */ extern xen_version *xen_get_client_side_version(); +extern bool xen_uuid_string_to_bytes(char *uuid, char **bytes); -extern bool -xen_uuid_string_to_bytes(char *uuid, char **bytes); - +extern bool xen_uuid_bytes_to_string(char *bytes, char **uuid); -extern bool -xen_uuid_bytes_to_string(char *bytes, char **uuid); - - -extern void -xen_uuid_free(char *uuid); - - -extern void -xen_uuid_bytes_free(char *bytes); +extern void xen_uuid_free(char *uuid); +extern void xen_uuid_bytes_free(char *bytes); /** * Initialise this library. Call this before starting to use this library. * Note that since this library depends upon libxml2, you should also call * xmlInitParser as appropriate for your program. */ -extern -void xen_init(void); - +extern void xen_init(void); /** * Clear up this library. Call when you have finished using this library. * Note that since this library depends upon libxml2, you should also call * xmlCleanupParser as appropriate for your program. */ -extern -void xen_fini(void); - +extern void xen_fini(void); /** * Log in at the server, and allocate a xen_session to represent this session. */ -extern xen_session * -xen_session_login_with_password(xen_call_func call_func, void *handle, - const char *uname, const char *pwd, - xen_api_version version); - +extern xen_session *xen_session_login_with_password(xen_call_func call_func, + void *handle, + const char *uname, + const char *pwd, + xen_api_version version); /** * Log in at the server, and allocate a xen_session to represent this session. */ -extern xen_session * -xen_session_slave_local_login_with_password(xen_call_func call_func, void *handle, - const char *uname, const char *pwd); - +extern xen_session *xen_session_slave_local_login_with_password( + xen_call_func call_func, void *handle, const char *uname, const char *pwd); /** * Log out at the server, and free the xen_session. */ -extern void -xen_session_logout(xen_session *session); - +extern void xen_session_logout(xen_session *session); /** * Log out at the server, and free the local xen_session. */ -extern void -xen_session_local_logout(xen_session *session); - +extern void xen_session_local_logout(xen_session *session); - /** - * Log out all sessions associated to a user subject-identifier, except the session associated with the context calling this function +/** + * Log out all sessions associated to a user subject-identifier, except the + * session associated with the context calling this function */ extern bool -xen_session_logout_subject_identifier(xen_session *session, const char *subject_identifier); +xen_session_logout_subject_identifier(xen_session *session, + const char *subject_identifier); - - /** - * Log out all sessions associated to a user subject-identifier, except the session associated with the context calling this function +/** + * Log out all sessions associated to a user subject-identifier, except the + * session associated with the context calling this function */ -extern bool -xen_session_logout_subject_identifier_async(xen_session *session, xen_task *result, const char *subject_identifier); - +extern bool xen_session_logout_subject_identifier_async( + xen_session *session, xen_task *result, const char *subject_identifier); /** * Return a list of all the user subject-identifiers of all existing sessions */ extern bool -xen_session_get_all_subject_identifiers(xen_session *session, struct xen_string_set **result); - +xen_session_get_all_subject_identifiers(xen_session *session, + struct xen_string_set **result); /** * Return a list of all the user subject-identifiers of all existing sessions */ -extern bool -xen_session_get_all_subject_identifiers_async(xen_session *session, xen_task *result); - +extern bool xen_session_get_all_subject_identifiers_async(xen_session *session, + xen_task *result); /** * Clear any error condition recorded on this session. */ -void -xen_session_clear_error(xen_session *session); - +void xen_session_clear_error(xen_session *session); /** * Get the UUID of the second given session. Set *result to point at a * string, yours to free. */ -extern bool -xen_session_get_uuid(xen_session *session, char **result, - xen_session *self_session); - +extern bool xen_session_get_uuid(xen_session *session, char **result, + xen_session *self_session); /** * Get the this_host field of the second given session. Set *result to be a * handle to that host. */ -extern bool -xen_session_get_this_host(xen_session *session, xen_host *result, - xen_session *self_session); - +extern bool xen_session_get_this_host(xen_session *session, xen_host *result, + xen_session *self_session); /** * Get the this_user field of the second given session. Set *result to point * at a string, yours to free. */ -extern bool -xen_session_get_this_user(xen_session *session, char **result, - xen_session *self_session); - +extern bool xen_session_get_this_user(xen_session *session, char **result, + xen_session *self_session); /** * Get the last_active field of the given session, and place it in *result. */ -extern bool -xen_session_get_last_active(xen_session *session, time_t *result, - xen_session *self_session); +extern bool xen_session_get_last_active(xen_session *session, time_t *result, + xen_session *self_session); /** * Get a record containing the current state of the second given session. */ -extern bool -xen_session_get_record(xen_session *session, xen_session_record **result, - xen_session *self_session); - +extern bool xen_session_get_record(xen_session *session, + xen_session_record **result, + xen_session *self_session); #endif diff --git a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_event_batch.h b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_event_batch.h index c720b29a56c..608693dfc74 100644 --- a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_event_batch.h +++ b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_event_batch.h @@ -28,7 +28,6 @@ * OF THE POSSIBILITY OF SUCH DAMAGE. */ - #ifndef XEN_EVENT_BATCH_H #define XEN_EVENT_BATCH_H @@ -40,7 +39,8 @@ * */ -typedef struct xen_event_batch { +typedef struct xen_event_batch +{ xen_event_record_set *events; xen_string_int_map *valid_ref_counts; char *token; @@ -50,14 +50,14 @@ typedef struct xen_event_batch { * Free the given xen_event_batch, and all referenced values. The * given batch must have been allocated by this library. */ -extern void -xen_event_batch_free(xen_event_batch *batch); - +extern void xen_event_batch_free(xen_event_batch *batch); /** * Blocking call which returns a (possibly empty) batch of events. */ -extern bool -xen_event_from(xen_session *session, struct xen_event_batch **result, struct xen_string_set *classes, char *token, double timeout); +extern bool xen_event_from(xen_session *session, + struct xen_event_batch **result, + struct xen_string_set *classes, char *token, + double timeout); #endif diff --git a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_int_set.h b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_int_set.h index f84147822a4..7fdb6db5db0 100644 --- a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_int_set.h +++ b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_int_set.h @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,29 +31,23 @@ #ifndef XEN_INT_SET_H #define XEN_INT_SET_H - #include "xen_common.h" - typedef struct xen_int_set { size_t size; int contents[]; } xen_int_set; - /** * Allocate a xen_int_set of the given size. */ -extern xen_int_set * -xen_int_set_alloc(size_t size); +extern xen_int_set *xen_int_set_alloc(size_t size); /** * Free the given xen_int_set. The given set must have been allocated * by this library. */ -extern void -xen_int_set_free(xen_int_set *set); - +extern void xen_int_set_free(xen_int_set *set); #endif diff --git a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set.h b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set.h index 25795c108ec..c770b6fba8f 100644 --- a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set.h +++ b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set.h @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,29 +31,23 @@ #ifndef XEN_STRING_SET_H #define XEN_STRING_SET_H - #include "xen_common.h" - typedef struct xen_string_set { size_t size; char *contents[]; } xen_string_set; - /** * Allocate a xen_string_set of the given size. */ -extern xen_string_set * -xen_string_set_alloc(size_t size); +extern xen_string_set *xen_string_set_alloc(size_t size); /** * Free the given xen_string_set. The given set must have been allocated * by this library. */ -extern void -xen_string_set_free(xen_string_set *set); - +extern void xen_string_set_free(xen_string_set *set); #endif diff --git a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set_set.h b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set_set.h index 30aafd81640..9e4140718cd 100644 --- a/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set_set.h +++ b/ocaml/sdk-gen/c/autogen/include/xen/api/xen_string_set_set.h @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,30 +31,24 @@ #ifndef XEN_STRING_SET_SET_H #define XEN_STRING_SET_SET_H - #include "xen_common.h" #include - typedef struct xen_string_set_set { size_t size; xen_string_set *contents[]; } xen_string_set_set; - /** * Allocate a xen_string_set_set of the given size. */ -extern xen_string_set_set * -xen_string_set_set_alloc(size_t size); +extern xen_string_set_set *xen_string_set_set_alloc(size_t size); /** * Free the given xen_string_set_set. The given set of sets must have been * allocated by this library. */ -extern void -xen_string_set_set_free(xen_string_set_set *set); - +extern void xen_string_set_set_free(xen_string_set_set *set); #endif diff --git a/ocaml/sdk-gen/c/autogen/src/xen_common.c b/ocaml/sdk-gen/c/autogen/src/xen_common.c index 64811214095..7bd5f0cd80d 100644 --- a/ocaml/sdk-gen/c/autogen/src/xen_common.c +++ b/ocaml/sdk-gen/c/autogen/src/xen_common.c @@ -37,17 +37,16 @@ #include #include +#include #include #include #include #include #include #include -#include #include "xen/api/xen_common.h" #include "xen/api/xen_host.h" -#include "xen_internal.h" #include "xen/api/xen_int_float_map.h" #include "xen/api/xen_int_int_map.h" #include "xen/api/xen_int_string_set_map.h" @@ -55,6 +54,7 @@ #include "xen/api/xen_string_string_map.h" #include "xen/api/xen_string_string_set_map.h" #include "xen/api/xen_string_string_string_map_map.h" +#include "xen_internal.h" /* * Whether to ignore missing structure entries. This is not something we @@ -63,24 +63,20 @@ */ #define PERMISSIVE 1 - static xmlXPathCompExprPtr responsePath = NULL; static xmlXPathCompExprPtr faultPath = NULL; - typedef struct { size_t size; void *contents[]; } arbitrary_map; - typedef struct { void *handle; } arbitrary_record; - typedef struct { bool is_record; @@ -91,72 +87,51 @@ typedef struct } u; } arbitrary_record_opt; +static char *make_body(const char *, abstract_value[], int); -static char * -make_body(const char *, abstract_value [], int); - -static void -parse_result(xen_session *, const char *, const abstract_type *, void *); +static void parse_result(xen_session *, const char *, const abstract_type *, + void *); -static void -add_value(xmlNode *, const char *, const char *); -static void -add_param(xmlNode *, const char *, const char *); +static void add_value(xmlNode *, const char *, const char *); +static void add_param(xmlNode *, const char *, const char *); -static xmlNode * -add_param_struct(xmlNode *); -static xmlNode * -add_param_array(xmlNode *params_node); -static xmlNode * -add_struct_array(xmlNode *, const char *); -static xmlNode * -add_nested_struct(xmlNode *, const char *); -static void -add_struct_member(xmlNode *, const char *, const char *, const char *); -static void -add_unnamed_value(xmlNode *, const char *, const char *, const char *); +static xmlNode *add_param_struct(xmlNode *); +static xmlNode *add_param_array(xmlNode *params_node); +static xmlNode *add_struct_array(xmlNode *, const char *); +static xmlNode *add_nested_struct(xmlNode *, const char *); +static void add_struct_member(xmlNode *, const char *, const char *, + const char *); +static void add_unnamed_value(xmlNode *, const char *, const char *, + const char *); -static void -add_struct_value(const struct abstract_type *, void *, - void (*)(xmlNode *, const char *, const char *, - const char *), - const char *, xmlNode *); +static void add_struct_value(const struct abstract_type *, void *, + void (*)(xmlNode *, const char *, const char *, + const char *), + const char *, xmlNode *); -static xmlNode * -add_container(xmlNode *parent, const char *name); +static xmlNode *add_container(xmlNode *parent, const char *name); -static void -call_raw(xen_session *, const char *, abstract_value [], int, - const abstract_type *, void *); +static void call_raw(xen_session *, const char *, abstract_value[], int, + const abstract_type *, void *); -static void -parse_structmap_value(xen_session *, xmlNode *, const abstract_type *, - void *); +static void parse_structmap_value(xen_session *, xmlNode *, + const abstract_type *, void *); static size_t size_of_member(const abstract_type *); -static const char * -get_val_as_string(const struct abstract_type *, void *); +static const char *get_val_as_string(const struct abstract_type *, void *); -static void -set_api_version(xen_session *); +static void set_api_version(xen_session *); - -void -xen_init(void) +void xen_init(void) { - responsePath = - xmlXPathCompile( - BAD_CAST( - "/methodResponse/params/param/value/struct/member/value")); - faultPath = - xmlXPathCompile( - BAD_CAST("/methodResponse/fault/value/struct/member/value")); + responsePath = xmlXPathCompile( + BAD_CAST("/methodResponse/params/param/value/struct/member/value")); + faultPath = xmlXPathCompile( + BAD_CAST("/methodResponse/fault/value/struct/member/value")); } - -void -xen_fini(void) +void xen_fini(void) { xmlXPathFreeCompExpr(responsePath); xmlXPathFreeCompExpr(faultPath); @@ -164,11 +139,9 @@ xen_fini(void) faultPath = NULL; } - -void -xen_session_record_free(xen_session_record *record) +void xen_session_record_free(xen_session_record *record) { - if (record == NULL) + if ( record == NULL ) { return; } @@ -178,21 +151,16 @@ xen_session_record_free(xen_session_record *record) free(record); } - -xen_session * -xen_session_login_with_password(xen_call_func call_func, void *handle, - const char *uname, const char *pwd, - xen_api_version version) +xen_session *xen_session_login_with_password(xen_call_func call_func, + void *handle, const char *uname, + const char *pwd, + xen_api_version version) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = uname }, - { .type = &abstract_type_string, - .u.string_val = pwd }, + abstract_value params[] + = { { .type = &abstract_type_string, .u.string_val = uname }, + { .type = &abstract_type_string, .u.string_val = pwd }, { .type = &abstract_type_string, - .u.string_val = xen_api_version_to_string(version) } - }; + .u.string_val = xen_api_version_to_string(version) } }; xen_session *session = malloc(sizeof(xen_session)); session->call_func = call_func; @@ -206,15 +174,14 @@ xen_session_login_with_password(xen_call_func call_func, void *handle, call_raw(session, "session.login_with_password", params, 3, &abstract_type_string, &session->session_id); - if (!session->ok && - session->error_description_count == 4 && - session->error_description != NULL && - !strcmp(session->error_description[0], - "MESSAGE_PARAMETER_COUNT_MISMATCH")) + if ( !session->ok && session->error_description_count == 4 + && session->error_description != NULL + && !strcmp(session->error_description[0], + "MESSAGE_PARAMETER_COUNT_MISMATCH") ) { // We're calling an API 1.1 host. - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { free(session->error_description[i]); } @@ -228,7 +195,7 @@ xen_session_login_with_password(xen_call_func call_func, void *handle, &abstract_type_string, &session->session_id); } - if (session->ok) + if ( session->ok ) { set_api_version(session); } @@ -236,18 +203,13 @@ xen_session_login_with_password(xen_call_func call_func, void *handle, return session; } - -xen_session * -xen_session_slave_local_login_with_password(xen_call_func call_func, void *handle, - const char *uname, const char *pwd) +xen_session *xen_session_slave_local_login_with_password( + xen_call_func call_func, void *handle, const char *uname, const char *pwd) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = uname }, - { .type = &abstract_type_string, - .u.string_val = pwd }, - }; + abstract_value params[] = { + { .type = &abstract_type_string, .u.string_val = uname }, + { .type = &abstract_type_string, .u.string_val = pwd }, + }; xen_session *session = malloc(sizeof(xen_session)); session->call_func = call_func; @@ -260,24 +222,22 @@ xen_session_slave_local_login_with_password(xen_call_func call_func, void *handl call_raw(session, "session.slave_local_login_with_password", params, 2, &abstract_type_string, &session->session_id); - if (session->ok) + if ( session->ok ) { - //assume the latest api version + // assume the latest api version session->api_version = xen_api_latest_version; } return session; } - -void -set_api_version(xen_session *session) +void set_api_version(xen_session *session) { int64_t major_version = (int64_t)0; int64_t minor_version = (int64_t)1; xen_host host; - if (!xen_session_get_this_host(session, &host, session)) + if ( !xen_session_get_this_host(session, &host, session) ) { session->api_version = xen_api_unknown_version; return; @@ -285,22 +245,19 @@ set_api_version(xen_session *session) xen_host_get_api_version_major(session, &major_version, host); xen_host_get_api_version_minor(session, &minor_version, host); - session->api_version = xen_api_version_from_int(major_version, minor_version); + session->api_version + = xen_api_version_from_int(major_version, minor_version); xen_host_free(host); } - -void -xen_session_logout(xen_session *session) +void xen_session_logout(xen_session *session) { - abstract_value params[] = - { - }; + abstract_value params[] = {}; xen_call_(session, "session.logout", params, 0, NULL, NULL); - if (session->error_description != NULL) + if ( session->error_description != NULL ) { - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { free(session->error_description[i]); } @@ -311,18 +268,14 @@ xen_session_logout(xen_session *session) free(session); } - -void -xen_session_local_logout(xen_session *session) +void xen_session_local_logout(xen_session *session) { - abstract_value params[] = - { - }; + abstract_value params[] = {}; xen_call_(session, "session.local_logout", params, 0, NULL, NULL); - if (session->error_description != NULL) + if ( session->error_description != NULL ) { - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { free(session->error_description[i]); } @@ -333,59 +286,48 @@ xen_session_local_logout(xen_session *session) free(session); } - -bool - xen_session_get_all_subject_identifiers(xen_session *session, struct xen_string_set **result) +bool xen_session_get_all_subject_identifiers(xen_session *session, + struct xen_string_set **result) { - abstract_value params[] = - { - }; + abstract_value params[] = {}; abstract_type result_type = abstract_type_string_set; *result = NULL; - xen_call_(session, "session.get_all_subject_identifiers", params, 0, &result_type, result); + xen_call_(session, "session.get_all_subject_identifiers", params, 0, + &result_type, result); return session->ok; } - -bool -xen_session_get_all_subject_identifiers_async(xen_session *session, xen_task *result) +bool xen_session_get_all_subject_identifiers_async(xen_session *session, + xen_task *result) { - abstract_value params[] = - { - }; + abstract_value params[] = {}; abstract_type result_type = abstract_type_string; *result = NULL; - xen_call_(session, "Async.session.get_all_subject_identifiers", params, 0, &result_type, result); + xen_call_(session, "Async.session.get_all_subject_identifiers", params, 0, + &result_type, result); return session->ok; } - -bool -xen_session_logout_subject_identifier(xen_session *session, const char *subject_identifier) +bool xen_session_logout_subject_identifier(xen_session *session, + const char *subject_identifier) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = subject_identifier } - }; + abstract_value params[] = { { .type = &abstract_type_string, + .u.string_val = subject_identifier } }; - xen_call_(session, "session.logout_subject_identifier", params, 1, NULL, NULL); + xen_call_(session, "session.logout_subject_identifier", params, 1, NULL, + NULL); return session->ok; } - -bool -xen_session_logout_subject_identifier_async(xen_session *session, xen_task *result, const char *subject_identifier) +bool xen_session_logout_subject_identifier_async( + xen_session *session, xen_task *result, const char *subject_identifier) { - abstract_value param_values[] = - { - { .type = &abstract_type_string, - .u.string_val = subject_identifier } - }; + abstract_value param_values[] = { { .type = &abstract_type_string, + .u.string_val = subject_identifier } }; abstract_type result_type = abstract_type_string; @@ -394,13 +336,11 @@ xen_session_logout_subject_identifier_async(xen_session *session, xen_task *resu return session->ok; } - -void -xen_session_clear_error(xen_session *session) +void xen_session_clear_error(xen_session *session) { - if (session->error_description != NULL) + if ( session->error_description != NULL ) { - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { free(session->error_description[i]); } @@ -411,106 +351,78 @@ xen_session_clear_error(xen_session *session) session->ok = true; } - -bool -xen_session_get_uuid(xen_session *session, char **result, - xen_session *self_session) +bool xen_session_get_uuid(xen_session *session, char **result, + xen_session *self_session) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = self_session->session_id } - }; + abstract_value params[] = { { .type = &abstract_type_string, + .u.string_val = self_session->session_id } }; - xen_call_(session, "session.get_uuid", params, 1, - &abstract_type_string, result); + xen_call_(session, "session.get_uuid", params, 1, &abstract_type_string, + result); return session->ok; } - -bool -xen_session_get_this_host(xen_session *session, xen_host *result, - xen_session *self_session) +bool xen_session_get_this_host(xen_session *session, xen_host *result, + xen_session *self_session) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = self_session->session_id } - }; + abstract_value params[] = { { .type = &abstract_type_string, + .u.string_val = self_session->session_id } }; xen_call_(session, "session.get_this_host", params, 1, &abstract_type_string, result); return session->ok; } - -bool -xen_session_get_this_user(xen_session *session, char **result, - xen_session *self_session) +bool xen_session_get_this_user(xen_session *session, char **result, + xen_session *self_session) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = self_session->session_id } - }; + abstract_value params[] = { { .type = &abstract_type_string, + .u.string_val = self_session->session_id } }; xen_call_(session, "session.get_this_user", params, 1, &abstract_type_string, result); return session->ok; } - -bool -xen_session_get_last_active(xen_session *session, time_t *result, - xen_session *self_session) +bool xen_session_get_last_active(xen_session *session, time_t *result, + xen_session *self_session) { - abstract_value params[] = - { - { .type = &abstract_type_string, - .u.string_val = self_session->session_id } - }; + abstract_value params[] = { { .type = &abstract_type_string, + .u.string_val = self_session->session_id } }; xen_call_(session, "session.get_last_active", params, 1, &abstract_type_datetime, result); return session->ok; } +static const struct_member xen_session_record_struct_members[] = { + { .key = "uuid", + .type = &abstract_type_string, + .offset = offsetof(xen_session_record, uuid) }, + { .key = "this_host", + .type = &abstract_type_ref, + .offset = offsetof(xen_session_record, this_host) }, + { .key = "this_user", + .type = &abstract_type_string, + .offset = offsetof(xen_session_record, this_user) }, + { .key = "last_active", + .type = &abstract_type_datetime, + .offset = offsetof(xen_session_record, last_active) }, +}; -static const struct_member xen_session_record_struct_members[] = - { - { .key = "uuid", - .type = &abstract_type_string, - .offset = offsetof(xen_session_record, uuid) }, - { .key = "this_host", - .type = &abstract_type_ref, - .offset = offsetof(xen_session_record, this_host) }, - { .key = "this_user", - .type = &abstract_type_string, - .offset = offsetof(xen_session_record, this_user) }, - { .key = "last_active", - .type = &abstract_type_datetime, - .offset = offsetof(xen_session_record, last_active) }, - }; - -const abstract_type xen_session_record_abstract_type_ = - { - .XEN_API_TYPE = STRUCT, - .struct_size = sizeof(xen_session_record), - .member_count = - sizeof(xen_session_record_struct_members) / sizeof(struct_member), - .members = xen_session_record_struct_members - }; - +const abstract_type xen_session_record_abstract_type_ + = { .XEN_API_TYPE = STRUCT, + .struct_size = sizeof(xen_session_record), + .member_count + = sizeof(xen_session_record_struct_members) / sizeof(struct_member), + .members = xen_session_record_struct_members }; -bool -xen_session_get_record(xen_session *session, xen_session_record **result, - xen_session *self_session) +bool xen_session_get_record(xen_session *session, xen_session_record **result, + xen_session *self_session) { - abstract_value param_values[] = - { - { .type = &abstract_type_string, - .u.string_val = self_session->session_id } - }; + abstract_value param_values[] + = { { .type = &abstract_type_string, + .u.string_val = self_session->session_id } }; abstract_type result_type = xen_session_record_abstract_type_; @@ -520,128 +432,101 @@ xen_session_get_record(xen_session *session, xen_session_record **result, return session->ok; } - #define X "%02x" #define UUID_FORMAT X X X X "-" X X "-" X X "-" X X "-" X X X X X X - -bool -xen_uuid_string_to_bytes(char *uuid, char **bytes) +bool xen_uuid_string_to_bytes(char *uuid, char **bytes) { unsigned int buf[16]; *bytes = NULL; - if (strlen(uuid) != 36) + if ( strlen(uuid) != 36 ) return false; - if (16 != sscanf(uuid, UUID_FORMAT, - buf + 0, buf + 1, buf + 2, buf + 3, - buf + 4, buf + 5, - buf + 6, buf + 7, - buf + 8, buf + 9, - buf + 10, buf + 11, buf + 12, buf + 13, buf + 14, - buf + 15)) + if ( 16 + != sscanf(uuid, UUID_FORMAT, buf + 0, buf + 1, buf + 2, buf + 3, + buf + 4, buf + 5, buf + 6, buf + 7, buf + 8, buf + 9, + buf + 10, buf + 11, buf + 12, buf + 13, buf + 14, + buf + 15) ) { return false; } *bytes = malloc(16); - if (*bytes == NULL) + if ( *bytes == NULL ) return false; - for (int i = 0; i < 16; i++) { + for ( int i = 0; i < 16; i++ ) + { (*bytes)[i] = (char)buf[i]; } return true; } - -bool -xen_uuid_bytes_to_string(char *bytes, char **uuid) +bool xen_uuid_bytes_to_string(char *bytes, char **uuid) { *uuid = malloc(37); - if (*uuid == NULL) + if ( *uuid == NULL ) return false; - sprintf(*uuid, UUID_FORMAT, - bytes[0], bytes[1], bytes[2], bytes[3], - bytes[4], bytes[5], - bytes[6], bytes[7], - bytes[8], bytes[9], + sprintf(*uuid, UUID_FORMAT, bytes[0], bytes[1], bytes[2], bytes[3], + bytes[4], bytes[5], bytes[6], bytes[7], bytes[8], bytes[9], bytes[10], bytes[11], bytes[12], bytes[13], bytes[14], bytes[15]); return true; } - #undef UUID_FORMAT #undef X +void xen_uuid_free(char *uuid) { free(uuid); } -void -xen_uuid_free(char *uuid) -{ - free(uuid); -} - - -void -xen_uuid_bytes_free(char *bytes) -{ - free(bytes); -} - +void xen_uuid_bytes_free(char *bytes) { free(bytes); } /** * @param value A pointer to the correct location as per the given * result_type. Will be populated if the call succeeds. In that case, and if * value is a char **, the char * itself must be freed by the caller. */ -void -xen_call_(xen_session *s, const char *method_name, - abstract_value params[], int param_count, - const abstract_type *result_type, void *value) +void xen_call_(xen_session *s, const char *method_name, + abstract_value params[], int param_count, + const abstract_type *result_type, void *value) { - if (!s->ok) + if ( !s->ok ) { return; } - abstract_value *full_params = - malloc(sizeof(abstract_value) * (param_count + 1)); + abstract_value *full_params + = malloc(sizeof(abstract_value) * (param_count + 1)); full_params[0].type = &abstract_type_string; full_params[0].u.string_val = s->session_id; memcpy(full_params + 1, params, param_count * sizeof(abstract_value)); - call_raw(s, method_name, full_params, param_count + 1, result_type, - value); + call_raw(s, method_name, full_params, param_count + 1, result_type, value); free(full_params); } - -static bool -bufferAdd(const void *data, size_t len, void *buffer) +static bool bufferAdd(const void *data, size_t len, void *buffer) { return 0 == xmlBufferAdd((xmlBufferPtr)buffer, data, len); } - -static void -call_raw(xen_session *s, const char *method_name, - abstract_value params[], int param_count, - const abstract_type *result_type, void *value) +static void call_raw(xen_session *s, const char *method_name, + abstract_value params[], int param_count, + const abstract_type *result_type, void *value) { xmlBufferPtr buffer = xmlBufferCreate(); char *body = make_body(method_name, params, param_count); - int error_code = - s->call_func(body, strlen(body), s->handle, buffer, &bufferAdd); + int error_code + = s->call_func(body, strlen(body), s->handle, buffer, &bufferAdd); free(body); - if (error_code) + if ( error_code ) { char **strings = malloc(2 * sizeof(char *)); @@ -660,10 +545,9 @@ call_raw(xen_session *s, const char *method_name, xmlBufferFree(buffer); } - static void server_error(xen_session *session, const char *error_string) { - if (!session->ok) + if ( !session->ok ) { /* Don't wipe out the earlier error message with this one. */ return; @@ -679,25 +563,17 @@ static void server_error(xen_session *session, const char *error_string) session->error_description_count = 2; } - static bool is_node(xmlNode *n, char *type) { - return - n->type == XML_ELEMENT_NODE && - 0 == strcmp((char *)n->name, type); + return n->type == XML_ELEMENT_NODE && 0 == strcmp((char *)n->name, type); } - static bool is_container_node(xmlNode *n, char *type) { - return - is_node(n, type) && - n->children != NULL && - n->children == n->last && - n->children->type == XML_ELEMENT_NODE; + return is_node(n, type) && n->children != NULL && n->children == n->last + && n->children->type == XML_ELEMENT_NODE; } - /** * @return The contents of the given value, or NULL if this is not a node with * the given type. If not NULL, the result must be freed with xmlFree(). @@ -709,20 +585,17 @@ static xmlChar *string_from_value(xmlNode *n, char *type) allows XYZ where XYZ is to be interpreted as a string. */ - if (is_container_node(n, "value") && - 0 == strcmp((char *)n->children->name, type)) + if ( is_container_node(n, "value") + && 0 == strcmp((char *)n->children->name, type) ) { - return - n->children->children == NULL ? - xmlStrdup(BAD_CAST("")) : - xmlNodeGetContent(n->children->children); + return n->children->children == NULL + ? xmlStrdup(BAD_CAST("")) + : xmlNodeGetContent(n->children->children); } - else if (0 == strcmp(type, "string") && is_node(n, "value")) + else if ( 0 == strcmp(type, "string") && is_node(n, "value") ) { - return - n->children == NULL ? - xmlStrdup(BAD_CAST("")) : - xmlNodeGetContent(n->children); + return n->children == NULL ? xmlStrdup(BAD_CAST("")) + : xmlNodeGetContent(n->children); } else { @@ -730,7 +603,6 @@ static xmlChar *string_from_value(xmlNode *n, char *type) } } - /** * Find the name node that is a child of the given one, and return its * contents, or NULL if this has no such node. If not NULL, the result must @@ -740,9 +612,9 @@ static xmlChar *string_from_name(xmlNode *n) { xmlNode *cur = n->children; - while (cur != NULL) + while ( cur != NULL ) { - if (0 == strcmp((char *)cur->name, "name")) + if ( 0 == strcmp((char *)cur->name, "name") ) { return xmlNodeGetContent(cur); } @@ -752,15 +624,14 @@ static xmlChar *string_from_name(xmlNode *n) return NULL; } - static int count_children(xmlNode *n, const char *name) { int result = 0; xmlNode *cur = n->children; - while (cur != NULL) + while ( cur != NULL ) { - if (0 == strcmp((char *)cur->name, name)) + if ( 0 == strcmp((char *)cur->name, name) ) { result++; } @@ -770,42 +641,40 @@ static int count_children(xmlNode *n, const char *name) return result; } - static void destring(xen_session *s, xmlChar *name, const abstract_type *type, void *value) { - switch (type->XEN_API_TYPE) + switch ( type->XEN_API_TYPE ) { - case STRING: - { - *((char **)value) = xen_strdup_((const char *)name); - break; - } - case INT: - { - *((int64_t *)value) = atoll((const char *)name); - break; - } - case FLOAT: - { - *((double *)value) = atof((const char *)name); - break; - } - case ENUM: - { - *((int *)value) = type->enum_demarshaller(s, (const char *)name); - break; - } - default: - { - char buf[256]; - snprintf(buf, sizeof (buf), "Invalid Map key type: %s", name); - server_error(s, buf); - } + case STRING: + { + *((char **)value) = xen_strdup_((const char *)name); + break; + } + case INT: + { + *((int64_t *)value) = atoll((const char *)name); + break; + } + case FLOAT: + { + *((double *)value) = atof((const char *)name); + break; + } + case ENUM: + { + *((int *)value) = type->enum_demarshaller(s, (const char *)name); + break; + } + default: + { + char buf[256]; + snprintf(buf, sizeof(buf), "Invalid Map key type: %s", name); + server_error(s, buf); + } } } - /** * result_type : STRING => value : char **, the char * is yours. * result_type : ENUM => value : int * @@ -821,13 +690,12 @@ static void destring(xen_session *s, xmlChar *name, const abstract_type *type, * result_type : STRUCT => value : void **, the void * is yours. */ static void parse_into(xen_session *s, xmlNode *value_node, - const abstract_type *result_type, void *value, - int slot) + const abstract_type *result_type, void *value, int slot) { - if (result_type == NULL) + if ( result_type == NULL ) { xmlChar *string = string_from_value(value_node, "string"); - if (string == NULL || strcmp((char *)string, "")) + if ( string == NULL || strcmp((char *)string, "") ) { server_error(s, "Expected Void from the server, but didn't get it"); @@ -840,12 +708,12 @@ static void parse_into(xen_session *s, xmlNode *value_node, return; } - switch (result_type->XEN_API_TYPE) + switch ( result_type->XEN_API_TYPE ) { case STRING: { xmlChar *string = string_from_value(value_node, "string"); - if (string == NULL) + if ( string == NULL ) { server_error( s, "Expected a String from the server, but didn't get one"); @@ -861,7 +729,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, case ENUM: { xmlChar *string = string_from_value(value_node, "string"); - if (string == NULL) + if ( string == NULL ) { #if PERMISSIVE fprintf(stderr, @@ -874,8 +742,8 @@ static void parse_into(xen_session *s, xmlNode *value_node, } else { - ((int *)value)[slot] = - result_type->enum_demarshaller(s, (const char *)string); + ((int *)value)[slot] + = result_type->enum_demarshaller(s, (const char *)string); free(string); } } @@ -884,7 +752,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, case INT: { xmlChar *string = string_from_value(value_node, "string"); - if (string == NULL) + if ( string == NULL ) { server_error( s, "Expected an Int from the server, but didn't get one"); @@ -900,7 +768,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, case FLOAT: { xmlChar *string = string_from_value(value_node, "double"); - if (string == NULL) + if ( string == NULL ) { #if PERMISSIVE fprintf(stderr, @@ -922,7 +790,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, case BOOL: { xmlChar *string = string_from_value(value_node, "boolean"); - if (string == NULL) + if ( string == NULL ) { #if PERMISSIVE fprintf(stderr, @@ -944,11 +812,11 @@ static void parse_into(xen_session *s, xmlNode *value_node, case DATETIME: { xmlChar *string = string_from_value(value_node, "dateTime.iso8601"); - if (string == NULL) + if ( string == NULL ) { // Workaround for xapi's broken event.timestamp field. string = string_from_value(value_node, "string"); - if (string == NULL) + if ( string == NULL ) { server_error( s, @@ -973,11 +841,10 @@ static void parse_into(xen_session *s, xmlNode *value_node, case SET: { - if (!is_container_node(value_node, "value") || - !is_container_node(value_node->children, "array")) + if ( !is_container_node(value_node, "value") + || !is_container_node(value_node->children, "array") ) { - server_error(s, - "Expected Set from the server, but didn't get it"); + server_error(s, "Expected Set from the server, but didn't get it"); } else { @@ -987,15 +854,15 @@ static void parse_into(xen_session *s, xmlNode *value_node, const abstract_type *member_type = result_type->child; size_t member_size = size_of_member(member_type); - arbitrary_set *set = - calloc(1, sizeof(arbitrary_set) + member_size * n); + arbitrary_set *set + = calloc(1, sizeof(arbitrary_set) + member_size * n); set->size = n; int i = 0; xmlNode *cur = data_node->children; - while (cur != NULL) + while ( cur != NULL ) { - if (0 == strcmp((char *)cur->name, "value")) + if ( 0 == strcmp((char *)cur->name, "value") ) { parse_into(s, cur, member_type, set->contents, i); i++; @@ -1010,12 +877,11 @@ static void parse_into(xen_session *s, xmlNode *value_node, case MAP: { - if (!is_container_node(value_node, "value") || - value_node->children->type != XML_ELEMENT_NODE || - 0 != strcmp((char *)value_node->children->name, "struct")) + if ( !is_container_node(value_node, "value") + || value_node->children->type != XML_ELEMENT_NODE + || 0 != strcmp((char *)value_node->children->name, "struct") ) { - server_error(s, - "Expected Map from the server, but didn't get it"); + server_error(s, "Expected Map from the server, but didn't get it"); } else { @@ -1027,17 +893,17 @@ static void parse_into(xen_session *s, xmlNode *value_node, const struct struct_member *key_member = result_type->members; const struct struct_member *val_member = result_type->members + 1; - arbitrary_map *map = - calloc(1, sizeof(arbitrary_map) + struct_size * n); + arbitrary_map *map + = calloc(1, sizeof(arbitrary_map) + struct_size * n); map->size = n; int i = 0; xmlNode *cur = struct_node->children; - while (cur != NULL) + while ( cur != NULL ) { - if (0 == strcmp((char *)cur->name, "member")) + if ( 0 == strcmp((char *)cur->name, "member") ) { - if (cur->children == NULL || cur->last == cur->children) + if ( cur->children == NULL || cur->last == cur->children ) { server_error(s, "Malformed Map"); free(map); @@ -1045,7 +911,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, } xmlChar *name = string_from_name(cur); - if (name == NULL) + if ( name == NULL ) { server_error(s, "Malformed Map"); free(map); @@ -1053,21 +919,20 @@ static void parse_into(xen_session *s, xmlNode *value_node, } destring(s, name, key_member->type, - ((void *)(map + 1)) + - (i * struct_size) + - key_member->offset); + ((void *)(map + 1)) + (i * struct_size) + + key_member->offset); xmlFree(name); - if (!s->ok) + if ( !s->ok ) { free(map); return; } parse_structmap_value(s, cur, val_member->type, - ((void *)(map + 1)) + - (i * struct_size) + - val_member->offset); - if (!s->ok) + ((void *)(map + 1)) + + (i * struct_size) + + val_member->offset); + if ( !s->ok ) { free(map); return; @@ -1084,13 +949,12 @@ static void parse_into(xen_session *s, xmlNode *value_node, case STRUCT: { - if (!is_container_node(value_node, "value") || - value_node->children->type != XML_ELEMENT_NODE || - 0 != strcmp((char *)value_node->children->name, "struct") || - value_node->children->children == NULL) + if ( !is_container_node(value_node, "value") + || value_node->children->type != XML_ELEMENT_NODE + || 0 != strcmp((char *)value_node->children->name, "struct") + || value_node->children->children == NULL ) { - server_error(s, - "Expected Map from the server, but didn't get it"); + server_error(s, "Expected Map from the server, but didn't get it"); } else { @@ -1101,15 +965,15 @@ static void parse_into(xen_session *s, xmlNode *value_node, size_t member_count = result_type->member_count; - const struct_member **checklist = - malloc(sizeof(const struct_member *) * member_count); + const struct_member **checklist + = malloc(sizeof(const struct_member *) * member_count); int seen_count = 0; - while (cur != NULL) + while ( cur != NULL ) { - if (0 == strcmp((char *)cur->name, "member")) + if ( 0 == strcmp((char *)cur->name, "member") ) { - if (cur->children == NULL || cur->last == cur->children) + if ( cur->children == NULL || cur->last == cur->children ) { server_error(s, "Malformed Struct"); free(result); @@ -1118,7 +982,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, } xmlChar *name = string_from_name(cur); - if (name == NULL) + if ( name == NULL ) { server_error(s, "Malformed Struct"); free(result); @@ -1126,11 +990,11 @@ static void parse_into(xen_session *s, xmlNode *value_node, return; } - for (size_t i = 0; i < member_count; i++) + for ( size_t i = 0; i < member_count; i++ ) { const struct_member *mem = result_type->members + i; - if (0 == strcmp((char *)name, mem->key)) + if ( 0 == strcmp((char *)name, mem->key) ) { parse_structmap_value(s, cur, mem->type, result + mem->offset); @@ -1146,7 +1010,7 @@ static void parse_into(xen_session *s, xmlNode *value_node, xmlFree(name); - if (!s->ok) + if ( !s->ok ) { free(result); free(checklist); @@ -1157,28 +1021,27 @@ static void parse_into(xen_session *s, xmlNode *value_node, } /* Check that we've filled all fields. */ - for (size_t i = 0; i < member_count; i++) + for ( size_t i = 0; i < member_count; i++ ) { const struct_member *mem = result_type->members + i; int j; - for (j = 0; j < seen_count; j++) + for ( j = 0; j < seen_count; j++ ) { - if (checklist[j] == mem) + if ( checklist[j] == mem ) { break; } } - if (j == seen_count) + if ( j == seen_count ) { #if PERMISSIVE fprintf(stderr, "Struct did not contain expected field %s.\n", mem->key); #else - server_error_2(s, - "Struct did not contain expected field", + server_error_2(s, "Struct did not contain expected field", mem->key); free(result); free(checklist); @@ -1195,8 +1058,8 @@ static void parse_into(xen_session *s, xmlNode *value_node, case REF: { - arbitrary_record_opt *record_opt = - calloc(1, sizeof(arbitrary_record_opt)); + arbitrary_record_opt *record_opt + = calloc(1, sizeof(arbitrary_record_opt)); record_opt->is_record = false; parse_into(s, value_node, &abstract_type_string, @@ -1211,36 +1074,34 @@ static void parse_into(xen_session *s, xmlNode *value_node, } } - static size_t size_of_member(const abstract_type *type) { - switch (type->XEN_API_TYPE) - { - case STRING: - return sizeof(char *); - case INT: - return sizeof(int64_t); - case ENUM: - return sizeof(int); - case REF: - return sizeof(arbitrary_record_opt *); - case STRUCT: - case SET: - return type->struct_size; - default: - assert(false); + switch ( type->XEN_API_TYPE ) + { + case STRING: + return sizeof(char *); + case INT: + return sizeof(int64_t); + case ENUM: + return sizeof(int); + case REF: + return sizeof(arbitrary_record_opt *); + case STRUCT: + case SET: + return type->struct_size; + default: + assert(false); } } - static void parse_structmap_value(xen_session *s, xmlNode *n, const abstract_type *type, void *value) { xmlNode *cur = n->children; - while (cur != NULL) + while ( cur != NULL ) { - if (0 == strcmp((char *)cur->name, "value")) + if ( 0 == strcmp((char *)cur->name, "value") ) { parse_into(s, cur, type, value, 0); return; @@ -1251,18 +1112,16 @@ static void parse_structmap_value(xen_session *s, xmlNode *n, server_error(s, "Missing value in Map/Struct"); } - static void parse_fault(xen_session *session, xmlXPathContextPtr xpathCtx) { xmlXPathObjectPtr xpathObj = xmlXPathCompiledEval(faultPath, xpathCtx); - if (xpathObj == NULL) + if ( xpathObj == NULL ) { server_error(session, "Method response is neither result nor fault"); return; } - if (xpathObj->type != XPATH_NODESET || - xpathObj->nodesetval->nodeNr != 2) + if ( xpathObj->type != XPATH_NODESET || xpathObj->nodesetval->nodeNr != 2 ) { xmlXPathFreeObject(xpathObj); server_error(session, "Method response is neither result nor fault"); @@ -1273,11 +1132,11 @@ static void parse_fault(xen_session *session, xmlXPathContextPtr xpathCtx) xmlNode *fault_node1 = xpathObj->nodesetval->nodeTab[1]; xmlChar *fault_code_str = string_from_value(fault_node0, "int"); - if (fault_code_str == NULL) + if ( fault_code_str == NULL ) { fault_code_str = string_from_value(fault_node0, "i4"); } - if (fault_code_str == NULL) + if ( fault_code_str == NULL ) { xmlXPathFreeObject(xpathObj); server_error(session, "Fault code is malformed"); @@ -1285,7 +1144,7 @@ static void parse_fault(xen_session *session, xmlXPathContextPtr xpathCtx) } xmlChar *fault_string_str = string_from_value(fault_node1, "string"); - if (fault_string_str == NULL) + if ( fault_string_str == NULL ) { xmlFree(fault_code_str); xmlXPathFreeObject(xpathObj); @@ -1308,18 +1167,15 @@ static void parse_fault(xen_session *session, xmlXPathContextPtr xpathCtx) xmlXPathFreeObject(xpathObj); } - static void parse_failure(xen_session *session, xmlNode *node) { - abstract_type error_description_type = - { .XEN_API_TYPE = SET, - .child = &abstract_type_string }; + abstract_type error_description_type + = { .XEN_API_TYPE = SET, .child = &abstract_type_string }; arbitrary_set *error_descriptions; - parse_into(session, node, &error_description_type, &error_descriptions, - 0); + parse_into(session, node, &error_description_type, &error_descriptions, 0); - if (session->ok) + if ( session->ok ) { session->ok = false; @@ -1327,7 +1183,7 @@ static void parse_failure(xen_session *session, xmlNode *node) int n = error_descriptions->size; char **strings = malloc(n * sizeof(char *)); - for (int i = 0; i < n; i++) + for ( int i = 0; i < n; i++ ) { strings[i] = c[i]; } @@ -1339,33 +1195,31 @@ static void parse_failure(xen_session *session, xmlNode *node) free(error_descriptions); } - /** * Parameters as for xen_call_() above. */ static void parse_result(xen_session *session, const char *result, const abstract_type *result_type, void *value) { - xmlDocPtr doc = - xmlReadMemory(result, strlen(result), "", NULL, XML_PARSE_NONET); + xmlDocPtr doc + = xmlReadMemory(result, strlen(result), "", NULL, XML_PARSE_NONET); - if (doc == NULL) + if ( doc == NULL ) { server_error(session, "Couldn't parse the server response"); return; } xmlXPathContextPtr xpathCtx = xmlXPathNewContext(doc); - if (xpathCtx == NULL) + if ( xpathCtx == NULL ) { xmlFreeDoc(doc); server_error(session, "Couldn't create XPath context"); return; } - xmlXPathObjectPtr xpathObj = - xmlXPathCompiledEval(responsePath, xpathCtx); - if (xpathObj == NULL) + xmlXPathObjectPtr xpathObj = xmlXPathCompiledEval(responsePath, xpathCtx); + if ( xpathObj == NULL ) { parse_fault(session, xpathCtx); @@ -1374,8 +1228,7 @@ static void parse_result(xen_session *session, const char *result, return; } - if (xpathObj->type != XPATH_NODESET || - xpathObj->nodesetval->nodeNr != 2) + if ( xpathObj->type != XPATH_NODESET || xpathObj->nodesetval->nodeNr != 2 ) { parse_fault(session, xpathCtx); @@ -1389,7 +1242,7 @@ static void parse_result(xen_session *session, const char *result, xmlNode *node1 = xpathObj->nodesetval->nodeTab[1]; xmlChar *status_code = string_from_value(node0, "string"); - if (status_code == NULL) + if ( status_code == NULL ) { xmlXPathFreeObject(xpathObj); xmlXPathFreeContext(xpathCtx); @@ -1398,7 +1251,7 @@ static void parse_result(xen_session *session, const char *result, return; } - if (strcmp((char *)status_code, "Success")) + if ( strcmp((char *)status_code, "Success") ) { parse_failure(session, node1); @@ -1417,23 +1270,22 @@ static void parse_result(xen_session *session, const char *result, xmlFreeDoc(doc); } - -static void -make_body_add_type(enum abstract_typename XEN_API_TYPE, abstract_value *v, - xmlNode *params_node) +static void make_body_add_type(enum abstract_typename XEN_API_TYPE, + abstract_value *v, xmlNode *params_node) { char buf[20]; char *encoded = NULL; - switch (XEN_API_TYPE) + switch ( XEN_API_TYPE ) { case STRING: - encoded = (char *)xmlEncodeEntitiesReentrant(NULL, (xmlChar*)v->u.string_val); - add_param(params_node, "string", encoded); - free(encoded); - break; + encoded = (char *)xmlEncodeEntitiesReentrant( + NULL, (xmlChar *)v->u.string_val); + add_param(params_node, "string", encoded); + free(encoded); + break; case INT: - snprintf(buf, sizeof(buf), "%"PRId64, v->u.int_val); + snprintf(buf, sizeof(buf), "%" PRId64, v->u.int_val); add_param(params_node, "string", buf); break; @@ -1463,12 +1315,11 @@ make_body_add_type(enum abstract_typename XEN_API_TYPE, abstract_value *v, xmlNode *data_node = add_param_array(params_node); - for (size_t i = 0; i < set_val->size; i++) + for ( size_t i = 0; i < set_val->size; i++ ) { - void *member_value = (char *)set_val->contents + - (i * member_size); - add_struct_value(member_type, member_value, - add_unnamed_value, NULL, data_node); + void *member_value = (char *)set_val->contents + (i * member_size); + add_struct_value(member_type, member_value, add_unnamed_value, + NULL, data_node); } } break; @@ -1479,7 +1330,7 @@ make_body_add_type(enum abstract_typename XEN_API_TYPE, abstract_value *v, xmlNode *struct_node = add_param_struct(params_node); - for (size_t i = 0; i < member_count; i++) + for ( size_t i = 0; i < member_count; i++ ) { const struct struct_member *mem = v->type->members + i; const char *key = mem->key; @@ -1496,26 +1347,29 @@ make_body_add_type(enum abstract_typename XEN_API_TYPE, abstract_value *v, const struct struct_member *member = v->type->members; arbitrary_map *map_val = v->u.struct_val; xmlNode *param_node = add_param_struct(params_node); - for (size_t i = 0; i < map_val->size; i++) { + for ( size_t i = 0; i < map_val->size; i++ ) + { enum abstract_typename typename_key = member[0].type->XEN_API_TYPE; enum abstract_typename typename_val = member[1].type->XEN_API_TYPE; int offset_key = member[0].offset; int offset_val = member[1].offset; int struct_size = v->type->struct_size; - switch (typename_key) { - case STRING: { - char **addr = (void *)(map_val + 1) + - (i * struct_size) + - offset_key; + switch ( typename_key ) + { + case STRING: + { + char **addr + = (void *)(map_val + 1) + (i * struct_size) + offset_key; char *key = *addr; - switch (typename_val) { - case STRING: { + switch ( typename_val ) + { + case STRING: + { char *val; - addr = (void *)(map_val + 1) + - (i * struct_size) + - offset_val; + addr = (void *)(map_val + 1) + (i * struct_size) + + offset_val; val = *addr; add_struct_member(param_node, key, "string", val); break; @@ -1532,37 +1386,34 @@ make_body_add_type(enum abstract_typename XEN_API_TYPE, abstract_value *v, } break; - default: assert(false); } } - -static char * -make_body(const char *method_name, abstract_value params[], int param_count) +static char *make_body(const char *method_name, abstract_value params[], + int param_count) { xmlDocPtr doc = xmlNewDoc(BAD_CAST "1.0"); xmlNode *methodCall = xmlNewNode(NULL, BAD_CAST "methodCall"); xmlDocSetRootElement(doc, methodCall); - xmlNewChild(methodCall, NULL, BAD_CAST "methodName", - BAD_CAST method_name); + xmlNewChild(methodCall, NULL, BAD_CAST "methodName", BAD_CAST method_name); - xmlNode *params_node = - xmlNewChild(methodCall, NULL, BAD_CAST "params", NULL); + xmlNode *params_node + = xmlNewChild(methodCall, NULL, BAD_CAST "params", NULL); - for (int p = 0; p < param_count; p++) + for ( int p = 0; p < param_count; p++ ) { abstract_value *v = params + p; make_body_add_type(v->type->XEN_API_TYPE, v, params_node); } xmlBufferPtr buffer = xmlBufferCreate(); - xmlSaveCtxtPtr save_ctxt = - xmlSaveToBuffer(buffer, NULL, XML_SAVE_NO_XHTML); + xmlSaveCtxtPtr save_ctxt + = xmlSaveToBuffer(buffer, NULL, XML_SAVE_NO_XHTML); - if (xmlSaveDoc(save_ctxt, doc) == -1) + if ( xmlSaveDoc(save_ctxt, doc) == -1 ) { return NULL; } @@ -1574,235 +1425,223 @@ make_body(const char *method_name, abstract_value params[], int param_count) return (char *)content; } - -static void -add_struct_value(const struct abstract_type *type, void *value, - void (*adder)(xmlNode *node, const char *key, - const char *type, const char *val), - const char *key, xmlNode *node) +static void add_struct_value(const struct abstract_type *type, void *value, + void (*adder)(xmlNode *node, const char *key, + const char *type, const char *val), + const char *key, xmlNode *node) { - switch (type->XEN_API_TYPE) + switch ( type->XEN_API_TYPE ) { - case REF: - case STRING: - case INT: - case ENUM: - { - const char *val_as_string = get_val_as_string(type, value); - adder(node, key, "string", val_as_string); - free((char*)val_as_string); - } - break; + case REF: + case STRING: + case INT: + case ENUM: + { + const char *val_as_string = get_val_as_string(type, value); + adder(node, key, "string", val_as_string); + free((char *)val_as_string); + } + break; - case FLOAT: - { - char buf[20]; - double val = *(double *)value; - snprintf(buf, sizeof(buf), "%lf", val); - adder(node, key, "double", buf); - } - break; + case FLOAT: + { + char buf[20]; + double val = *(double *)value; + snprintf(buf, sizeof(buf), "%lf", val); + adder(node, key, "double", buf); + } + break; - case BOOL: - { - bool val = *(bool *)value; - adder(node, key, "boolean", val ? "1" : "0"); - } - break; + case BOOL: + { + bool val = *(bool *)value; + adder(node, key, "boolean", val ? "1" : "0"); + } + break; + + case SET: + { + const struct abstract_type *member_type = type->child; + size_t member_size = size_of_member(member_type); + arbitrary_set *set_val = *(arbitrary_set **)value; - case SET: + if ( set_val != NULL ) { - const struct abstract_type *member_type = type->child; - size_t member_size = size_of_member(member_type); - arbitrary_set *set_val = *(arbitrary_set **)value; + xmlNode *data_node = add_struct_array(node, key); - if (set_val != NULL) + for ( size_t i = 0; i < set_val->size; i++ ) { - xmlNode *data_node = add_struct_array(node, key); - - for (size_t i = 0; i < set_val->size; i++) - { - void *member_value = (char *)set_val->contents + - (i * member_size); - add_struct_value(member_type, member_value, - add_unnamed_value, NULL, data_node); - } + void *member_value + = (char *)set_val->contents + (i * member_size); + add_struct_value(member_type, member_value, add_unnamed_value, + NULL, data_node); } } - break; + } + break; - case STRUCT: - { - assert(false); + case STRUCT: + { + assert(false); /* XXX Nested structures aren't supported yet, but fortunately we don't need them, because we don't have any "deep create" calls. This will need to be fixed. */ - } - break; + } + break; - case MAP: - { - size_t member_size = type->struct_size; - const struct abstract_type *l_type = type->members[0].type; - const struct abstract_type *r_type = type->members[1].type; - int l_offset = type->members[0].offset; - int r_offset = type->members[1].offset; + case MAP: + { + size_t member_size = type->struct_size; + const struct abstract_type *l_type = type->members[0].type; + const struct abstract_type *r_type = type->members[1].type; + int l_offset = type->members[0].offset; + int r_offset = type->members[1].offset; - arbitrary_map *map_val = *(arbitrary_map **)value; + arbitrary_map *map_val = *(arbitrary_map **)value; - if (map_val != NULL) - { - xmlNode *struct_node = add_nested_struct(node, key); + if ( map_val != NULL ) + { + xmlNode *struct_node = add_nested_struct(node, key); - for (size_t i = 0; i < map_val->size; i++) - { - void *contents = (void *)map_val->contents; - void *l_value = contents + (i * member_size) + l_offset; - void *r_value = contents + (i * member_size) + r_offset; + for ( size_t i = 0; i < map_val->size; i++ ) + { + void *contents = (void *)map_val->contents; + void *l_value = contents + (i * member_size) + l_offset; + void *r_value = contents + (i * member_size) + r_offset; - const char *l_value_as_string = - get_val_as_string(l_type, l_value); - add_struct_value(r_type, r_value, add_struct_member, - l_value_as_string, struct_node); + const char *l_value_as_string + = get_val_as_string(l_type, l_value); + add_struct_value(r_type, r_value, add_struct_member, + l_value_as_string, struct_node); - free((char*)l_value_as_string); - } + free((char *)l_value_as_string); } } - break; + } + break; - case DATETIME: - { - char buf[255]; - struct tm *tm = gmtime((time_t*)value); - strftime(buf, sizeof(buf), "%Y%m%dT%H:%M:%S", tm); - adder(node, key, "string", buf); - } - break; + case DATETIME: + { + char buf[255]; + struct tm *tm = gmtime((time_t *)value); + strftime(buf, sizeof(buf), "%Y%m%dT%H:%M:%S", tm); + adder(node, key, "string", buf); + } + break; - default: - assert(false); + default: + assert(false); } } - -static const char * -get_val_as_string(const struct abstract_type *type, void *value) +static const char *get_val_as_string(const struct abstract_type *type, + void *value) { - switch (type->XEN_API_TYPE) + switch ( type->XEN_API_TYPE ) { - case REF: - { - char *buf = NULL; - arbitrary_record_opt *val = *(arbitrary_record_opt **)value; + case REF: + { + char *buf = NULL; + arbitrary_record_opt *val = *(arbitrary_record_opt **)value; - if (val != NULL) + if ( val != NULL ) + { + if ( val->is_record ) { - if (val->is_record) - { - buf = (char *)malloc(strlen(val->u.record->handle) + 1); - strcpy(buf, val->u.record->handle); - } - else + buf = (char *)malloc(strlen(val->u.record->handle) + 1); + strcpy(buf, val->u.record->handle); + } + else + { + if ( val->u.handle != NULL ) { - if(val->u.handle!=NULL) { - buf = (char *)malloc(strlen(val->u.handle) + 1); - strcpy(buf, val->u.handle); - } + buf = (char *)malloc(strlen(val->u.handle) + 1); + strcpy(buf, val->u.handle); } } - - return buf; } - case STRING: - { - xmlChar *encoded_value = *(xmlChar **)value; - xmlParserCtxtPtr ctxt = xmlCreateDocParserCtxt(encoded_value); - char *res = (char*)xmlStringDecodeEntities(ctxt, encoded_value, 1, 0, 0, 0); - xmlFreeParserCtxt(ctxt); - return res; - } + return buf; + } - case INT: - { - int str_len = sizeof(char) * 20; - char *buf = (char *)malloc(str_len); - int64_t val = *(int64_t *)value; - snprintf(buf, str_len, "%"PRId64, val); - return buf; - } + case STRING: + { + xmlChar *encoded_value = *(xmlChar **)value; + xmlParserCtxtPtr ctxt = xmlCreateDocParserCtxt(encoded_value); + char *res + = (char *)xmlStringDecodeEntities(ctxt, encoded_value, 1, 0, 0, 0); + xmlFreeParserCtxt(ctxt); + return res; + } - case ENUM: - { - int val = *(int *)value; - char *buf = (char *)malloc(strlen(type->enum_marshaller(val)) + 1); - strcpy(buf, type->enum_marshaller(val)); - return buf; - } + case INT: + { + int str_len = sizeof(char) * 20; + char *buf = (char *)malloc(str_len); + int64_t val = *(int64_t *)value; + snprintf(buf, str_len, "%" PRId64, val); + return buf; + } - default: - assert(false); - break; + case ENUM: + { + int val = *(int *)value; + char *buf = (char *)malloc(strlen(type->enum_marshaller(val)) + 1); + strcpy(buf, type->enum_marshaller(val)); + return buf; } -} + default: + assert(false); + break; + } +} -static xmlNode * -add_container(xmlNode *parent, const char *name) +static xmlNode *add_container(xmlNode *parent, const char *name) { return xmlNewChild(parent, NULL, BAD_CAST name, NULL); } - -static void -add_param(xmlNode *params_node, const char *type, const char *value) +static void add_param(xmlNode *params_node, const char *type, + const char *value) { xmlNode *param_node = add_container(params_node, "param"); add_value(param_node, type, value); } - -static void -add_value(xmlNode *parent, const char *type, const char *value) +static void add_value(xmlNode *parent, const char *type, const char *value) { xmlNode *value_node = add_container(parent, "value"); xmlNewChild(value_node, NULL, BAD_CAST type, BAD_CAST value); } - -static void -add_unnamed_value(xmlNode *parent, const char *name, const char *type, - const char *value) +static void add_unnamed_value(xmlNode *parent, const char *name, + const char *type, const char *value) { (void)name; add_value(parent, type, value); } - -static xmlNode * -add_param_struct(xmlNode *params_node) +static xmlNode *add_param_struct(xmlNode *params_node) { xmlNode *param_node = add_container(params_node, "param"); - xmlNode *value_node = add_container(param_node, "value"); + xmlNode *value_node = add_container(param_node, "value"); return xmlNewChild(value_node, NULL, BAD_CAST "struct", NULL); } -static xmlNode * -add_param_array(xmlNode *params_node) +static xmlNode *add_param_array(xmlNode *params_node) { xmlNode *param_node = add_container(params_node, "param"); - xmlNode *value_node = add_container(param_node, "value"); - xmlNode *array_node = add_container(value_node, "array"); + xmlNode *value_node = add_container(param_node, "value"); + xmlNode *array_node = add_container(value_node, "array"); return add_container(array_node, "data"); } -static void -add_struct_member(xmlNode *struct_node, const char *name, const char *type, - const char *value) +static void add_struct_member(xmlNode *struct_node, const char *name, + const char *type, const char *value) { xmlNode *member_node = add_container(struct_node, "member"); @@ -1811,23 +1650,19 @@ add_struct_member(xmlNode *struct_node, const char *name, const char *type, add_value(member_node, type, value); } - -static xmlNode * -add_struct_array(xmlNode *struct_node, const char *name) +static xmlNode *add_struct_array(xmlNode *struct_node, const char *name) { xmlNode *member_node = add_container(struct_node, "member"); xmlNewChild(member_node, NULL, BAD_CAST "name", BAD_CAST name); xmlNode *value_node = add_container(member_node, "value"); - xmlNode *array_node = add_container(value_node, "array"); + xmlNode *array_node = add_container(value_node, "array"); - return add_container(array_node, "data"); + return add_container(array_node, "data"); } - -static xmlNode * -add_nested_struct(xmlNode *struct_node, const char *name) +static xmlNode *add_nested_struct(xmlNode *struct_node, const char *name) { xmlNode *member_node = add_container(struct_node, "member"); @@ -1838,33 +1673,29 @@ add_nested_struct(xmlNode *struct_node, const char *name) return add_container(value_node, "struct"); } - int xen_enum_lookup_(const char *str, const char **lookup_table, int n) { - if (str != NULL) + if ( str != NULL ) { - for (int i = 0; i < n; i++) + for ( int i = 0; i < n; i++ ) { - if (0 == strcmp(str, lookup_table[i])) + if ( 0 == strcmp(str, lookup_table[i]) ) { return i; } } } - return n - 1; /* lookup_table[n - 1] is always "undefined". */ + return n - 1; /* lookup_table[n - 1] is always "undefined". */ } - -char * -xen_strdup_(const char *in) +char *xen_strdup_(const char *in) { char *result = malloc(strlen(in) + 1); strcpy(result, in); return result; } - const abstract_type abstract_type_string = { .XEN_API_TYPE = STRING }; const abstract_type abstract_type_int = { .XEN_API_TYPE = INT }; const abstract_type abstract_type_float = { .XEN_API_TYPE = FLOAT }; @@ -1872,186 +1703,109 @@ const abstract_type abstract_type_bool = { .XEN_API_TYPE = BOOL }; const abstract_type abstract_type_datetime = { .XEN_API_TYPE = DATETIME }; const abstract_type abstract_type_ref = { .XEN_API_TYPE = REF }; -const abstract_type abstract_type_string_set = -{ - .XEN_API_TYPE = SET, - .child = &abstract_type_string -}; +const abstract_type abstract_type_string_set + = { .XEN_API_TYPE = SET, .child = &abstract_type_string }; -const abstract_type abstract_type_string_set_set = -{ - .XEN_API_TYPE = SET, - .child = &abstract_type_string_set -}; +const abstract_type abstract_type_string_set_set + = { .XEN_API_TYPE = SET, .child = &abstract_type_string_set }; -const abstract_type abstract_type_int_set = -{ - .XEN_API_TYPE = SET, - .child = &abstract_type_int -}; - -const abstract_type abstract_type_ref_set = -{ - .XEN_API_TYPE = SET, - .child = &abstract_type_ref -}; +const abstract_type abstract_type_int_set + = { .XEN_API_TYPE = SET, .child = &abstract_type_int }; +const abstract_type abstract_type_ref_set + = { .XEN_API_TYPE = SET, .child = &abstract_type_ref }; typedef struct xen_string_ref_map_contents { - char *key; - struct arbitrary_record_opt *val; + char *key; + struct arbitrary_record_opt *val; } xen_string_ref_map_contents; -static const struct struct_member string_ref_members[] = -{ - { - .type = &abstract_type_string, - .offset = offsetof(xen_string_ref_map_contents, key) - }, - { - .type = &abstract_type_ref, - .offset = offsetof(xen_string_ref_map_contents, val) - } -}; - -const abstract_type abstract_type_string_ref_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_string_ref_map_contents), - .members = string_ref_members -}; - -static const struct struct_member string_int_members[] = -{ - { - .type = &abstract_type_string, - .offset = offsetof(xen_string_int_map_contents, key) - }, - { - .type = &abstract_type_int, - .offset = offsetof(xen_string_int_map_contents, val) - } -}; - -const abstract_type abstract_type_string_int_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_string_int_map_contents), - .members = string_int_members -}; - -static const struct struct_member string_string_members[] = -{ - { - .type = &abstract_type_string, - .offset = offsetof(xen_string_string_map_contents, key) - }, - { - .type = &abstract_type_string, - .offset = offsetof(xen_string_string_map_contents, val) - } -}; - -const abstract_type abstract_type_string_string_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_string_string_map_contents), - .members = string_string_members -}; - -static struct struct_member int_float_members[] = -{ - { - .type = &abstract_type_int, - .offset = offsetof(xen_int_float_map_contents, key) - }, - { - .type = &abstract_type_float, - .offset = offsetof(xen_int_float_map_contents, val) - } -}; - -const abstract_type abstract_type_int_float_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_int_float_map_contents), - .members = int_float_members -}; - -static struct struct_member int_int_members[] = -{ - { - .type = &abstract_type_int, - .offset = offsetof(xen_int_int_map_contents, key) - }, - { - .type = &abstract_type_int, - .offset = offsetof(xen_int_int_map_contents, val) - } -}; - -const abstract_type abstract_type_int_int_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_int_int_map_contents), - .members = int_int_members -}; - -static struct struct_member int_string_set_members[] = -{ - { - .type = &abstract_type_int, - .offset = offsetof(xen_int_string_set_map_contents, key) - }, - { - .type = &abstract_type_string_set, - .offset = offsetof(xen_int_string_set_map_contents, val) - } -}; - -const abstract_type abstract_type_int_string_set_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_int_string_set_map_contents), - .members = int_string_set_members -}; - -static struct struct_member string_string_set_members[] = -{ - { - .type = &abstract_type_string, - .offset = offsetof(xen_string_string_set_map_contents, key) - }, - { - .type = &abstract_type_string_set, - .offset = offsetof(xen_string_string_set_map_contents, val) - } -}; - -const abstract_type abstract_type_string_string_set_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_string_string_set_map_contents), - .members = string_string_set_members -}; - -static struct struct_member string_string_string_map_members[] = -{ - { - .type = &abstract_type_string, - .offset = offsetof(xen_string_string_string_map_map_contents, key) - }, - { - .type = &abstract_type_string_string_map, - .offset = offsetof(xen_string_string_string_map_map_contents, val) - } -}; - -const abstract_type abstract_type_string_string_string_map_map = -{ - .XEN_API_TYPE = MAP, - .struct_size = sizeof(xen_string_string_string_map_map_contents), - .members = string_string_string_map_members -}; - +static const struct struct_member string_ref_members[] + = { { .type = &abstract_type_string, + .offset = offsetof(xen_string_ref_map_contents, key) }, + { .type = &abstract_type_ref, + .offset = offsetof(xen_string_ref_map_contents, val) } }; + +const abstract_type abstract_type_string_ref_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_string_ref_map_contents), + .members = string_ref_members }; + +static const struct struct_member string_int_members[] + = { { .type = &abstract_type_string, + .offset = offsetof(xen_string_int_map_contents, key) }, + { .type = &abstract_type_int, + .offset = offsetof(xen_string_int_map_contents, val) } }; + +const abstract_type abstract_type_string_int_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_string_int_map_contents), + .members = string_int_members }; + +static const struct struct_member string_string_members[] + = { { .type = &abstract_type_string, + .offset = offsetof(xen_string_string_map_contents, key) }, + { .type = &abstract_type_string, + .offset = offsetof(xen_string_string_map_contents, val) } }; + +const abstract_type abstract_type_string_string_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_string_string_map_contents), + .members = string_string_members }; + +static struct struct_member int_float_members[] + = { { .type = &abstract_type_int, + .offset = offsetof(xen_int_float_map_contents, key) }, + { .type = &abstract_type_float, + .offset = offsetof(xen_int_float_map_contents, val) } }; + +const abstract_type abstract_type_int_float_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_int_float_map_contents), + .members = int_float_members }; + +static struct struct_member int_int_members[] + = { { .type = &abstract_type_int, + .offset = offsetof(xen_int_int_map_contents, key) }, + { .type = &abstract_type_int, + .offset = offsetof(xen_int_int_map_contents, val) } }; + +const abstract_type abstract_type_int_int_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_int_int_map_contents), + .members = int_int_members }; + +static struct struct_member int_string_set_members[] + = { { .type = &abstract_type_int, + .offset = offsetof(xen_int_string_set_map_contents, key) }, + { .type = &abstract_type_string_set, + .offset = offsetof(xen_int_string_set_map_contents, val) } }; + +const abstract_type abstract_type_int_string_set_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_int_string_set_map_contents), + .members = int_string_set_members }; + +static struct struct_member string_string_set_members[] + = { { .type = &abstract_type_string, + .offset = offsetof(xen_string_string_set_map_contents, key) }, + { .type = &abstract_type_string_set, + .offset = offsetof(xen_string_string_set_map_contents, val) } }; + +const abstract_type abstract_type_string_string_set_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_string_string_set_map_contents), + .members = string_string_set_members }; + +static struct struct_member string_string_string_map_members[] + = { { .type = &abstract_type_string, + .offset = offsetof(xen_string_string_string_map_map_contents, key) }, + { .type = &abstract_type_string_string_map, + .offset + = offsetof(xen_string_string_string_map_map_contents, val) } }; + +const abstract_type abstract_type_string_string_string_map_map + = { .XEN_API_TYPE = MAP, + .struct_size = sizeof(xen_string_string_string_map_map_contents), + .members = string_string_string_map_members }; diff --git a/ocaml/sdk-gen/c/autogen/src/xen_event_batch.c b/ocaml/sdk-gen/c/autogen/src/xen_event_batch.c index 51afa39dbb6..f2f086db1f0 100644 --- a/ocaml/sdk-gen/c/autogen/src/xen_event_batch.c +++ b/ocaml/sdk-gen/c/autogen/src/xen_event_batch.c @@ -32,31 +32,28 @@ #include #include - -static const struct_member xen_event_batch_struct_members [] = { +static const struct_member xen_event_batch_struct_members[] = { { .key = "events", - .type = &xen_event_record_set_abstract_type_, - .offset = offsetof(xen_event_batch, events)}, + .type = &xen_event_record_set_abstract_type_, + .offset = offsetof(xen_event_batch, events) }, { .key = "valid_ref_counts", - .type = &abstract_type_string_int_map, - .offset = offsetof(xen_event_batch, valid_ref_counts)}, + .type = &abstract_type_string_int_map, + .offset = offsetof(xen_event_batch, valid_ref_counts) }, { .key = "token", - .type = &abstract_type_string, - .offset = offsetof(xen_event_batch, token)}, + .type = &abstract_type_string, + .offset = offsetof(xen_event_batch, token) }, }; -const abstract_type xen_event_batch_abstract_type_ = { - .XEN_API_TYPE = STRUCT, - .struct_size = sizeof (xen_event_batch), - .member_count = - sizeof (xen_event_batch_struct_members) / sizeof (struct_member), - .members = xen_event_batch_struct_members -}; +const abstract_type xen_event_batch_abstract_type_ + = { .XEN_API_TYPE = STRUCT, + .struct_size = sizeof(xen_event_batch), + .member_count + = sizeof(xen_event_batch_struct_members) / sizeof(struct_member), + .members = xen_event_batch_struct_members }; -void -xen_event_batch_free(xen_event_batch *batch) +void xen_event_batch_free(xen_event_batch *batch) { - if (batch == NULL) + if ( batch == NULL ) { return; } @@ -66,17 +63,15 @@ xen_event_batch_free(xen_event_batch *batch) free(batch); } -bool -xen_event_from(xen_session *session, struct xen_event_batch **result, struct xen_string_set *classes, char *token, double timeout) +bool xen_event_from(xen_session *session, struct xen_event_batch **result, + struct xen_string_set *classes, char *token, + double timeout) { - abstract_value param_values[] = { - { .type = &abstract_type_string_set, - .u.set_val = (arbitrary_set *) classes}, - { .type = &abstract_type_string, - .u.string_val = token}, - { .type = &abstract_type_float, - .u.float_val = timeout} - }; + abstract_value param_values[] + = { { .type = &abstract_type_string_set, + .u.set_val = (arbitrary_set *)classes }, + { .type = &abstract_type_string, .u.string_val = token }, + { .type = &abstract_type_float, .u.float_val = timeout } }; abstract_type result_type = xen_event_batch_abstract_type_; *result = NULL; XEN_CALL_("event.from"); diff --git a/ocaml/sdk-gen/c/autogen/src/xen_int_set.c b/ocaml/sdk-gen/c/autogen/src/xen_int_set.c index 841be9f2a3c..e58a09ca349 100644 --- a/ocaml/sdk-gen/c/autogen/src/xen_int_set.c +++ b/ocaml/sdk-gen/c/autogen/src/xen_int_set.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,20 +31,16 @@ #include "xen_internal.h" #include - -xen_int_set * -xen_int_set_alloc(size_t size) +xen_int_set *xen_int_set_alloc(size_t size) { - xen_int_set *result = calloc(1, sizeof(xen_int_set) + - size * sizeof(int)); + xen_int_set *result = calloc(1, sizeof(xen_int_set) + size * sizeof(int)); result->size = size; return result; } -void -xen_int_set_free(xen_int_set *set) +void xen_int_set_free(xen_int_set *set) { - if (set == NULL) + if ( set == NULL ) { return; } diff --git a/ocaml/sdk-gen/c/autogen/src/xen_string_set.c b/ocaml/sdk-gen/c/autogen/src/xen_string_set.c index 988f38437ca..9725a895d23 100644 --- a/ocaml/sdk-gen/c/autogen/src/xen_string_set.c +++ b/ocaml/sdk-gen/c/autogen/src/xen_string_set.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,27 +31,24 @@ #include "xen_internal.h" #include - -xen_string_set * -xen_string_set_alloc(size_t size) +xen_string_set *xen_string_set_alloc(size_t size) { - xen_string_set *result = calloc(1, sizeof(xen_string_set) + - size * sizeof(char *)); + xen_string_set *result + = calloc(1, sizeof(xen_string_set) + size * sizeof(char *)); result->size = size; return result; } -void -xen_string_set_free(xen_string_set *set) +void xen_string_set_free(xen_string_set *set) { - if (set == NULL) + if ( set == NULL ) { return; } size_t n = set->size; - for (size_t i = 0; i < n; i++) + for ( size_t i = 0; i < n; i++ ) { - free(set->contents[i]); + free(set->contents[i]); } free(set); diff --git a/ocaml/sdk-gen/c/autogen/src/xen_string_set_set.c b/ocaml/sdk-gen/c/autogen/src/xen_string_set_set.c index 2eb93086b60..b8987be04ca 100644 --- a/ocaml/sdk-gen/c/autogen/src/xen_string_set_set.c +++ b/ocaml/sdk-gen/c/autogen/src/xen_string_set_set.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -32,24 +32,21 @@ #include #include - -xen_string_set_set * -xen_string_set_set_alloc(size_t size) +xen_string_set_set *xen_string_set_set_alloc(size_t size) { - xen_string_set_set *result = calloc(1, sizeof(xen_string_set_set) + - size * sizeof(xen_string_set *)); + xen_string_set_set *result = calloc( + 1, sizeof(xen_string_set_set) + size * sizeof(xen_string_set *)); result->size = size; return result; } -void -xen_string_set_set_free(xen_string_set_set *set) +void xen_string_set_set_free(xen_string_set_set *set) { - if (set == NULL) + if ( set == NULL ) return; size_t n = set->size; - for (size_t i = 0; i < n; i++) + for ( size_t i = 0; i < n; i++ ) xen_string_set_free(set->contents[i]); free(set); diff --git a/ocaml/sdk-gen/c/autogen/test/test_enumerate.c b/ocaml/sdk-gen/c/autogen/test/test_enumerate.c index 72ff277038f..d408d07406e 100644 --- a/ocaml/sdk-gen/c/autogen/test/test_enumerate.c +++ b/ocaml/sdk-gen/c/autogen/test/test_enumerate.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -38,15 +38,14 @@ * */ - #define _GNU_SOURCE #include -#include #include +#include #include -#include #include +#include #include @@ -55,20 +54,20 @@ #define INDENTATION_LEVEL 2 #define RIGHT_JUST 30 -#define PRINT_INDENT(indent, string, format, ... ) \ - { \ - int j; \ - for (j=0;j<(int)indent;j++) \ - { \ - printf(" "); \ - } \ - printf("%s", string); \ - for (j=0;j<(int)(RIGHT_JUST-indent-strlen(string)); j++) \ - { \ - printf(" "); \ - } \ - printf(format, __VA_ARGS__); \ - printf("\n"); \ +#define PRINT_INDENT(indent, string, format, ...) \ + { \ + int j; \ + for ( j = 0; j < (int)indent; j++ ) \ + { \ + printf(" "); \ + } \ + printf("%s", string); \ + for ( j = 0; j < (int)(RIGHT_JUST - indent - strlen(string)); j++ ) \ + { \ + printf(" "); \ + } \ + printf(format, __VA_ARGS__); \ + printf("\n"); \ } typedef struct @@ -81,8 +80,7 @@ typedef struct static char *url; -static void -usage() +static void usage() { fprintf(stderr, "Usage:\n" @@ -90,41 +88,38 @@ usage() " test_enumerate \n" "\n" "where\n" - " is the server's URL, e.g. https://server.example.com\n" + " is the server's URL, e.g. " + "https://server.example.com\n" " is the username to use at the server; and\n" " is the password.\n"); exit(EXIT_FAILURE); } -static size_t -write_func(void *ptr, size_t size, size_t nmemb, xen_comms *comms) +static size_t write_func(void *ptr, size_t size, size_t nmemb, + xen_comms *comms) { size_t n = size * nmemb; #ifdef PRINT_XML - printf("Data from server:\n%s\n", ((char*) ptr)); + printf("Data from server:\n%s\n", ((char *)ptr)); #endif return comms->func(ptr, n, comms->handle) ? n : 0; } -static int -call_func(const void *data, size_t len, void *user_handle, - void *result_handle, xen_result_func result_func) +static int call_func(const void *data, size_t len, void *user_handle, + void *result_handle, xen_result_func result_func) { - (void) user_handle; + (void)user_handle; #ifdef PRINT_XML - printf("Data to server:\n%s\n", ((char*) data)); + printf("Data to server:\n%s\n", ((char *)data)); #endif CURL *curl = curl_easy_init(); - if (!curl) + if ( !curl ) return -1; - xen_comms comms = { - .func = result_func, - .handle = result_handle - }; + xen_comms comms = { .func = result_func, .handle = result_handle }; curl_easy_setopt(curl, CURLOPT_URL, url); curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 1); @@ -146,72 +141,70 @@ call_func(const void *data, size_t len, void *user_handle, return result; } -static void -dump_string_map(xen_string_string_map *smap, char *string, int indent) +static void dump_string_map(xen_string_string_map *smap, char *string, + int indent) { unsigned int i; char buf[512]; - if (!smap) + if ( !smap ) return; PRINT_INDENT(indent, string, "%s", ""); indent += INDENTATION_LEVEL; - for (i = 0; i < smap->size; i++) + for ( i = 0; i < smap->size; i++ ) { sprintf(buf, "[%s, %s]", smap->contents[i].key, smap->contents[i].val); PRINT_INDENT(indent, buf, "%s", ""); } } -static void -dump_string_set(xen_string_set *sset, char *string, int indent) +static void dump_string_set(xen_string_set *sset, char *string, int indent) { unsigned int i; - if (!sset) + if ( !sset ) return; PRINT_INDENT(indent, string, "%s", ""); indent += INDENTATION_LEVEL; - for (i = 0; i < sset->size; i++) + for ( i = 0; i < sset->size; i++ ) PRINT_INDENT(indent, "", "%s", sset->contents[i]); } +// dump a virtual disk interface (VDI) record -//dump a virtual disk interface (VDI) record - -static void -dump_vdi_record(xen_vdi_record *vrec, int indent) +static void dump_vdi_record(xen_vdi_record *vrec, int indent) { indent += INDENTATION_LEVEL; PRINT_INDENT(indent, "uuid:", "%s", vrec->uuid); PRINT_INDENT(indent, "name_label:", "%s", vrec->name_label); PRINT_INDENT(indent, "name_description:", "%s", vrec->name_description); - PRINT_INDENT(indent, "virtual_size:", "%"PRId64, vrec->virtual_size); - PRINT_INDENT(indent, "physical_utilisation:", "%"PRId64, vrec->physical_utilisation); + PRINT_INDENT(indent, "virtual_size:", "%" PRId64, vrec->virtual_size); + PRINT_INDENT(indent, "physical_utilisation:", "%" PRId64, + vrec->physical_utilisation); PRINT_INDENT(indent, "type:", "%s", xen_vdi_type_to_string(vrec->type)); PRINT_INDENT(indent, "sharable:", "%d", vrec->sharable); PRINT_INDENT(indent, "read_only:", "%d", vrec->read_only); } -static void -dump_vdi_opt_record(xen_session *session, xen_vdi_record_opt *voptr, int indent) +static void dump_vdi_opt_record(xen_session *session, + xen_vdi_record_opt *voptr, int indent) { xen_vdi_record *vrec; - if (voptr->is_record) + if ( voptr->is_record ) { dump_vdi_record(voptr->u.record, indent); } else { - if (xen_vdi_get_record(session, &vrec, voptr->u.handle)) + if ( xen_vdi_get_record(session, &vrec, voptr->u.handle) ) { dump_vdi_record(vrec, indent); xen_vdi_record_free(vrec); @@ -219,51 +212,54 @@ dump_vdi_opt_record(xen_session *session, xen_vdi_record_opt *voptr, int indent) } } - // dump a virtual block device record -static void -dump_vbd_record(xen_session *session, xen_vbd_record *vrec, int indent) +static void dump_vbd_record(xen_session *session, xen_vbd_record *vrec, + int indent) { indent += INDENTATION_LEVEL; PRINT_INDENT(indent, "uuid:", "%s", vrec->uuid); - //struct xen_vm_record_opt *vm; -- no need to follow to vm's ... we are dumping vdi's - //struct xen_vdi_record_opt *vdi; -- no need to follow to vdi ... we are dumping vdi's + // struct xen_vm_record_opt *vm; -- no need to follow to vm's ... we are + // dumping vdi's struct xen_vdi_record_opt *vdi; -- no need to follow to + // vdi ... we are dumping vdi's PRINT_INDENT(indent, "device:", "%s", vrec->device); PRINT_INDENT(indent, "bootable:", "%d", vrec->bootable); PRINT_INDENT(indent, "mode:", "%d", vrec->mode); PRINT_INDENT(indent, "type:", "%d", vrec->type); - PRINT_INDENT(indent, "currently_attached:", "%d", vrec->currently_attached); - PRINT_INDENT(indent, "status_code:", "%"PRId64, vrec->status_code); + PRINT_INDENT(indent, "currently_attached:", "%d", + vrec->currently_attached); + PRINT_INDENT(indent, "status_code:", "%" PRId64, vrec->status_code); PRINT_INDENT(indent, "status_detail:", "%s", vrec->status_detail); - PRINT_INDENT(indent, "qos_algorithm_type:", "%s", vrec->qos_algorithm_type); + PRINT_INDENT(indent, "qos_algorithm_type:", "%s", + vrec->qos_algorithm_type); - dump_string_set(vrec->qos_supported_algorithms, "qos_supported_algorithms:", indent); + dump_string_set(vrec->qos_supported_algorithms, + "qos_supported_algorithms:", indent); - if (vrec->vdi) + if ( vrec->vdi ) { PRINT_INDENT(indent, "VDI:", "%s", ""); dump_vdi_opt_record(session, vrec->vdi, indent); } - //struct xen_vbd_metrics_record_opt *metrics; + // struct xen_vbd_metrics_record_opt *metrics; } -static void -dump_vbd_opt_record(xen_session *session, xen_vbd_record_opt *voptr, int indent) +static void dump_vbd_opt_record(xen_session *session, + xen_vbd_record_opt *voptr, int indent) { xen_vbd_record *vrec; - if (voptr->is_record) + if ( voptr->is_record ) { dump_vbd_record(session, voptr->u.record, indent); } else { - if (xen_vbd_get_record(session, &vrec, voptr->u.handle)) + if ( xen_vbd_get_record(session, &vrec, voptr->u.handle) ) { dump_vbd_record(session, vrec, indent); xen_vbd_record_free(vrec); @@ -271,36 +267,37 @@ dump_vbd_opt_record(xen_session *session, xen_vbd_record_opt *voptr, int indent) } } -static void -dump_console_record(xen_console_record *crec, int indent) +static void dump_console_record(xen_console_record *crec, int indent) { indent += INDENTATION_LEVEL; PRINT_INDENT(indent, "uuid:", "%s", crec->uuid); - PRINT_INDENT(indent, "protocol:", "%s", xen_console_protocol_to_string(crec->protocol)); + PRINT_INDENT(indent, "protocol:", "%s", + xen_console_protocol_to_string(crec->protocol)); PRINT_INDENT(indent, "location:", "%s", crec->location); - //struct xen_vm_record_opt *vm; -- no need to follow to vm ... we are dumping vm's + // struct xen_vm_record_opt *vm; -- no need to follow to vm ... we are + // dumping vm's dump_string_map(crec->other_config, "other_config:", indent); } -static void -dump_consoles(xen_session *session, xen_console_record_opt_set *cons, int indent) +static void dump_consoles(xen_session *session, + xen_console_record_opt_set *cons, int indent) { unsigned int i; xen_console_record *crec; - for (i = 0; i < cons->size; i++) + for ( i = 0; i < cons->size; i++ ) { xen_console_record_opt *ccont = cons->contents[i]; - if (ccont->is_record) + if ( ccont->is_record ) { dump_console_record(ccont->u.record, indent); } else { - if (xen_console_get_record(session, &crec, ccont->u.handle)) + if ( xen_console_get_record(session, &crec, ccont->u.handle) ) { dump_console_record(crec, indent); xen_console_record_free(crec); @@ -309,85 +306,105 @@ dump_consoles(xen_session *session, xen_console_record_opt_set *cons, int indent } } -static void -dump_vm(xen_session *session, struct xen_vm_set *vm_set, int indent) +static void dump_vm(xen_session *session, struct xen_vm_set *vm_set, + int indent) { unsigned int i; xen_vm_record *rec = NULL; indent += INDENTATION_LEVEL; - for (i = 0; i < vm_set->size; i++) + for ( i = 0; i < vm_set->size; i++ ) { - if (xen_vm_get_record(session, &rec, vm_set->contents[i])) + if ( xen_vm_get_record(session, &rec, vm_set->contents[i]) ) { - if (rec->is_a_template) continue; - printf("------------------------------------------------------------------------------\n"); + if ( rec->is_a_template ) + continue; + printf("----------------------------------------------------------" + "--------------------\n"); printf("Virtual Machine: %s\n", rec->name_label); - printf("------------------------------------------------------------------------------\n"); + printf("----------------------------------------------------------" + "--------------------\n"); PRINT_INDENT(indent, "uuid:", "%s", rec->uuid); - PRINT_INDENT(indent, "power_state:", "%s", xen_vm_power_state_to_string(rec->power_state)); + PRINT_INDENT(indent, "power_state:", "%s", + xen_vm_power_state_to_string(rec->power_state)); PRINT_INDENT(indent, "name_label:", "%s", rec->name_label); - PRINT_INDENT(indent, "name_description:", "%s", rec->name_description); - PRINT_INDENT(indent, "user_version:", "%"PRId64, rec->user_version); + PRINT_INDENT(indent, "name_description:", "%s", + rec->name_description); + PRINT_INDENT(indent, "user_version:", "%" PRId64, + rec->user_version); PRINT_INDENT(indent, "is_a_template:", "%d", rec->is_a_template); - // -- no need to follow resident_on -- it points back to current host - PRINT_INDENT(indent, "memory_static_max:", "%"PRId64, rec->memory_static_max); - PRINT_INDENT(indent, "memory_static_min:", "%"PRId64, rec->memory_static_min); - PRINT_INDENT(indent, "memory_dynamic_max:", "%"PRId64, rec->memory_dynamic_max); - PRINT_INDENT(indent, "memory_dynamic_min:", "%"PRId64, rec->memory_dynamic_min); - if (rec->vcpus_params) + // -- no need to follow resident_on -- it points back to current + // host + PRINT_INDENT(indent, "memory_static_max:", "%" PRId64, + rec->memory_static_max); + PRINT_INDENT(indent, "memory_static_min:", "%" PRId64, + rec->memory_static_min); + PRINT_INDENT(indent, "memory_dynamic_max:", "%" PRId64, + rec->memory_dynamic_max); + PRINT_INDENT(indent, "memory_dynamic_min:", "%" PRId64, + rec->memory_dynamic_min); + if ( rec->vcpus_params ) { dump_string_map(rec->vcpus_params, "vcpus_params:", indent); } - PRINT_INDENT(indent, "vcpus_max:", "%"PRId64, rec->vcpus_max); - PRINT_INDENT(indent, "vcpus_at_startup:", "%"PRId64, rec->vcpus_at_startup); - PRINT_INDENT(indent, "actions_after_shutdown:", "%d", rec->actions_after_shutdown); - PRINT_INDENT(indent, "actions_after_reboot:", "%d", rec->actions_after_reboot); - PRINT_INDENT(indent, "actions_after_crash:", "%d", rec->actions_after_crash); - if (rec->consoles) + PRINT_INDENT(indent, "vcpus_max:", "%" PRId64, rec->vcpus_max); + PRINT_INDENT(indent, "vcpus_at_startup:", "%" PRId64, + rec->vcpus_at_startup); + PRINT_INDENT(indent, "actions_after_shutdown:", "%d", + rec->actions_after_shutdown); + PRINT_INDENT(indent, "actions_after_reboot:", "%d", + rec->actions_after_reboot); + PRINT_INDENT(indent, "actions_after_crash:", "%d", + rec->actions_after_crash); + if ( rec->consoles ) { PRINT_INDENT(indent, "consoles:", "%s", ""); dump_consoles(session, rec->consoles, indent); } - if (rec->vbds) + if ( rec->vbds ) { unsigned int j; PRINT_INDENT(indent, "VBDS:", "%s", ""); - for (j = 0; j < rec->vbds->size; j++) - dump_vbd_opt_record(session, rec->vbds->contents[j], indent); + for ( j = 0; j < rec->vbds->size; j++ ) + dump_vbd_opt_record(session, rec->vbds->contents[j], + indent); } PRINT_INDENT(indent, "pv_bootloader:", "%s", rec->pv_bootloader); PRINT_INDENT(indent, "pv_kernel:", "%s", rec->pv_kernel); PRINT_INDENT(indent, "pv_ramdisk:", "%s", rec->pv_ramdisk); PRINT_INDENT(indent, "pv_args:", "%s", rec->pv_args); - PRINT_INDENT(indent, "pv_bootloader_args:", "%s", rec->pv_bootloader_args); - PRINT_INDENT(indent, "hvm_boot_policy:", "%s", rec->hvm_boot_policy); - if (rec->hvm_boot_params) + PRINT_INDENT(indent, "pv_bootloader_args:", "%s", + rec->pv_bootloader_args); + PRINT_INDENT(indent, "hvm_boot_policy:", "%s", + rec->hvm_boot_policy); + if ( rec->hvm_boot_params ) { - dump_string_map(rec->hvm_boot_params, "hvm_boot_params:", indent); + dump_string_map(rec->hvm_boot_params, + "hvm_boot_params:", indent); } PRINT_INDENT(indent, "pci_bus:", "%s", rec->pci_bus); - if (rec->other_config) + if ( rec->other_config ) { dump_string_map(rec->other_config, "other_config:", indent); } - PRINT_INDENT(indent, "domid:", "%"PRId64, rec->domid); - PRINT_INDENT(indent, "is_control_domain:", "%d", rec->is_control_domain); + PRINT_INDENT(indent, "domid:", "%" PRId64, rec->domid); + PRINT_INDENT(indent, "is_control_domain:", "%d", + rec->is_control_domain); } - printf("------------------------------------------------------------------------------\n"); + printf("--------------------------------------------------------------" + "----------------\n"); session->ok = true; printf("\n"); xen_vm_record_free(rec); } } -int -main(int argc, char **argv) +int main(int argc, char **argv) { - if (argc != 4) + if ( argc != 4 ) { usage(); } @@ -402,14 +419,14 @@ main(int argc, char **argv) xen_init(); curl_global_init(CURL_GLOBAL_ALL); - xen_session *session = xen_session_login_with_password(call_func, NULL, username, - password, xen_api_latest_version); + xen_session *session = xen_session_login_with_password( + call_func, NULL, username, password, xen_api_latest_version); /* get all vm entries */ - if (xen_vm_get_all(session, &vm_set)) + if ( xen_vm_get_all(session, &vm_set) ) dump_vm(session, vm_set, 0); - if (vm_set) + if ( vm_set ) xen_vm_set_free(vm_set); return 0; diff --git a/ocaml/sdk-gen/c/autogen/test/test_event_handling.c b/ocaml/sdk-gen/c/autogen/test/test_event_handling.c index 251192d2f71..47d42a41553 100644 --- a/ocaml/sdk-gen/c/autogen/test/test_event_handling.c +++ b/ocaml/sdk-gen/c/autogen/test/test_event_handling.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,75 +31,68 @@ #define _GNU_SOURCE #include #include -#include #include +#include #include -#include #include +#include #include - static void usage() { fprintf(stderr, -"Usage:\n" -"\n" -" test_event_handling \n" -"\n" -"where\n" -" is the server's URL, e.g. https://server.example.com\n" -" is the username to use at the server; and\n" -" is the password.\n"); + "Usage:\n" + "\n" + " test_event_handling \n" + "\n" + "where\n" + " is the server's URL, e.g. " + "https://server.example.com\n" + " is the username to use at the server; and\n" + " is the password.\n"); exit(EXIT_FAILURE); } - static char *url; - typedef struct { xen_result_func func; void *handle; } xen_comms; - -static size_t -write_func(void *ptr, size_t size, size_t nmemb, xen_comms *comms) +static size_t write_func(void *ptr, size_t size, size_t nmemb, + xen_comms *comms) { size_t n = size * nmemb; #ifdef PRINT_XML printf("\n\n---Result from server -----------------------\n"); - printf("%s\n",((char*) ptr)); + printf("%s\n", ((char *)ptr)); fflush(stdout); #endif return comms->func(ptr, n, comms->handle) ? n : 0; } - -static int -call_func(const void *data, size_t len, void *user_handle, - void *result_handle, xen_result_func result_func) +static int call_func(const void *data, size_t len, void *user_handle, + void *result_handle, xen_result_func result_func) { (void)user_handle; #ifdef PRINT_XML printf("\n\n---Data to server: -----------------------\n"); - printf("%s\n",((char*) data)); + printf("%s\n", ((char *)data)); fflush(stdout); #endif CURL *curl = curl_easy_init(); - if (!curl) { + if ( !curl ) + { return -1; } - xen_comms comms = { - .func = result_func, - .handle = result_handle - }; + xen_comms comms = { .func = result_func, .handle = result_handle }; curl_easy_setopt(curl, CURLOPT_URL, url); curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 1); @@ -121,18 +114,16 @@ call_func(const void *data, size_t len, void *user_handle, return result; } - static void print_error(xen_session *session) { fprintf(stderr, "Error: %d\n", session->error_description_count); - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { fprintf(stderr, "%s ", session->error_description[i]); } fprintf(stderr, "\n"); } - /** * Workaround for whinging GCCs, as suggested by strftime(3). */ @@ -142,10 +133,9 @@ static size_t my_strftime(char *s, size_t max, const char *fmt, return strftime(s, max, fmt, tm); } - int main(int argc, char **argv) { - if (argc != 4) + if ( argc != 4 ) { usage(); } @@ -158,27 +148,26 @@ int main(int argc, char **argv) xen_init(); curl_global_init(CURL_GLOBAL_ALL); -#define CLEANUP \ - do { \ - xen_session_logout(session); \ - curl_global_cleanup(); \ - xen_fini(); \ - xmlCleanupParser(); \ - } while(0) \ - +#define CLEANUP \ + do \ + { \ + xen_session_logout(session); \ + curl_global_cleanup(); \ + xen_fini(); \ + xmlCleanupParser(); \ + } while ( 0 ) - xen_session *session = - xen_session_login_with_password(call_func, NULL, username, password, - xen_api_latest_version); + xen_session *session = xen_session_login_with_password( + call_func, NULL, username, password, xen_api_latest_version); - //get events for all classes - char *all_classes = calloc(1, sizeof (all_classes)); - strncpy(all_classes, "*", sizeof (all_classes) - 1); + // get events for all classes + char *all_classes = calloc(1, sizeof(all_classes)); + strncpy(all_classes, "*", sizeof(all_classes) - 1); struct xen_string_set *classes = xen_string_set_alloc(1); classes->contents[0] = all_classes; - if (!session->ok) + if ( !session->ok ) { print_error(session); CLEANUP; @@ -188,35 +177,36 @@ int main(int argc, char **argv) // interval in seconds, after which the xen_event_from call should time out const double timeout = 30; - // the output of xen_event_from includes a token, which can be passed into a - // subsequent xen_event_from call to retrieve only the events that have occurred - // since the last call; if an empty string is passed, xen_event_from will return - // all events (this is normally done for the very first call) + // the output of xen_event_from includes a token, which can be passed into + // a subsequent xen_event_from call to retrieve only the events that have + // occurred since the last call; if an empty string is passed, + // xen_event_from will return all events (this is normally done for the + // very first call) char token[512]; token[0] = '\0'; - while (true) + while ( true ) { printf("Polling for events...\n"); struct xen_event_batch *event_batch; - if (!xen_event_from(session, &event_batch, classes, token, timeout)) + if ( !xen_event_from(session, &event_batch, classes, token, timeout) ) { print_error(session); CLEANUP; return 1; } - strncpy(token, event_batch->token, sizeof (token) - 1); - token[sizeof (token) - 1] = '\0'; + strncpy(token, event_batch->token, sizeof(token) - 1); + token[sizeof(token) - 1] = '\0'; - for (size_t i = 0; i < event_batch->events->size; i++) + for ( size_t i = 0; i < event_batch->events->size; i++ ) { xen_event_record *ev = event_batch->events->contents[i]; char time[256]; struct tm *tm = localtime(&ev->timestamp); my_strftime(time, 256, "%c, local time", tm); - printf("Event received: ID = %"PRId64", %s.\n", ev->id, time); - switch (ev->operation) + printf("Event received: ID = %" PRId64 ", %s.\n", ev->id, time); + switch ( ev->operation ) { case XEN_EVENT_OPERATION_ADD: printf("%s created with reference %s.\n", ev->class, ev->ref); diff --git a/ocaml/sdk-gen/c/autogen/test/test_failures.c b/ocaml/sdk-gen/c/autogen/test/test_failures.c index abb17ddcd4a..405c25b8c05 100644 --- a/ocaml/sdk-gen/c/autogen/test/test_failures.c +++ b/ocaml/sdk-gen/c/autogen/test/test_failures.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without + * + * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -34,26 +34,23 @@ * */ - #include #include #include #include - -static void print_code(enum xen_api_failure code, const char * str) +static void print_code(enum xen_api_failure code, const char *str) { printf("Code %d is string %s.\n", code, str); } - int main() { - enum xen_api_failure internal_error = - xen_api_failure_from_string("INTERNAL_ERROR"); - const char * handle_invalid = - xen_api_failure_to_string(XEN_API_FAILURE_HANDLE_INVALID); + enum xen_api_failure internal_error + = xen_api_failure_from_string("INTERNAL_ERROR"); + const char *handle_invalid + = xen_api_failure_to_string(XEN_API_FAILURE_HANDLE_INVALID); assert(internal_error == XEN_API_FAILURE_INTERNAL_ERROR); assert(strcmp(handle_invalid, "HANDLE_INVALID") == 0); diff --git a/ocaml/sdk-gen/c/autogen/test/test_get_records.c b/ocaml/sdk-gen/c/autogen/test/test_get_records.c index 410268aaf48..528d403dd27 100644 --- a/ocaml/sdk-gen/c/autogen/test/test_get_records.c +++ b/ocaml/sdk-gen/c/autogen/test/test_get_records.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -31,75 +31,68 @@ #define _GNU_SOURCE #include #include -#include #include +#include #include -#include #include +#include #include - static void usage() { fprintf(stderr, -"Usage:\n" -"\n" -" test_get_records \n" -"\n" -"where\n" -" is the server's URL, e.g. https://server.example.com\n" -" is the username to use at the server; and\n" -" is the password.\n"); + "Usage:\n" + "\n" + " test_get_records \n" + "\n" + "where\n" + " is the server's URL, e.g. " + "https://server.example.com\n" + " is the username to use at the server; and\n" + " is the password.\n"); exit(EXIT_FAILURE); } - static char *url; - typedef struct { xen_result_func func; void *handle; } xen_comms; - -static size_t -write_func(void *ptr, size_t size, size_t nmemb, xen_comms *comms) +static size_t write_func(void *ptr, size_t size, size_t nmemb, + xen_comms *comms) { size_t n = size * nmemb; #ifdef PRINT_XML printf("\n\n---Result from server -----------------------\n"); - printf("%s\n",((char*) ptr)); + printf("%s\n", ((char *)ptr)); fflush(stdout); #endif return comms->func(ptr, n, comms->handle) ? n : 0; } - -static int -call_func(const void *data, size_t len, void *user_handle, - void *result_handle, xen_result_func result_func) +static int call_func(const void *data, size_t len, void *user_handle, + void *result_handle, xen_result_func result_func) { (void)user_handle; #ifdef PRINT_XML printf("\n\n---Data to server: -----------------------\n"); - printf("%s\n",((char*) data)); + printf("%s\n", ((char *)data)); fflush(stdout); #endif CURL *curl = curl_easy_init(); - if (!curl) { + if ( !curl ) + { return -1; } - xen_comms comms = { - .func = result_func, - .handle = result_handle - }; + xen_comms comms = { .func = result_func, .handle = result_handle }; curl_easy_setopt(curl, CURLOPT_URL, url); curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 1); @@ -121,21 +114,19 @@ call_func(const void *data, size_t len, void *user_handle, return result; } - static void print_error(xen_session *session) { fprintf(stderr, "Error: %d\n", session->error_description_count); - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { fprintf(stderr, "%s ", session->error_description[i]); } fprintf(stderr, "\n"); } - int main(int argc, char **argv) { - if (argc != 4) + if ( argc != 4 ) usage(); url = argv[1]; @@ -146,35 +137,34 @@ int main(int argc, char **argv) xen_init(); curl_global_init(CURL_GLOBAL_ALL); -#define CLEANUP \ - do { \ - xen_session_logout(session); \ - curl_global_cleanup(); \ - xen_fini(); \ - xmlCleanupParser(); \ - } while(0) \ +#define CLEANUP \ + do \ + { \ + xen_session_logout(session); \ + curl_global_cleanup(); \ + xen_fini(); \ + xmlCleanupParser(); \ + } while ( 0 ) - - xen_session *session = xen_session_login_with_password(call_func, NULL, - username, password, xen_api_latest_version); + xen_session *session = xen_session_login_with_password( + call_func, NULL, username, password, xen_api_latest_version); - /* Print some info for hosts */ - + xen_host_xen_host_record_map *hostRecords; - if (!xen_host_get_all_records(session, &hostRecords)) + if ( !xen_host_get_all_records(session, &hostRecords) ) { print_error(session); CLEANUP; return 1; } - - for (size_t i = 0; i < hostRecords->size; i++) + + for ( size_t i = 0; i < hostRecords->size; i++ ) { - xen_host_record *rec = hostRecords->contents[i].val; + xen_host_record *rec = hostRecords->contents[i].val; printf("Host: %s, edition: %s\n", rec->name_label, rec->edition); } - + xen_host_xen_host_record_map_free(hostRecords); /* Print some info for templates */ @@ -182,37 +172,38 @@ int main(int argc, char **argv) char chosenUuid[256]; chosenUuid[0] = '\0'; - - xen_vm_xen_vm_record_map *vmRecords; - if (!xen_vm_get_all_records(session, &vmRecords)) + + xen_vm_xen_vm_record_map *vmRecords; + if ( !xen_vm_get_all_records(session, &vmRecords) ) { print_error(session); CLEANUP; return 1; } - - for (size_t i = 0; i < vmRecords->size; i++) + + for ( size_t i = 0; i < vmRecords->size; i++ ) { - xen_vm_record *rec = vmRecords->contents[i].val; - if (!rec->is_a_template) + xen_vm_record *rec = vmRecords->contents[i].val; + if ( !rec->is_a_template ) continue; - if (chosenUuid[0] == '\0') + if ( chosenUuid[0] == '\0' ) { - strncpy(chosenUuid, rec->uuid, sizeof (chosenUuid) - 1); - chosenUuid[sizeof (chosenUuid) - 1] = '\0'; + strncpy(chosenUuid, rec->uuid, sizeof(chosenUuid) - 1); + chosenUuid[sizeof(chosenUuid) - 1] = '\0'; } - - printf("VM: %s, vCPUs max: %" PRId64 "\n", rec->name_label, rec->vcpus_max); + + printf("VM: %s, vCPUs max: %" PRId64 "\n", rec->name_label, + rec->vcpus_max); } - + xen_vm_xen_vm_record_map_free(vmRecords); - + /* clone the first vm, add a blocked operation to the clone * and then print out its allowed and blocked oeprations */ xen_vm orig; - if (!xen_vm_get_by_uuid(session, &orig, chosenUuid)) + if ( !xen_vm_get_by_uuid(session, &orig, chosenUuid) ) { print_error(session); CLEANUP; @@ -222,47 +213,48 @@ int main(int argc, char **argv) xen_vm clone; xen_vm_clone(session, &clone, orig, "clonedVM"); - xen_vm_add_to_blocked_operations(session, clone, XEN_VM_OPERATIONS_POOL_MIGRATE, "123"); + xen_vm_add_to_blocked_operations(session, clone, + XEN_VM_OPERATIONS_POOL_MIGRATE, "123"); xen_vm_record *vm_rec; xen_vm_get_record(session, &vm_rec, clone); - for (size_t j = 0; j < vm_rec->allowed_operations->size; j++) + for ( size_t j = 0; j < vm_rec->allowed_operations->size; j++ ) { - printf("VM: %s, Allowed operation: %s\n", - vm_rec->name_label, - xen_vm_operations_to_string(vm_rec->allowed_operations->contents[j])); + printf("VM: %s, Allowed operation: %s\n", vm_rec->name_label, + xen_vm_operations_to_string( + vm_rec->allowed_operations->contents[j])); } - for (size_t k = 0; k < vm_rec->blocked_operations->size; k++) + for ( size_t k = 0; k < vm_rec->blocked_operations->size; k++ ) { printf("VM: %s, Blocked operation: %s, Error code: %s\n", - vm_rec->name_label, - xen_vm_operations_to_string(vm_rec->blocked_operations->contents[k].key), - vm_rec->blocked_operations->contents[k].val); + vm_rec->name_label, + xen_vm_operations_to_string( + vm_rec->blocked_operations->contents[k].key), + vm_rec->blocked_operations->contents[k].val); } xen_vm_record_free(vm_rec); xen_vm_destroy(session, clone); /* Print some info for storage repositories */ - - xen_sr_xen_sr_record_map *srRecords; - if (!xen_sr_get_all_records(session, &srRecords)) + + xen_sr_xen_sr_record_map *srRecords; + if ( !xen_sr_get_all_records(session, &srRecords) ) { print_error(session); CLEANUP; return 1; } - - for (size_t i = 0; i < srRecords->size; i++) + + for ( size_t i = 0; i < srRecords->size; i++ ) { - xen_sr_record *rec = srRecords->contents[i].val; - printf("SR: %s -> Free space: %" PRId64 "\n", - rec->name_label, - rec->physical_size - rec->physical_utilisation); + xen_sr_record *rec = srRecords->contents[i].val; + printf("SR: %s -> Free space: %" PRId64 "\n", rec->name_label, + rec->physical_size - rec->physical_utilisation); } - + xen_sr_xen_sr_record_map_free(srRecords); CLEANUP; diff --git a/ocaml/sdk-gen/c/autogen/test/test_vm_async_migrate.c b/ocaml/sdk-gen/c/autogen/test/test_vm_async_migrate.c index 5451d4fc989..4020a813c4b 100644 --- a/ocaml/sdk-gen/c/autogen/test/test_vm_async_migrate.c +++ b/ocaml/sdk-gen/c/autogen/test/test_vm_async_migrate.c @@ -54,78 +54,76 @@ #define _GNU_SOURCE #include -#include #include +#include #include #include #include -#include #include +#include #include static char *url; - typedef struct { xen_result_func func; void *handle; } xen_comms; - static void usage() { - fprintf(stderr, - "Usage:\n" - "\n" - " test_vm_async_migrate \n" - "\n" - "where\n" - " is the master server's URL, e.g. server.example.com\n" - " is the username to use at the server \n" - " is the password to .\n" - " is the name of the server to migrate all the VMs from\n" - " is the name server to migrate all the VMs to\n"); + fprintf( + stderr, + "Usage:\n" + "\n" + " test_vm_async_migrate " + "\n" + "\n" + "where\n" + " is the master server's URL, e.g. " + "server.example.com\n" + " is the username to use at the server \n" + " is the password to .\n" + " is the name of the server to migrate all the VMs " + "from\n" + " is the name server to migrate all the VMs to\n"); exit(EXIT_FAILURE); } -static size_t -write_func(void *ptr, size_t size, size_t nmemb, xen_comms *comms) +static size_t write_func(void *ptr, size_t size, size_t nmemb, + xen_comms *comms) { size_t n = size * nmemb; #ifdef PRINT_XML printf("\n\n---Result from server -----------------------\n"); - printf("%s\n",((char*) ptr)); + printf("%s\n", ((char *)ptr)); fflush(stdout); #endif return comms->func(ptr, n, comms->handle) ? n : 0; } - -static int -call_func(const void *data, size_t len, void *user_handle, - void *result_handle, xen_result_func result_func) +static int call_func(const void *data, size_t len, void *user_handle, + void *result_handle, xen_result_func result_func) { (void)user_handle; #ifdef PRINT_XML printf("\n\n---Data to server: -----------------------\n"); - printf("%s\n",((char*) data)); + printf("%s\n", ((char *)data)); fflush(stdout); #endif CURL *curl = curl_easy_init(); - if (!curl) { + if ( !curl ) + { return -1; } - xen_comms comms = { - .func = result_func, - .handle = result_handle - }; + xen_comms comms = { .func = result_func, .handle = result_handle }; curl_easy_setopt(curl, CURLOPT_URL, url); curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 1); @@ -147,11 +145,10 @@ call_func(const void *data, size_t len, void *user_handle, return result; } - static void print_error(xen_session *session) { fprintf(stderr, "Error: %d\n", session->error_description_count); - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { fprintf(stderr, "%s ", session->error_description[i]); } @@ -161,7 +158,7 @@ static void print_error(xen_session *session) int main(int argc, char **argv) { - if (argc != 6) + if ( argc != 6 ) { usage(); } @@ -170,50 +167,51 @@ int main(int argc, char **argv) char *username = argv[2]; char *password = argv[3]; - char* sourceHost = argv[4]; - char* targetHost = argv[5]; + char *sourceHost = argv[4]; + char *targetHost = argv[5]; xmlInitParser(); xmlKeepBlanksDefault(0); xen_init(); curl_global_init(CURL_GLOBAL_ALL); -#define CLEANUP \ - do { \ - xen_session_logout(session); \ - curl_global_cleanup(); \ - xen_fini(); \ - xmlCleanupParser(); \ - } while(0) \ +#define CLEANUP \ + do \ + { \ + xen_session_logout(session); \ + curl_global_cleanup(); \ + xen_fini(); \ + xmlCleanupParser(); \ + } while ( 0 ) - - xen_session *session = - xen_session_login_with_password(call_func, NULL, username, password, - xen_api_latest_version); + xen_session *session = xen_session_login_with_password( + call_func, NULL, username, password, xen_api_latest_version); /* Ensure the source and target hosts exist before attepting migration */ xen_host_set *source_hosts = 0; - if (!xen_host_get_by_name_label(session, &source_hosts, sourceHost) || source_hosts->size < 1) + if ( !xen_host_get_by_name_label(session, &source_hosts, sourceHost) + || source_hosts->size < 1 ) { fprintf(stderr, "Source host lookup failed.\n"); print_error(session); - if (source_hosts) + if ( source_hosts ) xen_host_set_free(source_hosts); return 1; } xen_host_set *target_hosts = 0; - if (!xen_host_get_by_name_label(session, &target_hosts, targetHost) || target_hosts->size < 1) + if ( !xen_host_get_by_name_label(session, &target_hosts, targetHost) + || target_hosts->size < 1 ) { fprintf(stderr, "Target host lookup failed.\n"); print_error(session); - if (target_hosts) + if ( target_hosts ) xen_host_set_free(target_hosts); return 1; } xen_vm_xen_vm_record_map *all_vms_in_pool; - if (!xen_vm_get_all_records(session, &all_vms_in_pool)) + if ( !xen_vm_get_all_records(session, &all_vms_in_pool) ) { xen_host_set_free(source_hosts); xen_host_set_free(target_hosts); @@ -222,10 +220,10 @@ int main(int argc, char **argv) return 1; } - xen_task* task_list = calloc(all_vms_in_pool->size, sizeof (xen_task)); - xen_string_string_map* options = xen_string_string_map_alloc(0); + xen_task *task_list = calloc(all_vms_in_pool->size, sizeof(xen_task)); + xen_string_string_map *options = xen_string_string_map_alloc(0); - for (size_t i = 0; i < all_vms_in_pool->size; i++) + for ( size_t i = 0; i < all_vms_in_pool->size; i++ ) { xen_vm a_vm = all_vms_in_pool->contents[i].key; xen_vm_record *rec = all_vms_in_pool->contents[i].val; @@ -236,15 +234,15 @@ int main(int argc, char **argv) * requested source_host */ - if (!rec->is_a_template - && !rec->is_control_domain - && (rec->power_state == XEN_VM_POWER_STATE_RUNNING) - && (strcmp(rec->resident_on->u.handle, - (char*) source_hosts->contents[0]) == 0)) + if ( !rec->is_a_template && !rec->is_control_domain + && (rec->power_state == XEN_VM_POWER_STATE_RUNNING) + && (strcmp(rec->resident_on->u.handle, + (char *)source_hosts->contents[0]) + == 0) ) { printf(" Migrating VM %s \n", rec->name_label); xen_vm_pool_migrate_async(session, &task_list[i], a_vm, - target_hosts->contents[0], options); + target_hosts->contents[0], options); } else { @@ -265,16 +263,16 @@ int main(int argc, char **argv) { int tasks_running = 0; - for (size_t j = 0; j < all_vms_in_pool->size; j++) + for ( size_t j = 0; j < all_vms_in_pool->size; j++ ) { xen_task a_task = task_list[j]; - if (a_task == NULL) + if ( a_task == NULL ) continue; enum xen_task_status_type task_status; xen_task_get_status(session, &task_status, a_task); - if (task_status == XEN_TASK_STATUS_TYPE_PENDING) + if ( task_status == XEN_TASK_STATUS_TYPE_PENDING ) { tasks_running++; } @@ -285,23 +283,25 @@ int main(int argc, char **argv) * process of being cancelled etc. */ - if (task_status == XEN_TASK_STATUS_TYPE_FAILURE) + if ( task_status == XEN_TASK_STATUS_TYPE_FAILURE ) { - if (xen_task_get_error_info(session, &error_msgs, task_list[j] )) + if ( xen_task_get_error_info(session, &error_msgs, + task_list[j]) ) { - /* VMs may need to meet certain criteria for migration to be - * possible between hosts; such as shared storage between - * hosts. It is advisable to check the criteria needed for - * migration on the particular version of XenServer. - * The error messages output below should give information - * that allows the identification of an unsupported - * operation + /* VMs may need to meet certain criteria for migration + * to be possible between hosts; such as shared storage + * between hosts. It is advisable to check the criteria + * needed for migration on the particular version of + * XenServer. The error messages output below should + * give information that allows the identification of + * an unsupported operation */ printf("-----------------------------------\n"); printf("Failed while trying to migrate VM: \n"); - for (size_t k = 0; k < error_msgs->size; k++) + for ( size_t k = 0; k < error_msgs->size; k++ ) { - printf("error_msg %zu : %s \n", k, error_msgs->contents[k]); + printf("error_msg %zu : %s \n", k, + error_msgs->contents[k]); } } } @@ -317,13 +317,12 @@ int main(int argc, char **argv) printf(" Tasks pending : %d \n", tasks_running); printf("**************************************\n"); - if (tasks_running == 0) + if ( tasks_running == 0 ) break; iter++; sleep(pause_interval_secs); - } - while (iter < max_iter); + } while ( iter < max_iter ); xen_string_set_free(error_msgs); xen_string_string_map_free(options); diff --git a/ocaml/sdk-gen/c/autogen/test/test_vm_ops.c b/ocaml/sdk-gen/c/autogen/test/test_vm_ops.c index 72c70e0f425..ebe23830cc1 100644 --- a/ocaml/sdk-gen/c/autogen/test/test_vm_ops.c +++ b/ocaml/sdk-gen/c/autogen/test/test_vm_ops.c @@ -1,19 +1,19 @@ /* * Copyright (c) Citrix Systems, Inc. * All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: - * + * * 1) Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. - * + * * 2) Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following * disclaimer in the documentation and/or other materials * provided with the distribution. - * + * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS @@ -47,81 +47,76 @@ #define _GNU_SOURCE #include -#include #include +#include #include -#include #include +#include #include static char *url; - typedef struct { xen_result_func func; void *handle; } xen_comms; - -static xen_vm create_new_vm(xen_session *session, char* template_name, char* sr_name, bool pv); +static xen_vm create_new_vm(xen_session *session, char *template_name, + char *sr_name, bool pv); static void print_vm_power_state(xen_session *session, xen_vm vm); static char *replace_str(char *str, char *orig, char *rep); static int cycle_vm(xen_session *session, xen_vm vm); - static void usage() { fprintf(stderr, -"Usage:\n" -"\n" -" test_vm_ops \n" -"\n" -"where\n" -" is the server's URL, e.g. https://server.example.com\n" -" the name of the SR in which to create a disk\n" -" is the username to use at the server; and\n" -" is the password.\n"); + "Usage:\n" + "\n" + " test_vm_ops \n" + "\n" + "where\n" + " is the server's URL, e.g. " + "https://server.example.com\n" + " the name of the SR in which to create a disk\n" + " is the username to use at the server; and\n" + " is the password.\n"); exit(EXIT_FAILURE); } -static size_t -write_func(void *ptr, size_t size, size_t nmemb, xen_comms *comms) +static size_t write_func(void *ptr, size_t size, size_t nmemb, + xen_comms *comms) { size_t n = size * nmemb; #ifdef PRINT_XML printf("\n\n---Result from server -----------------------\n"); - printf("%s\n",((char*) ptr)); + printf("%s\n", ((char *)ptr)); fflush(stdout); #endif return comms->func(ptr, n, comms->handle) ? n : 0; } - -static int -call_func(const void *data, size_t len, void *user_handle, - void *result_handle, xen_result_func result_func) +static int call_func(const void *data, size_t len, void *user_handle, + void *result_handle, xen_result_func result_func) { (void)user_handle; #ifdef PRINT_XML printf("\n\n---Data to server: -----------------------\n"); - printf("%s\n",((char*) data)); + printf("%s\n", ((char *)data)); fflush(stdout); #endif CURL *curl = curl_easy_init(); - if (!curl) { + if ( !curl ) + { return -1; } - xen_comms comms = { - .func = result_func, - .handle = result_handle - }; + xen_comms comms = { .func = result_func, .handle = result_handle }; curl_easy_setopt(curl, CURLOPT_URL, url); curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 1); @@ -143,22 +138,20 @@ call_func(const void *data, size_t len, void *user_handle, return result; } - static void print_error(xen_session *session) { fprintf(stderr, "Error: %d\n", session->error_description_count); - for (int i = 0; i < session->error_description_count; i++) + for ( int i = 0; i < session->error_description_count; i++ ) { fprintf(stderr, "%s ", session->error_description[i]); } fprintf(stderr, "\n"); } - int main(int argc, char **argv) { - if (argc != 5) + if ( argc != 5 ) { usage(); } @@ -173,18 +166,17 @@ int main(int argc, char **argv) xen_init(); curl_global_init(CURL_GLOBAL_ALL); -#define CLEANUP \ - do { \ - xen_session_logout(session); \ - curl_global_cleanup(); \ - xen_fini(); \ - xmlCleanupParser(); \ - } while(0) \ +#define CLEANUP \ + do \ + { \ + xen_session_logout(session); \ + curl_global_cleanup(); \ + xen_fini(); \ + xmlCleanupParser(); \ + } while ( 0 ) - - xen_session *session = - xen_session_login_with_password(call_func, NULL, username, password, - xen_api_latest_version); + xen_session *session = xen_session_login_with_password( + call_func, NULL, username, password, xen_api_latest_version); /* --------------------------------------------------------------------- Read host, capabilities and API vsn @@ -193,7 +185,7 @@ int main(int argc, char **argv) printf("\n\nQuerying host...\n"); xen_host host; - if (!xen_session_get_this_host(session, &host, session)) + if ( !xen_session_get_this_host(session, &host, session) ) { print_error(session); CLEANUP; @@ -201,7 +193,7 @@ int main(int argc, char **argv) } xen_string_string_map *versions; - if (!xen_host_get_software_version(session, &versions, host)) + if ( !xen_host_get_software_version(session, &versions, host) ) { print_error(session); xen_host_free(host); @@ -210,8 +202,8 @@ int main(int argc, char **argv) } xen_string_set *supported_bootloaders; - if (!xen_host_get_supported_bootloaders(session, &supported_bootloaders, - host)) + if ( !xen_host_get_supported_bootloaders(session, &supported_bootloaders, + host) ) { print_error(session); xen_string_string_map_free(versions); @@ -221,7 +213,7 @@ int main(int argc, char **argv) } xen_string_set *capabilities; - if (!xen_host_get_capabilities(session, &capabilities, host)) + if ( !xen_host_get_capabilities(session, &capabilities, host) ) { print_error(session); xen_string_set_free(supported_bootloaders); @@ -231,22 +223,21 @@ int main(int argc, char **argv) return 1; } - - for (size_t i = 0; i < versions->size; i++) + for ( size_t i = 0; i < versions->size; i++ ) { printf("%s -> %s.\n", versions->contents[i].key, versions->contents[i].val); } printf("Host supports the following bootloaders:"); - for (size_t i = 0; i < supported_bootloaders->size; i++) + for ( size_t i = 0; i < supported_bootloaders->size; i++ ) { printf(" %s", supported_bootloaders->contents[i]); } printf("\n"); printf("Host has the following capabilities:"); - for (size_t i = 0; i < capabilities->size; i++) + for ( size_t i = 0; i < capabilities->size; i++ ) { printf(" %s", capabilities->contents[i]); } @@ -262,8 +253,9 @@ int main(int argc, char **argv) --------------------------------------------------------------------- */ printf("\n\nCreating new HVM VM...\n"); - xen_vm hvm_vm = create_new_vm(session, "Other install media", sr_name, false); - if (!session->ok) + xen_vm hvm_vm + = create_new_vm(session, "Other install media", sr_name, false); + if ( !session->ok ) { /* Error has been logged, just clean up. */ CLEANUP; @@ -285,8 +277,7 @@ int main(int argc, char **argv) printf("\nGetting VM record...\n"); xen_vm_record *vm_record; xen_vm_get_record(session, &vm_record, hvm_vm); - printf("VM record: %s blob: %s\n", - (char *)vm_record->handle, + printf("VM record: %s blob: %s\n", (char *)vm_record->handle, (char *)blob_record->handle); printf("Freeing VM record...\n"); xen_vm_record_free(vm_record); @@ -294,8 +285,8 @@ int main(int argc, char **argv) printf("Freeing blob record...\n"); xen_blob_record_free(blob_record); printf("Blob record freed.\n"); - - if (!session->ok) + + if ( !session->ok ) { /* Error has been logged, just clean up. */ xen_vm_free(hvm_vm); @@ -307,14 +298,15 @@ int main(int argc, char **argv) Test Enum parsing by setting actions after shutdown */ - xen_vm_set_actions_after_shutdown(session, hvm_vm, XEN_ON_NORMAL_EXIT_RESTART); + xen_vm_set_actions_after_shutdown(session, hvm_vm, + XEN_ON_NORMAL_EXIT_RESTART); /* Test getting a map and having a play */ xen_string_string_map *hvm_boot_params; - if (!xen_vm_get_hvm_boot_params(session, &hvm_boot_params, hvm_vm)) + if ( !xen_vm_get_hvm_boot_params(session, &hvm_boot_params, hvm_vm) ) { print_error(session); CLEANUP; @@ -323,7 +315,7 @@ int main(int argc, char **argv) printf("HVM_boot_params contains:\n"); - for (size_t i = 0; i < hvm_boot_params->size; i++) + for ( size_t i = 0; i < hvm_boot_params->size; i++ ) { printf("%s -> %s.\n", hvm_boot_params->contents[i].key, hvm_boot_params->contents[i].val); @@ -337,7 +329,7 @@ int main(int argc, char **argv) /* TODO uncomment this when we test against real hosts, as SDK doesn't have debian template - + printf("\n\nCreating new PV VM...\n"); xen_vm pv_vm = create_new_vm(session, "Debian Etch 4.0", sr_name, true); if (!session->ok) @@ -392,160 +384,175 @@ static int cycle_vm(xen_session *session, xen_vm vm) return 0; } - /** - * Creation of a new VM by cloning from an existing template (looked up by name) + * Creation of a new VM by cloning from an existing template (looked up by + * name) */ -static xen_vm create_new_vm(xen_session *session, char* template_name, char* sr_name, bool PV) +static xen_vm create_new_vm(xen_session *session, char *template_name, + char *sr_name, bool PV) { /* * Lookup template by name */ xen_vm_set *vms; - if (!xen_vm_get_by_name_label(session, &vms, template_name) || - vms->size < 1) - { - fprintf(stderr, "VM lookup failed.\n"); - print_error(session); - return NULL; - } - + if ( !xen_vm_get_by_name_label(session, &vms, template_name) + || vms->size < 1 ) + { + fprintf(stderr, "VM lookup failed.\n"); + print_error(session); + return NULL; + } + /* * Create VM by cloning from template */ xen_vm vm; - char *name_before = "NewVM <&>"; //using xml sensitive characters + char *name_before = "NewVM <&>"; // using xml sensitive characters int name_length = 9; xen_vm_clone(session, &vm, vms->contents[0], name_before); char *name_after; xen_vm_get_name_label(session, &name_after, vm); int result = strncmp(name_before, name_after, name_length); - if (result != 0){ - fprintf(stderr, "Error: The VM name failed to be encoded/decoded correctly\n"); - fprintf(stderr, "Before:%s\nAfter:%s\n", name_before, name_after); - return NULL; - } - - xen_vm_set_free(vms); - - if (!session->ok) { - fprintf(stderr, "VM clone failed.\n"); - print_error(session); - return NULL; + if ( result != 0 ) + { + fprintf(stderr, + "Error: The VM name failed to be encoded/decoded correctly\n"); + fprintf(stderr, "Before:%s\nAfter:%s\n", name_before, name_after); + return NULL; } - if (PV) { + xen_vm_set_free(vms); - xen_string_string_map *other_config; - if (!xen_vm_get_other_config(session, &other_config, vm)) { - - fprintf(stderr, "VM get other_config failed.\n"); + if ( !session->ok ) + { + fprintf(stderr, "VM clone failed.\n"); print_error(session); return NULL; - } - - char *disks = NULL; - - for (size_t i=0; i < other_config->size; i++) { - - printf("%s -> %s.\n", other_config->contents[i].key, - other_config->contents[i].val); - - if (strcmp(other_config->contents[i].key, "disks") == 0) { - disks = other_config->contents[i].val; - break; + } + + if ( PV ) + { + + xen_string_string_map *other_config; + if ( !xen_vm_get_other_config(session, &other_config, vm) ) + { + + fprintf(stderr, "VM get other_config failed.\n"); + print_error(session); + return NULL; } - } - - if (disks == NULL) { - fprintf(stderr, "Did not find provision XML in other_config.\n"); - xen_string_string_map_free(other_config); - return NULL; - } - - xen_sr_set *srs; - if (!xen_sr_get_by_name_label(session, &srs, sr_name) || - srs->size < 1) { - - fprintf(stderr, "SR lookup failed.\n"); - print_error(session); - xen_vm_free(vm); - return NULL; - } - xen_sr sr = srs->contents[0]; + char *disks = NULL; - char *sr_uuid; + for ( size_t i = 0; i < other_config->size; i++ ) + { - if(!xen_sr_get_uuid(session, &sr_uuid, sr)){ - //TODO free...? + printf("%s -> %s.\n", other_config->contents[i].key, + other_config->contents[i].val); - return NULL; - } + if ( strcmp(other_config->contents[i].key, "disks") == 0 ) + { + disks = other_config->contents[i].val; + break; + } + } - char *new_str; - if(asprintf(&new_str, "sr=\"%s\"", sr_uuid) < 0) { - return NULL; - } + if ( disks == NULL ) + { + fprintf(stderr, "Did not find provision XML in other_config.\n"); + xen_string_string_map_free(other_config); + return NULL; + } - char *new_disks = replace_str(disks, "sr=\"\"", new_str); + xen_sr_set *srs; + if ( !xen_sr_get_by_name_label(session, &srs, sr_name) + || srs->size < 1 ) + { - free(new_str); + fprintf(stderr, "SR lookup failed.\n"); + print_error(session); + xen_vm_free(vm); + return NULL; + } - xen_string_string_map_free(other_config); + xen_sr sr = srs->contents[0]; - if (new_disks == NULL) { - fprintf(stderr, "Error replacing SR in provision XML.\n"); - return NULL; - } + char *sr_uuid; - fprintf(stdout, "New provisions XML: %s\n", new_disks); + if ( !xen_sr_get_uuid(session, &sr_uuid, sr) ) + { + // TODO free...? + + return NULL; + } + + char *new_str; + if ( asprintf(&new_str, "sr=\"%s\"", sr_uuid) < 0 ) + { + return NULL; + } + + char *new_disks = replace_str(disks, "sr=\"\"", new_str); + + free(new_str); + + xen_string_string_map_free(other_config); + + if ( new_disks == NULL ) + { + fprintf(stderr, "Error replacing SR in provision XML.\n"); + return NULL; + } + + fprintf(stdout, "New provisions XML: %s\n", new_disks); + + if ( !xen_vm_remove_from_other_config(session, vm, "disks") ) + { + fprintf(stderr, "Error removing old value from other_config.\n"); + print_error(session); + free(new_disks); + return NULL; + } + + if ( !xen_vm_add_to_other_config(session, vm, "disks", new_disks) ) + { + fprintf(stderr, "Error adding new value to other_config.\n"); + print_error(session); + free(new_disks); + return NULL; + } - if (!xen_vm_remove_from_other_config(session, vm, "disks")) { - fprintf(stderr, "Error removing old value from other_config.\n"); - print_error(session); free(new_disks); - return NULL; - } - - if (!xen_vm_add_to_other_config(session, vm, "disks", new_disks)) { - fprintf(stderr, "Error adding new value to other_config.\n"); + } + + xen_vm_set_name_description(session, vm, + "An example VM created via C bindings"); + if ( !session->ok ) + { + fprintf(stderr, "Failed to set VM description.\n"); print_error(session); - free(new_disks); return NULL; - } - - free(new_disks); } - - xen_vm_set_name_description(session, vm, "An example VM created via C bindings"); - if (!session->ok) - { - fprintf(stderr, "Failed to set VM description.\n"); - print_error(session); - return NULL; - } - + xen_vm_provision(session, vm); - if (!session->ok) - { - fprintf(stderr, "Failed to provision VM.\n"); - print_error(session); - return NULL; - } - - if (PV) - return vm; + if ( !session->ok ) + { + fprintf(stderr, "Failed to provision VM.\n"); + print_error(session); + return NULL; + } + + if ( PV ) + return vm; /* * Create a new disk for the new VM. */ printf("Creating new (blank) disk image in 'Shared SR'\n"); xen_sr_set *srs; - if (!xen_sr_get_by_name_label(session, &srs, sr_name) || - srs->size < 1) + if ( !xen_sr_get_by_name_label(session, &srs, sr_name) || srs->size < 1 ) { fprintf(stderr, "SR lookup failed.\n"); print_error(session); @@ -553,70 +560,58 @@ static xen_vm create_new_vm(xen_session *session, char* template_name, char* sr_ return NULL; } - xen_sr_record_opt sr_record = - { - .u.handle = srs->contents[0] - }; + xen_sr_record_opt sr_record = { .u.handle = srs->contents[0] }; - xen_string_string_map* other_config = xen_string_string_map_alloc(0); - xen_vdi_record vdi0_record = - { - .name_label = "MyRootFS", + xen_string_string_map *other_config = xen_string_string_map_alloc(0); + xen_vdi_record vdi0_record + = { .name_label = "MyRootFS", .name_description = "MyRootFS description", .sr = &sr_record, .virtual_size = (1024 * 1024 * 1024), /* 1 GiB in bytes */ .type = XEN_VDI_TYPE_SYSTEM, .sharable = false, .read_only = false, - .other_config = other_config - }; + .other_config = other_config }; xen_vdi vdi0; - if (!xen_vdi_create(session, &vdi0, &vdi0_record)) + if ( !xen_vdi_create(session, &vdi0, &vdi0_record) ) { fprintf(stderr, "VDI creation failed.\n"); print_error(session); xen_sr_set_free(srs); - + xen_vm_free(vm); return NULL; } + xen_vm_record_opt vm_record_opt = { .u.handle = vm }; + xen_vdi_record_opt vdi0_record_opt = { .u.handle = vdi0 }; + xen_string_string_map *qos_algorithm_params + = xen_string_string_map_alloc(0); + xen_string_string_map *vbd_other_config = xen_string_string_map_alloc(0); - xen_vm_record_opt vm_record_opt = - { - .u.handle = vm - }; - xen_vdi_record_opt vdi0_record_opt = - { - .u.handle = vdi0 - }; - xen_string_string_map* qos_algorithm_params = xen_string_string_map_alloc(0); - xen_string_string_map* vbd_other_config = xen_string_string_map_alloc(0); - - enum xen_vbd_type vbd_type_disk = xen_vbd_type_from_string(session, "Disk"); + enum xen_vbd_type vbd_type_disk + = xen_vbd_type_from_string(session, "Disk"); printf("Attaching disk image to newly created VM\n"); - xen_vbd_record vbd0_record = - { - .vm = &vm_record_opt, + xen_vbd_record vbd0_record + = { .vm = &vm_record_opt, .vdi = &vdi0_record_opt, .userdevice = "xvda", - .type = vbd_type_disk, + .type = vbd_type_disk, .mode = XEN_VBD_MODE_RW, .bootable = 1, - .qos_algorithm_params = qos_algorithm_params, - .other_config = vbd_other_config - }; + .qos_algorithm_params = qos_algorithm_params, + .other_config = vbd_other_config }; xen_vbd vbd0; - if (!xen_vbd_create(session, &vbd0, &vbd0_record)) + if ( !xen_vbd_create(session, &vbd0, &vbd0_record) ) { fprintf(stderr, "VBD creation failed.\n"); print_error(session); - xen_vdi_free(vdi0); + xen_vdi_free(vdi0); xen_sr_set_free(srs); xen_vm_free(vm); return NULL; @@ -626,15 +621,15 @@ static xen_vm create_new_vm(xen_session *session, char* template_name, char* sr_ char *vdi0_uuid; char *vbd0_uuid; - xen_vm_get_uuid(session, &vm_uuid, vm); + xen_vm_get_uuid(session, &vm_uuid, vm); xen_vdi_get_uuid(session, &vdi0_uuid, vdi0); - xen_vbd_get_uuid(session, &vbd0_uuid, vbd0); + xen_vbd_get_uuid(session, &vbd0_uuid, vbd0); - if (!session->ok) + if ( !session->ok ) { fprintf(stderr, "get_uuid call failed.\n"); print_error(session); - + xen_uuid_free(vm_uuid); xen_uuid_free(vdi0_uuid); xen_uuid_free(vbd0_uuid); @@ -646,10 +641,10 @@ static xen_vm create_new_vm(xen_session *session, char* template_name, char* sr_ } fprintf(stderr, - "Created a new VM, with UUID %s, VDI UUID %s, VBD " - "UUID %s.\n", - vm_uuid, vdi0_uuid, vbd0_uuid); - + "Created a new VM, with UUID %s, VDI UUID %s, VBD " + "UUID %s.\n", + vm_uuid, vdi0_uuid, vbd0_uuid); + xen_uuid_free(vm_uuid); xen_uuid_free(vdi0_uuid); xen_uuid_free(vbd0_uuid); @@ -660,7 +655,6 @@ static xen_vm create_new_vm(xen_session *session, char* template_name, char* sr_ return vm; } - /** * Print the power state for the given VM. */ @@ -669,13 +663,13 @@ static void print_vm_power_state(xen_session *session, xen_vm vm) char *vm_uuid; enum xen_vm_power_state power_state; - if (!xen_vm_get_uuid(session, &vm_uuid, vm)) + if ( !xen_vm_get_uuid(session, &vm_uuid, vm) ) { print_error(session); return; } - if (!xen_vm_get_power_state(session, &power_state, vm)) + if ( !xen_vm_get_power_state(session, &power_state, vm) ) { xen_uuid_free(vm_uuid); print_error(session); @@ -695,42 +689,45 @@ static void print_vm_power_state(xen_session *session, xen_vm vm) */ static char *replace_str(char *str, char *orig, char *rep) { - int occurrences = 0; - int i = 0, k = 0; - char *p = str; + int occurrences = 0; + int i = 0, k = 0; + char *p = str; - while ((p = strstr(p, orig)) != NULL) { - - ++occurrences; + while ( (p = strstr(p, orig)) != NULL ) + { - p += strlen(orig); - } + ++occurrences; - char *buffer = malloc(strlen(str) + 1 - (occurrences * (strlen(orig) - strlen(rep)))); - if(buffer == NULL) - return NULL; + p += strlen(orig); + } - p = str; - - while ((p = strstr(p, orig)) != NULL) { + char *buffer = malloc(strlen(str) + 1 + - (occurrences * (strlen(orig) - strlen(rep)))); + if ( buffer == NULL ) + return NULL; - int j = p - str - k; + p = str; - strncpy(buffer + i, str + k, j); - - i += j; - - strcpy(buffer + i, rep); + while ( (p = strstr(p, orig)) != NULL ) + { - i += strlen(rep); - - p += strlen(orig); - k += j + strlen(orig); - } + int j = p - str - k; + + strncpy(buffer + i, str + k, j); + + i += j; + + strcpy(buffer + i, rep); + + i += strlen(rep); + + p += strlen(orig); + k += j + strlen(orig); + } - strncpy(buffer + i, str + k, strlen(str + k)); + strncpy(buffer + i, str + k, strlen(str + k)); - buffer[i + strlen(str + k)] = '\0'; + buffer[i + strlen(str + k)] = '\0'; - return buffer; + return buffer; } diff --git a/ocaml/vhd-tool/src/direct_copy_stubs.c b/ocaml/vhd-tool/src/direct_copy_stubs.c index 579df243e8e..c62153a1f24 100644 --- a/ocaml/vhd-tool/src/direct_copy_stubs.c +++ b/ocaml/vhd-tool/src/direct_copy_stubs.c @@ -14,101 +14,106 @@ #define _GNU_SOURCE -#include -#include #include +#include +#include +#include #include #include +#include +#include #include #include -#include -#include -#include #include +#include +#include +#include #include #include -#include -#include -#include #include -enum direct_copy_rc { - OK = 0, - TRIED_AND_FAILED = 1, - READ_FAILED = 2, - WRITE_FAILED = 3, - WRITE_UNEXPECTED_EOF = 4, - WRITE_POLL_FAILED = 5, - READ_POLL_FAILED = 6 +enum direct_copy_rc +{ + OK = 0, + TRIED_AND_FAILED = 1, + READ_FAILED = 2, + WRITE_FAILED = 3, + WRITE_UNEXPECTED_EOF = 4, + WRITE_POLL_FAILED = 5, + READ_POLL_FAILED = 6 }; -#define XFER_BUFSIZ (2*1024*1024) +#define XFER_BUFSIZ (2 * 1024 * 1024) -struct direct_copy_handle { - int in_fd; - int out_fd; - char *buffer; +struct direct_copy_handle +{ + int in_fd; + int out_fd; + char *buffer; }; CAMLprim value stub_init(value in_fd, value out_fd) { - CAMLparam2(in_fd, out_fd); - CAMLlocal1(result); - int c_in_fd = Int_val(in_fd); - int c_out_fd = Int_val(out_fd); - struct direct_copy_handle *cpinfo = NULL; - int flags; - - /* This is where we will keep the handle on return to OCaml. The - * Abstract tag teaches OCaml's garbage collector not to mess with - * it */ - result = alloc(1, Abstract_tag); - - /* initialise handle */ - cpinfo = malloc(sizeof(struct direct_copy_handle)); - if (!cpinfo) caml_raise_out_of_memory(); - cpinfo->buffer = NULL; - if (posix_memalign((void **)&cpinfo->buffer, sysconf(_SC_PAGESIZE), XFER_BUFSIZ)) { - free(cpinfo); - caml_raise_out_of_memory(); - } - cpinfo->in_fd = c_in_fd; - cpinfo->out_fd = c_out_fd; + CAMLparam2(in_fd, out_fd); + CAMLlocal1(result); + int c_in_fd = Int_val(in_fd); + int c_out_fd = Int_val(out_fd); + struct direct_copy_handle *cpinfo = NULL; + int flags; + + /* This is where we will keep the handle on return to OCaml. The + * Abstract tag teaches OCaml's garbage collector not to mess with + * it */ + result = alloc(1, Abstract_tag); + + /* initialise handle */ + cpinfo = malloc(sizeof(struct direct_copy_handle)); + if ( !cpinfo ) + caml_raise_out_of_memory(); + cpinfo->buffer = NULL; + if ( posix_memalign((void **)&cpinfo->buffer, sysconf(_SC_PAGESIZE), + XFER_BUFSIZ) ) + { + free(cpinfo); + caml_raise_out_of_memory(); + } + cpinfo->in_fd = c_in_fd; + cpinfo->out_fd = c_out_fd; #ifdef __linux__ - /* Force the output to have O_DIRECT if possible. - Because it may not be possible, ignore any error - we might get on setting the flag. - */ - flags = fcntl(c_out_fd, F_GETFL, NULL); - if (flags >= 0 && !(flags & O_DIRECT)) - fcntl(c_out_fd, F_SETFL, flags | O_DIRECT); + /* Force the output to have O_DIRECT if possible. + Because it may not be possible, ignore any error + we might get on setting the flag. + */ + flags = fcntl(c_out_fd, F_GETFL, NULL); + if ( flags >= 0 && !(flags & O_DIRECT) ) + fcntl(c_out_fd, F_SETFL, flags | O_DIRECT); #endif - Field(result, 0) = (uintptr_t)cpinfo; - CAMLreturn(result); - + Field(result, 0) = (uintptr_t)cpinfo; + CAMLreturn(result); } CAMLprim value stub_cleanup(value handle) { - CAMLparam1(handle); - struct direct_copy_handle *cpinfo = NULL; + CAMLparam1(handle); + struct direct_copy_handle *cpinfo = NULL; - assert(Is_block(handle) && Tag_val(handle) == Abstract_tag); - cpinfo = (struct direct_copy_handle *)Field(handle, 0); + assert(Is_block(handle) && Tag_val(handle) == Abstract_tag); + cpinfo = (struct direct_copy_handle *)Field(handle, 0); - free(cpinfo->buffer); - free(cpinfo); - Field(handle, 0) = (uintptr_t)NULL; - CAMLreturn(Val_unit); + free(cpinfo->buffer); + free(cpinfo); + Field(handle, 0) = (uintptr_t)NULL; + CAMLreturn(Val_unit); } /* Wait for an fd. There will be a subsequent read() or write() * to collect any fd error conditions that might occur */ -static inline int pollwait(int fd, short event) { +static inline int pollwait(int fd, short event) +{ struct pollfd pfd; pfd.fd = fd; @@ -116,111 +121,131 @@ static inline int pollwait(int fd, short event) { return poll(&pfd, 1, -1); } -CAMLprim value stub_direct_copy(value handle, value len){ - CAMLparam2(handle, len); - CAMLlocal1(result); - size_t c_len = Int64_val(len); - struct direct_copy_handle *cpinfo = NULL; - size_t bytes; - size_t remaining; - enum direct_copy_rc rc; - - assert(Is_block(handle) && Tag_val(handle) == Abstract_tag); - cpinfo = (struct direct_copy_handle *)Field(handle, 0); - if (!cpinfo) caml_failwith("direct_copy: NULL handle"); - - /* Calling enter_blocking_section() actually releases the OCaml - * runtime lock, so no OCaml exceptions may be thrown, and no OCaml - * values may be accessed, until it is reacquired. Also this - * means other OCaml threads may do things while this is going - * on so the caller must be careful. */ - enter_blocking_section(); - - rc = TRIED_AND_FAILED; - bytes = 0; - - remaining = c_len; - while (remaining > 0) { - ssize_t bread; - ssize_t bwritten = 0; - - bread = read(cpinfo->in_fd, cpinfo->buffer, (remaining < XFER_BUFSIZ)?remaining:XFER_BUFSIZ); - /* If we previously hit exactly the end of the input by accident, we're done. */ - if (bread == 0) break; - if (bread < 0) { - if (errno == EINTR) continue; - if (errno == EAGAIN) { - if (pollwait(cpinfo->in_fd, POLLIN) < 0) { - /* If poll() got interrupted, hitting read() (or, later, write() - * again one extra time to try again is insignificant, and avoids - * another loop */ - if (errno == EINTR) continue; - rc = READ_POLL_FAILED; +CAMLprim value stub_direct_copy(value handle, value len) +{ + CAMLparam2(handle, len); + CAMLlocal1(result); + size_t c_len = Int64_val(len); + struct direct_copy_handle *cpinfo = NULL; + size_t bytes; + size_t remaining; + enum direct_copy_rc rc; + + assert(Is_block(handle) && Tag_val(handle) == Abstract_tag); + cpinfo = (struct direct_copy_handle *)Field(handle, 0); + if ( !cpinfo ) + caml_failwith("direct_copy: NULL handle"); + + /* Calling enter_blocking_section() actually releases the OCaml + * runtime lock, so no OCaml exceptions may be thrown, and no OCaml + * values may be accessed, until it is reacquired. Also this + * means other OCaml threads may do things while this is going + * on so the caller must be careful. */ + enter_blocking_section(); + + rc = TRIED_AND_FAILED; + bytes = 0; + + remaining = c_len; + while ( remaining > 0 ) + { + ssize_t bread; + ssize_t bwritten = 0; + + bread = read(cpinfo->in_fd, cpinfo->buffer, + (remaining < XFER_BUFSIZ) ? remaining : XFER_BUFSIZ); + /* If we previously hit exactly the end of the input by accident, we're + * done. */ + if ( bread == 0 ) + break; + if ( bread < 0 ) + { + if ( errno == EINTR ) + continue; + if ( errno == EAGAIN ) + { + if ( pollwait(cpinfo->in_fd, POLLIN) < 0 ) + { + /* If poll() got interrupted, hitting read() (or, later, + * write() again one extra time to try again is + * insignificant, and avoids another loop */ + if ( errno == EINTR ) + continue; + rc = READ_POLL_FAILED; + goto fail; + } + continue; + } + rc = READ_FAILED; + goto fail; + } + while ( bwritten < bread ) + { + ssize_t ret; + + ret = write(cpinfo->out_fd, cpinfo->buffer + bwritten, + bread - bwritten); + if ( ret == 0 ) + { + rc = WRITE_UNEXPECTED_EOF; goto fail; } - continue; + if ( ret < 0 ) + { + if ( errno == EINTR ) + continue; + /* If someone passed us a non-blocking FD and we got + * EAGAIN, we need to keep trying, because the input FD + * could be something we cannot rewind. */ + if ( errno == EAGAIN ) + { + if ( pollwait(cpinfo->out_fd, POLLOUT) < 0 ) + { + if ( errno == EINTR ) + continue; + rc = WRITE_POLL_FAILED; + goto fail; + } + continue; + } + rc = WRITE_FAILED; + goto fail; + } + bytes += ret; + bwritten += ret; + remaining -= ret; } - rc = READ_FAILED; - goto fail; - } - while (bwritten < bread) { - ssize_t ret; - - ret = write(cpinfo->out_fd, cpinfo->buffer + bwritten, bread - bwritten); - if (ret == 0) { - rc = WRITE_UNEXPECTED_EOF; - goto fail; - } - if (ret < 0) { - if (errno == EINTR) continue; - /* If someone passed us a non-blocking FD and we got - * EAGAIN, we need to keep trying, because the input FD - * could be something we cannot rewind. */ - if (errno == EAGAIN) { - if (pollwait(cpinfo->out_fd, POLLOUT) < 0) { - if (errno == EINTR) continue; - rc = WRITE_POLL_FAILED; - goto fail; - } - continue; - } - rc = WRITE_FAILED; - goto fail; - } - bytes += ret; - bwritten += ret; - remaining -= ret; } - } - rc = OK; + rc = OK; fail: - leave_blocking_section(); - /* Now that the OCaml runtime lock is reacquired, it is safe to - * raise OCaml exceptions */ + leave_blocking_section(); + /* Now that the OCaml runtime lock is reacquired, it is safe to + * raise OCaml exceptions */ - switch (rc) { + switch ( rc ) + { case TRIED_AND_FAILED: - caml_failwith("direct_copy: General error"); - break; + caml_failwith("direct_copy: General error"); + break; case WRITE_FAILED: - uerror("write", Nothing); - break; + uerror("write", Nothing); + break; case READ_FAILED: - uerror("read", Nothing); - break; + uerror("read", Nothing); + break; case WRITE_UNEXPECTED_EOF: - caml_failwith("direct_copy: Unexpected EOF on write"); - break; + caml_failwith("direct_copy: Unexpected EOF on write"); + break; case WRITE_POLL_FAILED: - uerror("write poll", Nothing); - break; + uerror("write poll", Nothing); + break; case READ_POLL_FAILED: - uerror("read poll", Nothing); - break; + uerror("read poll", Nothing); + break; case OK: - break; - } - result = caml_copy_int64(bytes); - CAMLreturn(result); + break; + } + result = caml_copy_int64(bytes); + CAMLreturn(result); } diff --git a/ocaml/xenopsd/c_stubs/sockopt_stubs.c b/ocaml/xenopsd/c_stubs/sockopt_stubs.c index 831eadc260f..a9e6befe6b9 100644 --- a/ocaml/xenopsd/c_stubs/sockopt_stubs.c +++ b/ocaml/xenopsd/c_stubs/sockopt_stubs.c @@ -11,61 +11,64 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. */ -#include -#include #include -#include #include -#include -#include -#include /* needed for _SC_OPEN_MAX */ +#include #include /* snprintf */ +#include #include +#include #include +#include +#include +#include /* needed for _SC_OPEN_MAX */ #if defined(__linux__) -# include +#include #endif -#include -#include #include -#include +#include #include #include -#include +#include +#include +#include #include #if defined(__linux__) -# define TCP_LEVEL SOL_TCP +#define TCP_LEVEL SOL_TCP #elif defined(__APPLE__) -# define TCP_LEVEL IPPROTO_TCP +#define TCP_LEVEL IPPROTO_TCP #else -# error "Don't know how to use setsockopt on this platform" +#error "Don't know how to use setsockopt on this platform" #endif -CAMLprim value stub_sockopt_set_sock_keepalives(value fd, value count, value idle, value interval) +CAMLprim value stub_sockopt_set_sock_keepalives(value fd, value count, + value idle, value interval) { CAMLparam4(fd, count, idle, interval); - int c_fd = Int_val(fd); - int optval; - socklen_t optlen=sizeof(optval); + int c_fd = Int_val(fd); + int optval; + socklen_t optlen = sizeof(optval); - optval = Int_val(count); - if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPCNT, &optval, optlen) < 0) { - uerror("setsockopt(TCP_KEEPCNT)", Nothing); - } + optval = Int_val(count); + if ( setsockopt(c_fd, TCP_LEVEL, TCP_KEEPCNT, &optval, optlen) < 0 ) + { + uerror("setsockopt(TCP_KEEPCNT)", Nothing); + } #if defined(__linux__) - optval = Int_val(idle); - if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPIDLE, &optval, optlen) < 0) { - uerror("setsockopt(TCP_KEEPIDLE)", Nothing); - } + optval = Int_val(idle); + if ( setsockopt(c_fd, TCP_LEVEL, TCP_KEEPIDLE, &optval, optlen) < 0 ) + { + uerror("setsockopt(TCP_KEEPIDLE)", Nothing); + } #endif - optval = Int_val(interval); - if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPINTVL, &optval, optlen) < 0) { - uerror("setsockopt(TCP_KEEPINTVL)", Nothing); - } + optval = Int_val(interval); + if ( setsockopt(c_fd, TCP_LEVEL, TCP_KEEPINTVL, &optval, optlen) < 0 ) + { + uerror("setsockopt(TCP_KEEPINTVL)", Nothing); + } - CAMLreturn(Val_unit); + CAMLreturn(Val_unit); } - diff --git a/ocaml/xenopsd/c_stubs/tuntap_stubs.c b/ocaml/xenopsd/c_stubs/tuntap_stubs.c index f5c4a97cd23..616c3b31650 100644 --- a/ocaml/xenopsd/c_stubs/tuntap_stubs.c +++ b/ocaml/xenopsd/c_stubs/tuntap_stubs.c @@ -5,19 +5,19 @@ * if more features are required. */ -#include -#include +#include +#include +#include #include +#include #include -#include -#include -#include +#include #include -#include -#include #include +#include #include +#include #include #define PATH_NET_TUN "/dev/net/tun" @@ -36,34 +36,38 @@ CAMLprim value stub_tap_open(value ocaml_ifname) memset(&ifr, 0, sizeof(ifr)); size_t len = strlen(ifname); - if (len == 0) { + if ( len == 0 ) + { caml_failwith("empty string argument in " __FILE__); } - if (len >= IFNAMSIZ) { - caml_failwith("string argument too long in "__FILE__); + if ( len >= IFNAMSIZ ) + { + caml_failwith("string argument too long in " __FILE__); } strncpy(ifr.ifr_name, ifname, IFNAMSIZ); path_net_tun = caml_copy_string(PATH_NET_TUN); int fd = open(PATH_NET_TUN, O_RDWR); - if (fd < 0) { + if ( fd < 0 ) + { uerror("open", path_net_tun); } - if (ioctl(fd, TUNGETFEATURES, &features) == -1) { + if ( ioctl(fd, TUNGETFEATURES, &features) == -1 ) + { int saved_errno = errno; close(fd); unix_error(saved_errno, "ioctl/TUNGETFEATURES", path_net_tun); } ifr.ifr_flags = IFF_TAP | IFF_NO_PI | (features & IFF_ONE_QUEUE); - if (ioctl(fd, TUNSETIFF, (void *) &ifr) != 0) { + if ( ioctl(fd, TUNSETIFF, (void *)&ifr) != 0 ) + { int saved_errno = errno; close(fd); - unix_error(saved_errno,"ioctl/TUNSETIFF", path_net_tun); + unix_error(saved_errno, "ioctl/TUNSETIFF", path_net_tun); } fcntl(fd, F_SETFL, O_NONBLOCK); CAMLreturn(Val_int(fd)); } - diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 868fbbf9c7f..58d2f418c83 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -24,15 +24,15 @@ #include -#include -#include #include +#include +#include #include #include +#include +#include #include -#include #include -#include #define _H(__h) (*((xc_interface **)Data_custom_val(__h))) #define _D(__d) ((uint32_t)Int_val(__d)) @@ -40,9 +40,9 @@ /* From xenctrl_stubs */ #define ERROR_STRLEN 1024 -#define Xtl_val(x)(*((struct xentoollog_logger **) Data_custom_val(x))) -#define Xfm_val(x)(*((struct xenforeignmemory_handle **) Data_abstract_val(x))) -#define Addr_val(x)(*((void **) Data_abstract_val(x))) +#define Xtl_val(x) (*((struct xentoollog_logger **)Data_custom_val(x))) +#define Xfm_val(x) (*((struct xenforeignmemory_handle **)Data_abstract_val(x))) +#define Addr_val(x) (*((void **)Data_abstract_val(x))) // Defined in OCaml 4.12: https://github.com/ocaml/ocaml/pull/9734 #if OCAML_VERSION < 41200 @@ -50,38 +50,39 @@ #define Is_some(v) Is_block(v) #endif -static void stub_xenctrlext_finalize(value v) -{ - xc_interface_close(_H(v)); -} +static void stub_xenctrlext_finalize(value v) { xc_interface_close(_H(v)); } static struct custom_operations xenctrlext_ops = { - .identifier = "xapi-project.xenctrlext", - .finalize = stub_xenctrlext_finalize, - .compare = custom_compare_default, /* Can't compare */ - .hash = custom_hash_default, /* Can't hash */ - .serialize = custom_serialize_default, /* Can't serialize */ - .deserialize = custom_deserialize_default, /* Can't deserialize */ - .compare_ext = custom_compare_ext_default, /* Can't compare */ + .identifier = "xapi-project.xenctrlext", + .finalize = stub_xenctrlext_finalize, + .compare = custom_compare_default, /* Can't compare */ + .hash = custom_hash_default, /* Can't hash */ + .serialize = custom_serialize_default, /* Can't serialize */ + .deserialize = custom_deserialize_default, /* Can't deserialize */ + .compare_ext = custom_compare_ext_default, /* Can't compare */ }; static void raise_unix_errno_msg(int err_code, const char *err_msg) { - CAMLparam0(); - value args[] = { unix_error_of_code(err_code), caml_copy_string(err_msg) }; + CAMLparam0(); + value args[] = { unix_error_of_code(err_code), caml_copy_string(err_msg) }; - caml_raise_with_args(*caml_named_value("Xenctrlext.Unix_error"), - sizeof(args)/sizeof(args[0]), args); - CAMLnoreturn; + caml_raise_with_args(*caml_named_value("Xenctrlext.Unix_error"), + sizeof(args) / sizeof(args[0]), args); + CAMLnoreturn; } static void failwith_xc(xc_interface *xch) { static char error_str[XC_MAX_ERROR_MSG_LEN + 6]; int real_errno = errno; - if (xch) { - snprintf(error_str, sizeof(error_str), "%d: %s", errno, strerror(errno)); - } else { + if ( xch ) + { + snprintf(error_str, sizeof(error_str), "%d: %s", errno, + strerror(errno)); + } + else + { snprintf(error_str, sizeof(error_str), "Unable to open XC interface"); } raise_unix_errno_msg(real_errno, error_str); @@ -89,201 +90,203 @@ static void failwith_xc(xc_interface *xch) CAMLprim value stub_xenctrlext_interface_open(void) { - CAMLparam0(); - CAMLlocal1(result); - xc_interface *xch; + CAMLparam0(); + CAMLlocal1(result); + xc_interface *xch; - caml_enter_blocking_section(); - xch = xc_interface_open(NULL, NULL, 0); - caml_leave_blocking_section(); + caml_enter_blocking_section(); + xch = xc_interface_open(NULL, NULL, 0); + caml_leave_blocking_section(); - if ( !xch ) - failwith_xc(xch); + if ( !xch ) + failwith_xc(xch); - result = caml_alloc_custom(&xenctrlext_ops, sizeof(xch), 0, 1); - _H(result) = xch; + result = caml_alloc_custom(&xenctrlext_ops, sizeof(xch), 0, 1); + _H(result) = xch; - CAMLreturn(result); + CAMLreturn(result); } CAMLprim value stub_xenctrlext_get_runstate_info(value xch, value domid) { - CAMLparam2(xch, domid); + CAMLparam2(xch, domid); #if defined(XENCTRL_HAS_GET_RUNSTATE_INFO) - CAMLlocal1(result); - xc_runstate_info_t info; - int retval; - - caml_enter_blocking_section(); - retval = xc_get_runstate_info(_H(xch), _D(domid), &info); - caml_leave_blocking_section(); - if (retval < 0) - failwith_xc(_H(xch)); - - /* Store - 0 : state (int32) - 1 : missed_changes (int32) - 2 : state_entry_time (int64) - 3-8 : times (int64s) - */ - result = caml_alloc_tuple(9); - Store_field(result, 0, caml_copy_int32(info.state)); - Store_field(result, 1, caml_copy_int32(info.missed_changes)); - Store_field(result, 2, caml_copy_int64(info.state_entry_time)); - Store_field(result, 3, caml_copy_int64(info.time[0])); - Store_field(result, 4, caml_copy_int64(info.time[1])); - Store_field(result, 5, caml_copy_int64(info.time[2])); - Store_field(result, 6, caml_copy_int64(info.time[3])); - Store_field(result, 7, caml_copy_int64(info.time[4])); - Store_field(result, 8, caml_copy_int64(info.time[5])); - - CAMLreturn(result); + CAMLlocal1(result); + xc_runstate_info_t info; + int retval; + + caml_enter_blocking_section(); + retval = xc_get_runstate_info(_H(xch), _D(domid), &info); + caml_leave_blocking_section(); + if ( retval < 0 ) + failwith_xc(_H(xch)); + + /* Store + 0 : state (int32) + 1 : missed_changes (int32) + 2 : state_entry_time (int64) + 3-8 : times (int64s) + */ + result = caml_alloc_tuple(9); + Store_field(result, 0, caml_copy_int32(info.state)); + Store_field(result, 1, caml_copy_int32(info.missed_changes)); + Store_field(result, 2, caml_copy_int64(info.state_entry_time)); + Store_field(result, 3, caml_copy_int64(info.time[0])); + Store_field(result, 4, caml_copy_int64(info.time[1])); + Store_field(result, 5, caml_copy_int64(info.time[2])); + Store_field(result, 6, caml_copy_int64(info.time[3])); + Store_field(result, 7, caml_copy_int64(info.time[4])); + Store_field(result, 8, caml_copy_int64(info.time[5])); + + CAMLreturn(result); #else - caml_failwith("XENCTRL_HAS_GET_RUNSTATE_INFO not defined"); + caml_failwith("XENCTRL_HAS_GET_RUNSTATE_INFO not defined"); #endif } CAMLprim value stub_xenctrlext_get_boot_cpufeatures(value xch) { - CAMLparam1(xch); + CAMLparam1(xch); #if defined(XENCTRL_HAS_GET_CPUFEATURES) - CAMLlocal1(v); - uint32_t a, b, c, d, e, f, g, h; - int ret; - - caml_enter_blocking_section(); - ret = xc_get_boot_cpufeatures(_H(xch), &a, &b, &c, &d, &e, &f, &g, &h); - caml_leave_blocking_section(); - if (ret < 0) - failwith_xc(_H(xch)); - - v = caml_alloc_tuple(8); - Store_field(v, 0, caml_copy_int32(a)); - Store_field(v, 1, caml_copy_int32(b)); - Store_field(v, 2, caml_copy_int32(c)); - Store_field(v, 3, caml_copy_int32(d)); - Store_field(v, 4, caml_copy_int32(e)); - Store_field(v, 5, caml_copy_int32(f)); - Store_field(v, 6, caml_copy_int32(g)); - Store_field(v, 7, caml_copy_int32(h)); - - CAMLreturn(v); + CAMLlocal1(v); + uint32_t a, b, c, d, e, f, g, h; + int ret; + + caml_enter_blocking_section(); + ret = xc_get_boot_cpufeatures(_H(xch), &a, &b, &c, &d, &e, &f, &g, &h); + caml_leave_blocking_section(); + if ( ret < 0 ) + failwith_xc(_H(xch)); + + v = caml_alloc_tuple(8); + Store_field(v, 0, caml_copy_int32(a)); + Store_field(v, 1, caml_copy_int32(b)); + Store_field(v, 2, caml_copy_int32(c)); + Store_field(v, 3, caml_copy_int32(d)); + Store_field(v, 4, caml_copy_int32(e)); + Store_field(v, 5, caml_copy_int32(f)); + Store_field(v, 6, caml_copy_int32(g)); + Store_field(v, 7, caml_copy_int32(h)); + + CAMLreturn(v); #else - caml_failwith("XENCTRL_HAS_GET_CPUFEATURES not defined"); + caml_failwith("XENCTRL_HAS_GET_CPUFEATURES not defined"); #endif } static int xcext_domain_send_s3resume(xc_interface *xch, unsigned int domid) { - return xc_set_hvm_param(xch, domid, HVM_PARAM_ACPI_S_STATE, 0); + return xc_set_hvm_param(xch, domid, HVM_PARAM_ACPI_S_STATE, 0); } -static int xcext_domain_set_timer_mode(xc_interface *xch, unsigned int domid, int mode) +static int xcext_domain_set_timer_mode(xc_interface *xch, unsigned int domid, + int mode) { - return xc_set_hvm_param(xch, domid, - HVM_PARAM_TIMER_MODE, (unsigned long) mode); + return xc_set_hvm_param(xch, domid, HVM_PARAM_TIMER_MODE, + (unsigned long)mode); } CAMLprim value stub_xenctrlext_domain_get_acpi_s_state(value xch, value domid) { - CAMLparam2(xch, domid); - unsigned long v; - int ret; + CAMLparam2(xch, domid); + unsigned long v; + int ret; - caml_enter_blocking_section(); - ret = xc_get_hvm_param(_H(xch), _D(domid), HVM_PARAM_ACPI_S_STATE, &v); - caml_leave_blocking_section(); - if (ret != 0) - failwith_xc(_H(xch)); + caml_enter_blocking_section(); + ret = xc_get_hvm_param(_H(xch), _D(domid), HVM_PARAM_ACPI_S_STATE, &v); + caml_leave_blocking_section(); + if ( ret != 0 ) + failwith_xc(_H(xch)); - CAMLreturn(Val_int(v)); + CAMLreturn(Val_int(v)); } CAMLprim value stub_xenctrlext_domain_send_s3resume(value xch, value domid) { - CAMLparam2(xch, domid); - caml_enter_blocking_section(); - xcext_domain_send_s3resume(_H(xch), _D(domid)); - caml_leave_blocking_section(); - CAMLreturn(Val_unit); + CAMLparam2(xch, domid); + caml_enter_blocking_section(); + xcext_domain_send_s3resume(_H(xch), _D(domid)); + caml_leave_blocking_section(); + CAMLreturn(Val_unit); } -CAMLprim value stub_xenctrlext_domain_set_timer_mode(value xch, value id, value mode) +CAMLprim value stub_xenctrlext_domain_set_timer_mode(value xch, value id, + value mode) { - CAMLparam3(xch, id, mode); - int ret; - - caml_enter_blocking_section(); - ret = xcext_domain_set_timer_mode(_H(xch), _D(id), Int_val(mode)); - caml_leave_blocking_section(); - if (ret < 0) - failwith_xc(_H(xch)); - CAMLreturn(Val_unit); + CAMLparam3(xch, id, mode); + int ret; + + caml_enter_blocking_section(); + ret = xcext_domain_set_timer_mode(_H(xch), _D(id), Int_val(mode)); + caml_leave_blocking_section(); + if ( ret < 0 ) + failwith_xc(_H(xch)); + CAMLreturn(Val_unit); } CAMLprim value stub_xenctrlext_get_max_nr_cpus(value xch) { - CAMLparam1(xch); - xc_physinfo_t c_physinfo; - int r; + CAMLparam1(xch); + xc_physinfo_t c_physinfo; + int r; - caml_enter_blocking_section(); - r = xc_physinfo(_H(xch), &c_physinfo); - caml_leave_blocking_section(); + caml_enter_blocking_section(); + r = xc_physinfo(_H(xch), &c_physinfo); + caml_leave_blocking_section(); - if (r) - failwith_xc(_H(xch)); + if ( r ) + failwith_xc(_H(xch)); - CAMLreturn(Val_int(c_physinfo.max_cpu_id + 1)); + CAMLreturn(Val_int(c_physinfo.max_cpu_id + 1)); } -CAMLprim value stub_xenctrlext_domain_set_target(value xch, - value domid, - value target) +CAMLprim value stub_xenctrlext_domain_set_target(value xch, value domid, + value target) { - CAMLparam3(xch, domid, target); - - caml_enter_blocking_section(); - int retval = xc_domain_set_target(_H(xch), _D(domid), _D(target)); - caml_leave_blocking_section(); - if (retval) - failwith_xc(_H(xch)); - CAMLreturn(Val_unit); + CAMLparam3(xch, domid, target); + + caml_enter_blocking_section(); + int retval = xc_domain_set_target(_H(xch), _D(domid), _D(target)); + caml_leave_blocking_section(); + if ( retval ) + failwith_xc(_H(xch)); + CAMLreturn(Val_unit); } -CAMLprim value stub_xenctrlext_physdev_map_pirq(value xch, - value domid, - value irq) +CAMLprim value stub_xenctrlext_physdev_map_pirq(value xch, value domid, + value irq) { CAMLparam3(xch, domid, irq); int pirq = Int_val(irq); caml_enter_blocking_section(); int retval = xc_physdev_map_pirq(_H(xch), _D(domid), pirq, &pirq); caml_leave_blocking_section(); - if (retval) + if ( retval ) failwith_xc(_H(xch)); CAMLreturn(Val_int(pirq)); } /* ocaml here would be int -> int */ CAMLprim value stub_xenctrlext_assign_device(value xch, value domid, - value machine_sbdf, value flag) + value machine_sbdf, value flag) { CAMLparam4(xch, domid, machine_sbdf, flag); caml_enter_blocking_section(); - int retval = xc_assign_device(_H(xch), _D(domid), Int_val(machine_sbdf), Int_val(flag)); + int retval = xc_assign_device(_H(xch), _D(domid), Int_val(machine_sbdf), + Int_val(flag)); caml_leave_blocking_section(); - if (retval) + if ( retval ) failwith_xc(_H(xch)); CAMLreturn(Val_unit); } -CAMLprim value stub_xenctrlext_deassign_device(value xch, value domid, value machine_sbdf) +CAMLprim value stub_xenctrlext_deassign_device(value xch, value domid, + value machine_sbdf) { CAMLparam3(xch, domid, machine_sbdf); caml_enter_blocking_section(); int retval = xc_deassign_device(_H(xch), _D(domid), Int_val(machine_sbdf)); caml_leave_blocking_section(); - if (retval) + if ( retval ) failwith_xc(_H(xch)); CAMLreturn(Val_unit); } @@ -300,21 +303,24 @@ CAMLprim value stub_xenctrlext_domain_soft_reset(value xch, value domid) caml_enter_blocking_section(); int retval = xc_domain_soft_reset(_H(xch), _D(domid)); caml_leave_blocking_section(); - if (retval) + if ( retval ) failwith_xc(_H(xch)); CAMLreturn(Val_unit); } CAMLprim value stub_xenctrlext_domain_update_channels(value xch, value domid, - value store_port, value console_port) + value store_port, + value console_port) { CAMLparam4(xch, domid, store_port, console_port); caml_enter_blocking_section(); - int retval = xc_set_hvm_param(_H(xch), _D(domid), HVM_PARAM_STORE_EVTCHN, Int_val(store_port)); - if (!retval) - retval = xc_set_hvm_param(_H(xch), _D(domid), HVM_PARAM_CONSOLE_EVTCHN, Int_val(console_port)); + int retval = xc_set_hvm_param(_H(xch), _D(domid), HVM_PARAM_STORE_EVTCHN, + Int_val(store_port)); + if ( !retval ) + retval = xc_set_hvm_param(_H(xch), _D(domid), HVM_PARAM_CONSOLE_EVTCHN, + Int_val(console_port)); caml_leave_blocking_section(); - if (retval) + if ( retval ) failwith_xc(_H(xch)); CAMLreturn(Val_unit); } @@ -322,286 +328,306 @@ CAMLprim value stub_xenctrlext_domain_update_channels(value xch, value domid, /* based on xenctrl_stubs.c */ static int get_cpumap_len(value xch, value cpumap) { - int ml_len = Wosize_val(cpumap); - caml_enter_blocking_section(); - int xc_len = xc_get_max_cpus(_H(xch)); - caml_leave_blocking_section(); + int ml_len = Wosize_val(cpumap); + caml_enter_blocking_section(); + int xc_len = xc_get_max_cpus(_H(xch)); + caml_leave_blocking_section(); - return (ml_len < xc_len ? ml_len : xc_len); + return (ml_len < xc_len ? ml_len : xc_len); } CAMLprim value stub_xenctrlext_vcpu_setaffinity_soft(value xch, value domid, value vcpu, value cpumap) { - CAMLparam4(xch, domid, vcpu, cpumap); - int i, len = get_cpumap_len(xch, cpumap); - xc_cpumap_t c_cpumap; - int retval; - - caml_enter_blocking_section(); - c_cpumap = xc_cpumap_alloc(_H(xch)); - caml_leave_blocking_section(); - if (c_cpumap == NULL) - failwith_xc(_H(xch)); - - for (i=0; idim[0] / 4096; - - caml_enter_blocking_section(); - retval = xenforeignmemory_unmap(handle, data, pages); - caml_leave_blocking_section(); - the_errno = errno; - - if(retval < 0) { - raise_unix_errno_msg(the_errno, - "Error when trying to unmap foreign memory"); - } + CAMLparam2(fmem, mapping); + size_t pages; + int retval, the_errno; + struct xenforeignmemory_handle *handle = Xfm_val(fmem); + void *data = Caml_ba_data_val(mapping); - CAMLreturn(Val_unit); + // convert mapping to pages and addr + pages = Caml_ba_array_val(mapping)->dim[0] / 4096; + + caml_enter_blocking_section(); + retval = xenforeignmemory_unmap(handle, data, pages); + caml_leave_blocking_section(); + the_errno = errno; + + if ( retval < 0 ) + { + raise_unix_errno_msg(the_errno, + "Error when trying to unmap foreign memory"); + } + + CAMLreturn(Val_unit); } /* -* Local variables: -* indent-tabs-mode: t -*/ + * Local variables: + * indent-tabs-mode: t + */ diff --git a/unixpwd/c/main.c b/unixpwd/c/main.c index ac61fe22085..6559570e0f8 100644 --- a/unixpwd/c/main.c +++ b/unixpwd/c/main.c @@ -14,41 +14,48 @@ #include #include +#include #include #include #include -#include #include "unixpwd.h" -int -main(int argc, char **argv) +int main(int argc, char **argv) { - int rc; - char *pwd; - char *buf; - char *msg; - int i; + int rc; + char *pwd; + char *buf; + char *msg; + int i; mtrace(); - switch (argc) { + switch ( argc ) + { case 1: - for (i = 0; i < 100; i++) { + for ( i = 0; i < 100; i++ ) + { buf = unixpwd_unshadow(); msg = strerror(errno); - if (buf) { + if ( buf ) + { free(buf); - } else { + } + else + { fprintf(stderr, "can't unshadow: %s\n", msg); break; } } buf = unixpwd_unshadow(); msg = strerror(errno); - if (buf) { + if ( buf ) + { puts(buf); free(buf); - } else { + } + else + { fprintf(stderr, "can't unshadow: %s\n", msg); break; } @@ -57,36 +64,45 @@ main(int argc, char **argv) case 2: pwd = unixpwd_get(argv[1]); msg = strerror(errno); - if (pwd) { + if ( pwd ) + { printf("%s: %s\n", argv[1], pwd); free(pwd); rc = 0; - } else { + } + else + { fprintf(stderr, "can't find entry for %s: %s\n", argv[1], msg); rc = 1; } pwd = unixpwd_getpwd(argv[1]); msg = strerror(errno); - if (pwd) { + if ( pwd ) + { printf("/etc/passwd: %s: %s\n", argv[1], pwd); free(pwd); rc = 0; - } else { - fprintf(stderr, "can't find passwd entry for %s: %s\n", - argv[1], msg); + } + else + { + fprintf(stderr, "can't find passwd entry for %s: %s\n", argv[1], + msg); rc = 1; } pwd = unixpwd_getspw(argv[1]); msg = strerror(errno); - if (pwd) { + if ( pwd ) + { printf("/etc/shadow: %s: %s\n", argv[1], pwd); free(pwd); rc = 0; - } else { - fprintf(stderr, "can't find shadow entry for %s: %s\n", - argv[1], msg); + } + else + { + fprintf(stderr, "can't find shadow entry for %s: %s\n", argv[1], + msg); rc = 1; } @@ -95,14 +111,16 @@ main(int argc, char **argv) case 3: rc = unixpwd_setpwd(argv[1], argv[2]); msg = strerror(errno); - if (rc != 0) { + if ( rc != 0 ) + { fprintf(stderr, "error setting password: %s\n", msg); rc = 1; break; } rc = unixpwd_setspw(argv[1], argv[2]); msg = strerror(errno); - if (rc != 0) { + if ( rc != 0 ) + { fprintf(stderr, "error setting shadow password: %s\n", msg); rc = 1; break; diff --git a/unixpwd/c/unixpwd.c b/unixpwd/c/unixpwd.c index 91d943f30bb..1b3aa81d472 100644 --- a/unixpwd/c/unixpwd.c +++ b/unixpwd/c/unixpwd.c @@ -13,6 +13,7 @@ */ #include +#include #include #include #include @@ -22,95 +23,89 @@ #include #include #include -#include #ifdef DEVELOPMENT -#define ETC_PASSWD "passwd" -#define TMP_PASSWD "passwd.XXXXXX" -#define ETC_SPASSWD "shadow" -#define TMP_SPASSWD "shadow.XXXXXX" +#define ETC_PASSWD "passwd" +#define TMP_PASSWD "passwd.XXXXXX" +#define ETC_SPASSWD "shadow" +#define TMP_SPASSWD "shadow.XXXXXX" #else -#define ETC_PASSWD "/etc/passwd" -#define TMP_PASSWD "/etc/passwd.XXXXXX" -#define ETC_SPASSWD "/etc/shadow" -#define TMP_SPASSWD "/etc/shadow.XXXXXX" +#define ETC_PASSWD "/etc/passwd" +#define TMP_PASSWD "/etc/passwd.XXXXXX" +#define ETC_SPASSWD "/etc/shadow" +#define TMP_SPASSWD "/etc/shadow.XXXXXX" #endif #define BUFLEN 4096 -char * -unixpwd_getpwd(const char *user) +char *unixpwd_getpwd(const char *user) { - struct passwd pwd, - *pw; - char buf[BUFLEN]; + struct passwd pwd, *pw; + char buf[BUFLEN]; errno = 0; - if (getpwnam_r(user, &pwd, buf, BUFLEN, &pw) == 0 && pw) + if ( getpwnam_r(user, &pwd, buf, BUFLEN, &pw) == 0 && pw ) return strdup(pw->pw_passwd); - if (errno == 0) + if ( errno == 0 ) errno = EINVAL; return NULL; } -char * -unixpwd_getspw(const char *user) +char *unixpwd_getspw(const char *user) { - struct spwd spw, - *sp; - char buf[BUFLEN]; + struct spwd spw, *sp; + char buf[BUFLEN]; errno = 0; - if (getspnam_r(user, &spw, buf, BUFLEN, &sp) == 0 && sp) + if ( getspnam_r(user, &spw, buf, BUFLEN, &sp) == 0 && sp ) return strdup(sp->sp_pwdp); - if (errno == 0) + if ( errno == 0 ) errno = EINVAL; return NULL; } - -char * -unixpwd_get(const char *user) +char *unixpwd_get(const char *user) { - char *spw; + char *spw; spw = unixpwd_getspw(user); return (spw ? spw : unixpwd_getpwd(user)); } -int -unixpwd_setpwd(const char *user, char *password) +int unixpwd_setpwd(const char *user, char *password) { - struct passwd pwd, - *pw; - char buf[BUFLEN]; - int tmp; - FILE *tmp_file; - char tmp_name[PATH_MAX]; - struct stat statbuf; - int rc; - int updated = 0; + struct passwd pwd, *pw; + char buf[BUFLEN]; + int tmp; + FILE *tmp_file; + char tmp_name[PATH_MAX]; + struct stat statbuf; + int rc; + int updated = 0; strncpy(tmp_name, TMP_PASSWD, sizeof tmp_name); tmp = mkstemp(tmp_name); - if (tmp == -1) + if ( tmp == -1 ) return errno; - if (stat(ETC_PASSWD, &statbuf) != 0 - || fchown(tmp, statbuf.st_uid, statbuf.st_gid) != 0 - || fchmod(tmp, statbuf.st_mode) != 0 - || (tmp_file = fdopen(tmp, "w")) == NULL) { + if ( stat(ETC_PASSWD, &statbuf) != 0 + || fchown(tmp, statbuf.st_uid, statbuf.st_gid) != 0 + || fchmod(tmp, statbuf.st_mode) != 0 + || (tmp_file = fdopen(tmp, "w")) == NULL ) + { rc = errno ? errno : EPERM; close(tmp); return rc; } setpwent(); - while (1) { + while ( 1 ) + { rc = getpwent_r(&pwd, buf, BUFLEN, &pw); - if (rc != 0 || !pw) + if ( rc != 0 || !pw ) break; - if (!strcmp(user, pw->pw_name)) { + if ( !strcmp(user, pw->pw_name) ) + { pw->pw_passwd = password; updated++; } @@ -119,15 +114,18 @@ unixpwd_setpwd(const char *user, char *password) endpwent(); fclose(tmp_file); - if (rc != ENOENT) { + if ( rc != ENOENT ) + { unlink(tmp_name); return rc; } - if (!updated) { + if ( !updated ) + { unlink(tmp_name); return EINVAL; } - if (rename(tmp_name, ETC_PASSWD) != 0) { + if ( rename(tmp_name, ETC_PASSWD) != 0 ) + { rc = errno; unlink(tmp_name); return rc; @@ -135,46 +133,47 @@ unixpwd_setpwd(const char *user, char *password) return 0; } - -int -unixpwd_setspw(const char *user, char *password) +int unixpwd_setspw(const char *user, char *password) { - struct spwd spw, - *sp; - char buf[BUFLEN]; - int tmp; - FILE *tmp_file; - char tmp_name[PATH_MAX]; - struct stat statbuf; - int rc; - int updated = 0; + struct spwd spw, *sp; + char buf[BUFLEN]; + int tmp; + FILE *tmp_file; + char tmp_name[PATH_MAX]; + struct stat statbuf; + int rc; + int updated = 0; strncpy(tmp_name, TMP_SPASSWD, sizeof tmp_name); tmp = mkstemp(tmp_name); - if (tmp == -1) + if ( tmp == -1 ) return errno; - if (stat(ETC_SPASSWD, &statbuf) != 0 - || fchown(tmp, statbuf.st_uid, statbuf.st_gid) != 0 - || fchmod(tmp, statbuf.st_mode) != 0 - || (tmp_file = fdopen(tmp, "w")) == NULL) { + if ( stat(ETC_SPASSWD, &statbuf) != 0 + || fchown(tmp, statbuf.st_uid, statbuf.st_gid) != 0 + || fchmod(tmp, statbuf.st_mode) != 0 + || (tmp_file = fdopen(tmp, "w")) == NULL ) + { rc = errno ? errno : EPERM; close(tmp); unlink(tmp_name); return rc; } - if (lckpwdf() != 0) { + if ( lckpwdf() != 0 ) + { close(tmp); unlink(tmp_name); return ENOLCK; } setspent(); - while (1) { + while ( 1 ) + { rc = getspent_r(&spw, buf, BUFLEN, &sp); - if (rc != 0 || !sp) + if ( rc != 0 || !sp ) break; - if (!strcmp(user, sp->sp_namp)) { + if ( !strcmp(user, sp->sp_namp) ) + { sp->sp_pwdp = password; updated++; } @@ -183,17 +182,20 @@ unixpwd_setspw(const char *user, char *password) endspent(); fclose(tmp_file); - if (rc != ENOENT) { + if ( rc != ENOENT ) + { ulckpwdf(); unlink(tmp_name); return rc; } - if (!updated) { + if ( !updated ) + { ulckpwdf(); unlink(tmp_name); return EINVAL; } - if (rename(tmp_name, ETC_SPASSWD) != 0) { + if ( rename(tmp_name, ETC_SPASSWD) != 0 ) + { rc = errno; ulckpwdf(); unlink(tmp_name); @@ -203,51 +205,49 @@ unixpwd_setspw(const char *user, char *password) return 0; } -char * -unixpwd_unshadow(void) +char *unixpwd_unshadow(void) { - struct spwd spw, - *sp; - struct passwd pwd, - *pw; - char pwbuf[BUFLEN]; - char spbuf[BUFLEN]; + struct spwd spw, *sp; + struct passwd pwd, *pw; + char pwbuf[BUFLEN]; + char spbuf[BUFLEN]; - char *buf; - int size, - cur; + char *buf; + int size, cur; size = 1024; cur = 0; buf = malloc(size); - if (!buf) { + if ( !buf ) + { return NULL; } setpwent(); - while (1) { - char tmp[BUFLEN]; - int written; + while ( 1 ) + { + char tmp[BUFLEN]; + int written; - if (getpwent_r(&pwd, pwbuf, BUFLEN, &pw) != 0 || !pw) + if ( getpwent_r(&pwd, pwbuf, BUFLEN, &pw) != 0 || !pw ) break; getspnam_r(pw->pw_name, &spw, spbuf, BUFLEN, &sp); - written = snprintf(tmp, BUFLEN, "%s:%s:%d:%d:%s:%s:%s\n", - pw->pw_name, - sp ? sp->sp_pwdp : pw->pw_passwd, - pw->pw_uid, - pw->pw_gid, - pw->pw_gecos, pw->pw_dir, pw->pw_shell); - if (written >= BUFLEN) { + written = snprintf(tmp, BUFLEN, "%s:%s:%d:%d:%s:%s:%s\n", pw->pw_name, + sp ? sp->sp_pwdp : pw->pw_passwd, pw->pw_uid, + pw->pw_gid, pw->pw_gecos, pw->pw_dir, pw->pw_shell); + if ( written >= BUFLEN ) + { endpwent(); free(buf); return NULL; } - while (cur + written > size) { + while ( cur + written > size ) + { size = size << 1; buf = realloc(buf, size); - if (!buf) { + if ( !buf ) + { endpwent(); return NULL; } diff --git a/unixpwd/c/unixpwd.h b/unixpwd/c/unixpwd.h index 46394bc6ce8..db6ce0e328f 100644 --- a/unixpwd/c/unixpwd.h +++ b/unixpwd/c/unixpwd.h @@ -20,16 +20,16 @@ * and unixpwd_getspw() obtains the password from /etc/shadow. */ -char *unixpwd_get(const char *user); -char *unixpwd_getpwd(const char *user); -char *unixpwd_getspw(const char *user); +char *unixpwd_get(const char *user); +char *unixpwd_getpwd(const char *user); +char *unixpwd_getspw(const char *user); /* * return /etc/passwd as a string but with entries from shadow passwords * when they exist. The returned string must be passed to free(). On * error, returns NULL and errno set. */ -char *unixpwd_unshadow(void); +char *unixpwd_unshadow(void); /* * update password for user in /etc/passwd and /etc/shadow respectively @@ -38,5 +38,5 @@ char *unixpwd_unshadow(void); * unixpwd_setspw */ -int unixpwd_setpwd(const char *user, char *password); -int unixpwd_setspw(const char *user, char *password); +int unixpwd_setpwd(const char *user, char *password); +int unixpwd_setspw(const char *user, char *password); diff --git a/unixpwd/c/unixpwd_stubs.c b/unixpwd/c/unixpwd_stubs.c index 69de7894faa..7b2bdd6cb72 100644 --- a/unixpwd/c/unixpwd_stubs.c +++ b/unixpwd/c/unixpwd_stubs.c @@ -16,21 +16,22 @@ #include #include -#include -#include #include +#include #include +#include #include #include #include "unixpwd.h" -static CAMLprim value caml_unixpwd_get_(value caml_user, const char *fname, char*(*f)(const char*)) +static CAMLprim value caml_unixpwd_get_(value caml_user, const char *fname, + char *(*f)(const char *)) { CAMLparam1(caml_user); - char *user; - char *passwd; - int saved_errno; + char *user; + char *passwd; + int saved_errno; CAMLlocal1(pw); user = caml_stat_strdup(String_val(caml_user)); @@ -38,11 +39,12 @@ static CAMLprim value caml_unixpwd_get_(value caml_user, const char *fname, char errno = 0; passwd = f(user); saved_errno = errno; - caml_stat_free(user); user = NULL; + caml_stat_free(user); + user = NULL; caml_leave_blocking_section(); errno = saved_errno; - if (passwd == NULL) /* errno of 0 will be mapped to `EUNKNOWNERR of 0` */ + if ( passwd == NULL ) /* errno of 0 will be mapped to `EUNKNOWNERR of 0` */ uerror(fname, caml_user); pw = caml_copy_string(passwd); @@ -50,31 +52,30 @@ static CAMLprim value caml_unixpwd_get_(value caml_user, const char *fname, char CAMLreturn(pw); } -CAMLprim value -caml_unixpwd_getpwd(value caml_user) +CAMLprim value caml_unixpwd_getpwd(value caml_user) { return caml_unixpwd_get_(caml_user, "unixpwd_getpwd", unixpwd_getpwd); } -CAMLprim value -caml_unixpwd_getspw(value caml_user) +CAMLprim value caml_unixpwd_getspw(value caml_user) { return caml_unixpwd_get_(caml_user, "unixpwd_getspw", unixpwd_getspw); } -CAMLprim value -caml_unixpwd_get(value caml_user) +CAMLprim value caml_unixpwd_get(value caml_user) { return caml_unixpwd_get_(caml_user, "unixpwd_get", unixpwd_get); } -static CAMLprim value caml_unixpwd_set_(value caml_user, value caml_password, const char *fname, int(*f)(const char*, char*)) +static CAMLprim value caml_unixpwd_set_(value caml_user, value caml_password, + const char *fname, + int (*f)(const char *, char *)) { CAMLparam2(caml_user, caml_password); - char *user; - char *password; - int saved_errno; - int rc; + char *user; + char *password; + int saved_errno; + int rc; user = caml_stat_strdup(String_val(caml_user)); password = caml_stat_strdup(String_val(caml_password)); @@ -87,36 +88,33 @@ static CAMLprim value caml_unixpwd_set_(value caml_user, value caml_password, co caml_leave_blocking_section(); errno = saved_errno; - if (rc != 0) + if ( rc != 0 ) uerror(fname, caml_user); /* only raise with user not pass */ CAMLreturn(Val_unit); } -CAMLprim value -caml_unixpwd_setpwd(value caml_user, value caml_password) +CAMLprim value caml_unixpwd_setpwd(value caml_user, value caml_password) { return caml_unixpwd_set_(caml_user, caml_password, "unix_setpwd", - unixpwd_setpwd); + unixpwd_setpwd); } -CAMLprim value -caml_unixpwd_setspw(value caml_user, value caml_password) +CAMLprim value caml_unixpwd_setspw(value caml_user, value caml_password) { return caml_unixpwd_set_(caml_user, caml_password, "unix_setpwd", - unixpwd_setspw); + unixpwd_setspw); } -CAMLprim value -caml_unixpwd_unshadow(void) +CAMLprim value caml_unixpwd_unshadow(void) { CAMLparam0(); - char *passwords; + char *passwords; CAMLlocal1(str); /* NOT thread safe, retain runtime lock for now, it uses setpwent/endpwent, * this should be replaced by fopen/fpwgetent_r/etc. */ passwords = unixpwd_unshadow(); - if (passwords == NULL) + if ( passwords == NULL ) uerror("unixpwd_unshadow", Nothing); str = caml_copy_string(passwords); From 10ff86edf3693602a48ad7e714ae6b706b55f5f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 8 Dec 2022 17:47:01 +0000 Subject: [PATCH 22/75] dbgring: switch from Xenmmap to Gnt + Io_page MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Xenmmap.read is being removed from Xen, use upstream mirage libs to access this instead. Signed-off-by: Edwin Török --- ocaml/xenopsd/dbgring/dbgring.ml | 34 +++++++++++++++++--------------- ocaml/xenopsd/dbgring/dune | 16 +++------------ 2 files changed, 21 insertions(+), 29 deletions(-) diff --git a/ocaml/xenopsd/dbgring/dbgring.ml b/ocaml/xenopsd/dbgring/dbgring.ml index 327463e3933..c037f654cec 100644 --- a/ocaml/xenopsd/dbgring/dbgring.ml +++ b/ocaml/xenopsd/dbgring/dbgring.ml @@ -11,27 +11,30 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) -open Xenops_utils let xenstored_proc_port = "/proc/xen/xsd_port" let xenstored_proc_kva = "/proc/xen/xsd_kva" +let gnttab = Gnt.Gnttab.interface_open () + let open_ring0 () = let fd = Unix.openfile xenstored_proc_kva [Unix.O_RDWR] 0o600 in - let sz = Xenmmap.getpagesize () in - let intf = Xenmmap.mmap fd Xenmmap.RDWR Xenmmap.SHARED sz 0 in - Unix.close fd ; intf + let sz = Io_page.page_size in + let intf = Unix.map_file fd Bigarray.char Bigarray.c_layout true [|sz|] + in + Unix.close fd ;Bigarray.reshape_1 intf sz |> Cstruct.of_bigarray -let open_ringU domid mfn = - Xenctrl.with_intf @@ fun xc -> - Xenctrl.map_foreign_range xc domid (Xenmmap.getpagesize ()) mfn +let open_ringU domid = + let mapping = Gnt.(Gnttab.map_exn gnttab { domid; ref = xenstore } true) in + mapping |> Gnt.Gnttab.Local_mapping.to_buf |> Io_page.to_cstruct -let open_ring domid mfn = + +let open_ring domid = if domid = 0 then open_ring0 () else - open_ringU domid mfn + open_ringU domid let hexify s = let hexseq_of_char c = Printf.sprintf "%02x" (Char.code c) in @@ -73,14 +76,13 @@ let int_from_page ss n = int_of_string ("0x" ^ b2 ^ b1) mod ring_size let _ = - let domid, mfn = - try (int_of_string Sys.argv.(1), Nativeint.of_string Sys.argv.(2)) - with _ -> (0, Nativeint.zero) - in - let sz = Xenmmap.getpagesize () - 1024 - 512 in - let intf = open_ring domid mfn in - let s = Xenmmap.read intf 0 sz in + let domid = try int_of_string Sys.argv.(1) with _ -> 0 in + let sz = Io_page.page_size - 1024 - 512 in + let intf = open_ring domid in + let s = Cstruct.copy intf 0 sz in let ss = hexify s in +(* TODO: this should use mirage/shared-memory-ring to read the various fields + from the ring instead of reimplementing the fetching here *) let req_cons = int_from_page ss (4 * ring_size) in let req_prod = int_from_page ss (8 + (4 * ring_size)) in let rsp_cons = ring_size + int_from_page ss (16 + (4 * ring_size)) in diff --git a/ocaml/xenopsd/dbgring/dune b/ocaml/xenopsd/dbgring/dune index 7fa6db8c16d..74af0e00de9 100644 --- a/ocaml/xenopsd/dbgring/dune +++ b/ocaml/xenopsd/dbgring/dune @@ -4,18 +4,8 @@ (package xapi-xenopsd-xc) (libraries dune-build-info - xapi-xenopsd - xenctrl - xenstore - xenstore.unix - xenstore_transport - xenstore_transport.unix - threads - xapi-idl.xen - rpclib.core - uutf - xapi-log - rpclib.json - xapi-stdext-pervasives + io-page-unix + xen-gnt + xen-gnt-unix ) ) From f6eceeb7ded9cd61faea09fdba21ce5a01465a5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 22 Nov 2022 15:22:33 +0000 Subject: [PATCH 23/75] xe-toolstack-restart: stop and start all services at once MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Starting all services at once is what happens on boot, so this should work. We currently stop services one at a time, and if they get stuck (e.g. due to waiting on a network filesystem that is stuck) then each has to hit the 1m30s timeout in systemd before they get killed, which is a minimum of ~32m before the toolstack is stopped. Which is a lot higher than the default 2 minute HA timeout, and even if the XAPI watcher would attempt recovery by restarting XAPI (or the toolstack), it would be stuck waiting for this 30m process to complete first. Stop all services at once and then start all needed ones at once. (Don't attempt to restart all in a single command since that might result in some services restarting and immediately seeing another service being restarted, interrupting communication and potentially leading to errors). Systemd can then use existing service dependencies to order the restarts. Signed-off-by: Edwin Török --- scripts/xe-toolstack-restart | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/scripts/xe-toolstack-restart b/scripts/xe-toolstack-restart index e49c6c246f1..5564e954c75 100755 --- a/scripts/xe-toolstack-restart +++ b/scripts/xe-toolstack-restart @@ -49,15 +49,13 @@ for svc in $SERVICES ; do if [ $? -eq 0 ] ; then TO_RESTART="$svc $TO_RESTART" - systemctl stop $svc fi done +systemctl stop ${TO_RESTART} set -e -for svc in $TO_RESTART ; do - systemctl start $svc -done +systemctl start ${TO_RESTART} rm -f $LOCKFILE echo "done." From 03788e3ad62622cf49d941fac0165af86a23f0b8 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 20 Sep 2022 19:46:51 +0100 Subject: [PATCH 24/75] schematest: add better instructions Signed-off-by: Pau Ruiz Safont --- ocaml/idl/schematest.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 7bc577a1f19..32111117c03 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -1,8 +1,10 @@ let hash x = Digest.string x |> Digest.to_hex -(* BEWARE: if this changes, check that schema has been bumped accordingly *) +(* BEWARE: if this changes, check that schema has been bumped accordingly in + ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) let last_known_schema_hash = "91175adc3dd18f9a75cde195ca76148e" + let current_schema_hash : string = let open Datamodel_types in let hash_of_obj x = From a51711a96860b29b4d07f2d69be4a608b9e1e923 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Mon, 12 Aug 2019 16:37:33 +0000 Subject: [PATCH 25/75] WIP: PVH Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_vm.ml | 1 + ocaml/idl/schematest.ml | 2 +- ocaml/tests/test_cpuid_helpers.ml | 1 + ocaml/xapi-cli-server/record_util.ml | 4 + ocaml/xapi-idl/xen/xenops_types.ml | 7 +- ocaml/xapi/cpuid_helpers.ml | 4 +- ocaml/xapi/helpers.ml | 13 +-- ocaml/xapi/memory_check.ml | 4 +- ocaml/xapi/vm_platform.ml | 2 +- ocaml/xapi/xapi_ha_vm_failover.ml | 2 +- ocaml/xapi/xapi_vif_helpers.ml | 2 +- ocaml/xapi/xapi_vm_helpers.ml | 6 +- ocaml/xapi/xapi_vm_lifecycle.ml | 2 +- ocaml/xapi/xapi_xenops.ml | 8 +- ocaml/xenopsd/cli/xn.ml | 2 +- ocaml/xenopsd/lib/xenops_server.ml | 20 ++++- ocaml/xenopsd/lib/xenopsd.ml | 7 ++ ocaml/xenopsd/test/test.ml | 6 +- ocaml/xenopsd/xc/xenops_server_xen.ml | 115 ++++++++++++++++++++------ 19 files changed, 159 insertions(+), 49 deletions(-) diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index f7fd08435f1..422bdc54edb 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -1631,6 +1631,7 @@ let domain_type = ("hvm", "HVM; Fully Virtualised") ; ("pv", "PV: Paravirtualised") ; ("pv_in_pvh", "PV inside a PVH container") + ; ("pvh", "PVH") ; ("unspecified", "Not specified or unknown domain type") ] ) diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 32111117c03..150f8b6ac08 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -2,7 +2,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "91175adc3dd18f9a75cde195ca76148e" +let last_known_schema_hash = "576e32b8e4e0aabaa3597682102c6d49" let current_schema_hash : string = diff --git a/ocaml/tests/test_cpuid_helpers.ml b/ocaml/tests/test_cpuid_helpers.ml index 6a7f3084b9d..3b78aea11bb 100644 --- a/ocaml/tests/test_cpuid_helpers.ml +++ b/ocaml/tests/test_cpuid_helpers.ml @@ -506,6 +506,7 @@ module NextBootCPUFeatures = Generic.MakeStateful (struct ([("a", `hvm)], [features_hvm]) ; ([("a", `pv)], [features_pv]) ; ([("a", `pv_in_pvh)], [features_hvm]) + ; ([("a", `pvh)], [features_hvm]) ; ( [("a", `hvm); ("b", `pv); ("c", `pv_in_pvh)] , [features_hvm; features_pv; features_hvm] ) diff --git a/ocaml/xapi-cli-server/record_util.ml b/ocaml/xapi-cli-server/record_util.ml index aca94e6120a..d58fce41d57 100644 --- a/ocaml/xapi-cli-server/record_util.ml +++ b/ocaml/xapi-cli-server/record_util.ml @@ -956,6 +956,8 @@ let domain_type_to_string = function "pv" | `pv_in_pvh -> "pv-in-pvh" + | `pvh -> + "pvh" | `unspecified -> "unspecified" @@ -967,6 +969,8 @@ let domain_type_of_string x = `pv | "pv-in-pvh" -> `pv_in_pvh + | "pvh" -> + `pvh | s -> raise (Record_failure ("Invalid domain type. Got " ^ s)) diff --git a/ocaml/xapi-idl/xen/xenops_types.ml b/ocaml/xapi-idl/xen/xenops_types.ml index 765181f2023..40f19f72fcb 100644 --- a/ocaml/xapi-idl/xen/xenops_types.ml +++ b/ocaml/xapi-idl/xen/xenops_types.ml @@ -129,7 +129,11 @@ module Vm = struct } [@@deriving rpcty, sexp] - type builder_info = HVM of hvm_info | PV of pv_info | PVinPVH of pv_info + type builder_info = + | HVM of hvm_info + | PV of pv_info + | PVinPVH of pv_info + | PVH of pv_info [@@deriving rpcty, sexp] type id = string [@@deriving rpcty, sexp] @@ -177,6 +181,7 @@ module Vm = struct | Domain_HVM | Domain_PV | Domain_PVinPVH + | Domain_PVH | Domain_undefined [@@deriving rpcty, sexp] diff --git a/ocaml/xapi/cpuid_helpers.ml b/ocaml/xapi/cpuid_helpers.ml index 3b4595b625f..3683e416188 100644 --- a/ocaml/xapi/cpuid_helpers.ml +++ b/ocaml/xapi/cpuid_helpers.ml @@ -111,7 +111,7 @@ let vendor = Map_check.(field "vendor" string) let get_flags_for_vm ~__context vm cpu_info = let features_field, features_field_boot = match Helpers.domain_type ~__context ~self:vm with - | `hvm | `pv_in_pvh -> + | `hvm | `pv_in_pvh | `pvh -> (features_hvm, features_hvm_host) | `pv -> (features_pv, features_pv_host) @@ -156,7 +156,7 @@ let next_boot_cpu_features ~__context ~vm = Db.VM.get_domain_type ~__context ~self:vm |> Helpers.check_domain_type in match domain_type with - | `hvm | `pv_in_pvh -> + | `hvm | `pv_in_pvh | `pvh -> (features_hvm, features_hvm_host) | `pv -> (features_pv, features_pv_host) diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index a5fdd042ca7..5e4827e8e0c 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -658,18 +658,21 @@ let rolling_upgrade_in_progress ~__context = (Db.Pool.get_other_config ~__context ~self:pool) with _ -> false -let check_domain_type : API.domain_type -> [`hvm | `pv_in_pvh | `pv] = function +let check_domain_type : API.domain_type -> [`hvm | `pv_in_pvh | `pv | `pvh] = + function | `hvm -> `hvm | `pv_in_pvh -> `pv_in_pvh | `pv -> `pv + | `pvh -> + `pvh | `unspecified -> raise Api_errors.(Server_error (internal_error, ["unspecified domain type"])) -let domain_type ~__context ~self : [`hvm | `pv_in_pvh | `pv] = +let domain_type ~__context ~self : [`hvm | `pv_in_pvh | `pv | `pvh] = let vm = Db.VM.get_record ~__context ~self in match vm.API.vM_power_state with | `Paused | `Running | `Suspended -> @@ -719,15 +722,15 @@ let boot_method_of_vm ~__context ~vm = match (check_domain_type vm.API.vM_domain_type, direct_boot) with | `hvm, _ -> Hvmloader (hvmloader_options ()) - | `pv, true | `pv_in_pvh, true -> + | `pv, true | `pv_in_pvh, true | `pvh, true -> Direct (direct_options ()) - | `pv, false | `pv_in_pvh, false -> + | `pv, false | `pv_in_pvh, false | `pvh, false -> Indirect (indirect_options ()) let needs_qemu_from_domain_type = function | `hvm -> true - | `pv_in_pvh | `pv | `unspecified -> + | `pv_in_pvh | `pv | `pvh | `unspecified -> false let will_have_qemu_from_record (x : API.vM_t) = diff --git a/ocaml/xapi/memory_check.ml b/ocaml/xapi/memory_check.ml index c9b3925e7ff..3658fca5a7d 100644 --- a/ocaml/xapi/memory_check.ml +++ b/ocaml/xapi/memory_check.ml @@ -33,6 +33,8 @@ let vm_compute_required_memory vm_record guest_memory_kib = (vm_record.API.vM_HVM_shadow_multiplier, Memory.HVM.full_config) | `pv_in_pvh -> (vm_record.API.vM_HVM_shadow_multiplier, Memory.PVinPVH.full_config) + | `pvh -> + (vm_record.API.vM_HVM_shadow_multiplier, Memory.HVM.full_config) | `pv -> (Memory.Linux.shadow_multiplier_default, Memory.Linux.full_config) in @@ -255,7 +257,7 @@ let vm_compute_memory_overhead ~vm_record = let vcpu_count = Int64.to_int vm_record.API.vM_VCPUs_max in let model = match Helpers.check_domain_type vm_record.API.vM_domain_type with - | `hvm -> + | `hvm | `pvh -> Memory.HVM.overhead_mib | `pv_in_pvh -> Memory.PVinPVH.overhead_mib diff --git a/ocaml/xapi/vm_platform.ml b/ocaml/xapi/vm_platform.ml index ecfc9d27424..a4cd195bcce 100644 --- a/ocaml/xapi/vm_platform.ml +++ b/ocaml/xapi/vm_platform.ml @@ -162,7 +162,7 @@ let sanity_check ~platformdata ~firmware ~vcpu_max ~vcpu_at_startup:_ in (* Sanity check for HVM or PV-in-PVH domains with invalid VCPU configuration*) let check_cores_per_socket = - match domain_type with `hvm | `pv_in_pvh -> true | `pv -> false + match domain_type with `hvm | `pv_in_pvh | `pvh -> true | `pv -> false in ( match (List.assoc device_model platformdata, firmware) with | "qemu-trad", Xenops_types.Vm.Uefi _ -> diff --git a/ocaml/xapi/xapi_ha_vm_failover.ml b/ocaml/xapi/xapi_ha_vm_failover.ml index c1e949ae4e5..043063340b3 100644 --- a/ocaml/xapi/xapi_ha_vm_failover.ml +++ b/ocaml/xapi/xapi_ha_vm_failover.ml @@ -206,7 +206,7 @@ let compute_evacuation_plan ~__context total_hosts remaining_hosts match Helpers.check_domain_type snapshot.API.vM_domain_type with | `hvm | `pv -> Memory_check.Dynamic_min - | `pv_in_pvh -> + | `pv_in_pvh | `pvh -> Memory_check.Static_max in (vm, total_memory_of_vm ~__context policy snapshot) diff --git a/ocaml/xapi/xapi_vif_helpers.ml b/ocaml/xapi/xapi_vif_helpers.ml index e2d103fb009..ebbfbae05fa 100644 --- a/ocaml/xapi/xapi_vif_helpers.ml +++ b/ocaml/xapi/xapi_vif_helpers.ml @@ -118,7 +118,7 @@ let valid_operations ~__context record _ref' : table = match Helpers.domain_type ~__context ~self:vm with | `hvm -> true - | `pv_in_pvh | `pv -> + | `pv_in_pvh | `pv | `pvh -> false in ( if power_state = `Running && needs_driver_check () then diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index 38250bd7445..04a0456bf94 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -303,7 +303,7 @@ let validate_actions_after_crash ~__context ~self ~value = let fld = "VM.actions_after_crash" in let hvm_cannot_coredump v = match Helpers.domain_type ~__context ~self with - | `hvm | `pv_in_pvh -> + | `hvm | `pv_in_pvh | `pvh -> value_not_supported fld v "cannot invoke a coredump of an HVM or PV-in-PVH domain" | `pv -> @@ -624,7 +624,7 @@ let assert_enough_memory_available ~__context ~self ~host ~snapshot = in let policy = match Helpers.check_domain_type snapshot.API.vM_domain_type with - | `hvm | `pv -> + | `hvm | `pv | `pvh -> Memory_check.Dynamic_min | `pv_in_pvh -> Memory_check.Static_max @@ -738,7 +738,7 @@ let assert_can_boot_here ~__context ~self ~host ~snapshot ~do_cpuid_check assert_usbs_available ~__context ~self ~host ; assert_netsriov_available ~__context ~self ~host ; ( match Helpers.domain_type ~__context ~self with - | `hvm | `pv_in_pvh -> + | `hvm | `pv_in_pvh | `pvh -> assert_host_supports_hvm ~__context ~self ~host | `pv -> () diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml index ada909caafc..b4d938ee556 100644 --- a/ocaml/xapi/xapi_vm_lifecycle.ml +++ b/ocaml/xapi/xapi_vm_lifecycle.ml @@ -159,7 +159,7 @@ let has_definitely_booted_pv ~vmmr = match r.Db_actions.vM_metrics_current_domain_type with | `hvm | `unspecified -> false - | `pv | `pv_in_pvh -> + | `pv | `pv_in_pvh | `pvh -> true ) diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 0f7aa7ff687..0fec653dcd9 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -547,6 +547,10 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = PVinPVH (make_direct_boot_record options) | `pv_in_pvh, Helpers.Indirect options -> PVinPVH (make_indirect_boot_record options) + | `pvh, Helpers.Direct options -> + PVH (make_direct_boot_record options) + | `pvh, Helpers.Indirect options -> + PVH (make_indirect_boot_record options) | _ -> raise Api_errors.( @@ -572,7 +576,7 @@ module MD = struct match vm.API.vM_domain_type with | `hvm -> true - | `pv_in_pvh | `pv | `unspecified -> + | `pv_in_pvh | `pv | `pvh | `unspecified -> false in let device_number = Device_number.of_string hvm vbd.API.vBD_userdevice in @@ -2049,6 +2053,8 @@ let update_vm ~__context id = update `pv | Domain_PVinPVH -> update `pv_in_pvh + | Domain_PVH -> + update `pvh | Domain_undefined -> if power_state <> `Halted then debug diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml index b42a459c077..dd3af75de84 100644 --- a/ocaml/xenopsd/cli/xn.ml +++ b/ocaml/xenopsd/cli/xn.ml @@ -432,7 +432,7 @@ let print_vm id = ) | HVM {boot_order= b; _} -> [(_builder, quote "hvm"); (_boot, quote b)] - | PVinPVH _ -> + | PVinPVH _ | PVH _ -> failwith "unimplemented" in let name = [(_name, quote vm_t.name)] in diff --git a/ocaml/xenopsd/lib/xenops_server.ml b/ocaml/xenopsd/lib/xenops_server.ml index e2c8045759d..2e3c31eba64 100644 --- a/ocaml/xenopsd/lib/xenops_server.ml +++ b/ocaml/xenopsd/lib/xenops_server.ml @@ -1177,6 +1177,24 @@ let export_metadata vdi_map vif_map vgpu_pci_map id = } ) } + | Vm.PVH pv_info -> + Vm.PVH + { + pv_info with + Vm.boot= + ( match pv_info.Vm.boot with + | Vm.Direct _ -> + pv_info.Vm.boot + | Vm.Indirect pv_indirect_boot -> + Vm.Indirect + { + pv_indirect_boot with + Vm.devices= + List.map (remap_vdi vdi_map) + pv_indirect_boot.Vm.devices + } + ) + } ) } in @@ -1257,7 +1275,7 @@ let import_metadata id md = let fs = let stat = B.HOST.stat () in ( match md.Metadata.vm.Vm.ty with - | HVM _ | PVinPVH _ -> + | HVM _ | PVinPVH _ | PVH _ -> Host.(stat.cpu_info.features_hvm) | PV _ -> Host.(stat.cpu_info.features_pv) diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index 82147027ba0..433ed01d932 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -59,6 +59,8 @@ let feature_flags_path = ref "/etc/xenserver/features.d" let pvinpvh_xen_cmdline = ref "pv-shim console=xen" +let pvh_ovmf_cmdline = ref "" + let numa_placement = ref false (* This is for debugging only *) @@ -242,6 +244,11 @@ let options = , (fun () -> !pvinpvh_xen_cmdline) , "Command line for the inner-xen for PV-in-PVH guests" ) + ; ( "pvh-ovmf-cmdline" + , Arg.Set_string pvh_ovmf_cmdline + , (fun () -> !pvh_ovmf_cmdline) + , "Command line for OVMF for PVH guests" + ) ; ( "numa-placement" , Arg.Bool (fun x -> numa_placement := x) , (fun () -> string_of_bool !numa_placement) diff --git a/ocaml/xenopsd/test/test.ml b/ocaml/xenopsd/test/test.ml index 3d2e35f31c7..5c503c27390 100644 --- a/ocaml/xenopsd/test/test.ml +++ b/ocaml/xenopsd/test/test.ml @@ -333,11 +333,11 @@ let vm_assert_equal vm vm' = assert_equal ~msg:"has_vendor_device" ~printer:string_of_bool vm.has_vendor_device vm'.has_vendor_device ; let is_hvm vm = - match vm.ty with HVM _ -> true | PV _ | PVinPVH _ -> false + match vm.ty with HVM _ -> true | PV _ | PVinPVH _ | PVH _ -> false in assert_equal ~msg:"HVM-ness" ~printer:string_of_bool (is_hvm vm) (is_hvm vm') ; match (vm.ty, vm'.ty) with - | HVM _, (PV _ | PVinPVH _) | (PV _ | PVinPVH _), HVM _ -> + | HVM _, (PV _ | PVinPVH _ | PVH _) | (PV _ | PVinPVH _ | PVH _), HVM _ -> failwith "HVM-ness" | HVM h, HVM h' -> assert_equal ~msg:"HAP" ~printer:string_of_bool h.hap h'.hap ; @@ -370,7 +370,7 @@ let vm_assert_equal vm vm' = h.boot_order h'.boot_order ; assert_equal ~msg:"qemu_disk_cmdline" ~printer:string_of_bool h.qemu_disk_cmdline h'.qemu_disk_cmdline - | (PV p | PVinPVH p), (PV p' | PVinPVH p') -> ( + | (PV p | PVinPVH p | PVH p), (PV p' | PVinPVH p' | PVH p') -> ( assert_equal ~msg:"framebuffer" ~printer:string_of_bool p.framebuffer p'.framebuffer ; assert_equal ~msg:"vncterm" ~printer:string_of_bool p.vncterm p'.vncterm ; diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 9e170b0ff49..e90d4e67ce8 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -129,7 +129,7 @@ module VmExtra = struct match vm.ty with | PV _ -> X86 {emulation_flags= []} - | PVinPVH _ -> + | PVinPVH _ | PVH _ -> X86 {emulation_flags= emulation_flags_pvh} | HVM _ -> X86 {emulation_flags= emulation_flags_all} @@ -210,7 +210,7 @@ module DB = struct x ) } - + let revision_of vm persistent = persistent |> revise_profile_qemu_trad vm end @@ -1131,7 +1131,7 @@ let dm_of ~vm = try let vmextra = DB.read_exn vm in match VmExtra.(vmextra.persistent.profile, vmextra.persistent.ty) with - | None, Some (PV _ | PVinPVH _) -> + | None, Some (PV _ | PVinPVH _ | PVH _) -> Device.Profile.Qemu_none | None, (Some (HVM _) | None) -> Device.Profile.fallback @@ -1162,7 +1162,7 @@ module VM = struct match persistent.ty with | Some (PV _) -> Memory.Linux.overhead_mib - | Some (PVinPVH _) -> + | Some (PVinPVH _ | PVH _ (* TODO: pvh *) ) -> Memory.PVinPVH.overhead_mib | Some (HVM _) -> Memory.HVM.overhead_mib @@ -1210,6 +1210,8 @@ module VM = struct "pv" | PVinPVH _ -> "pv-in-pvh" + | PVH _ -> + "pvh" in xs.Xs.write (domain_type_path domid) domain_type @@ -1222,6 +1224,8 @@ module VM = struct Domain_PV | "pv-in-pvh" -> Domain_PVinPVH + | "pvh" -> + Domain_PVH | x -> warn "domid = %d; Undefined domain type found (%s)" di.Xenctrl.domid x ; Domain_undefined @@ -1251,7 +1255,7 @@ module VM = struct raise (Xenopsd_error No_bootable_device) | PV {boot= Indirect {devices= _ :: _; _}; _} -> Domain.BuildPV {Domain.cmdline= ""; ramdisk= None} - | PVinPVH _ -> + | PVinPVH _ | PVH _ -> failwith "This domain type did not exist pre-xenopsd" in let build_info = @@ -1274,7 +1278,7 @@ module VM = struct last_start_time= 0.0 ; profile= profile_of ~vm } - + |> rpc_of VmExtra.persistent_t |> Jsonrpc.to_string @@ -1282,7 +1286,9 @@ module VM = struct let generate_create_info ~xs:_ vm persistent = let ty = match persistent.VmExtra.ty with Some ty -> ty | None -> vm.ty in - let hvm = match ty with HVM _ | PVinPVH _ -> true | PV _ -> false in + let hvm = + match ty with HVM _ | PVinPVH _ | PVH _ -> true | PV _ -> false + in (* XXX add per-vcpu information to the platform data *) (* VCPU configuration *) let xcext = Xenctrlext.get_handle () in @@ -1439,7 +1445,7 @@ module VM = struct ; pci_power_mgmt= vm.Vm.pci_power_mgmt ; platformdata= vm.Vm.platformdata } - + in Some VmExtra.{persistent} @@ -1520,7 +1526,7 @@ module VM = struct let persistent = VmExtra. {persistent with domain_config= Some domain_config} - + in (domain_config, persistent) @@ -1937,11 +1943,13 @@ module VM = struct match ty with | PV {framebuffer= false; _} -> None - | PV {framebuffer= true; _} | PVinPVH {framebuffer= true; _} -> + | PV {framebuffer= true; _} + | PVinPVH {framebuffer= true; _} + | PVH {framebuffer= true; _} -> debug "Ignoring request for a PV VNC console (would require qemu-trad)" ; None - | PVinPVH {framebuffer= false; _} -> + | PVinPVH {framebuffer= false; _} | PVH {framebuffer= false; _} -> None | HVM hvm_info -> let disks = @@ -2108,7 +2116,7 @@ module VM = struct ; shadow_multiplier= 1. ; video_mib= 0 } - + in (make_build_info !Resources.pvinpvh_xen builder_spec_info, "") @@ -2142,12 +2150,67 @@ module VM = struct ; shadow_multiplier= 1. ; video_mib= 0 } - + in (make_build_info !Resources.pvinpvh_xen builder_spec_info, "") ) + | PVH {boot= Direct direct; _} -> + let builder_spec_info = + Domain.BuildPVH + Domain. + { + cmdline= direct.cmdline + ; modules= + ( match direct.ramdisk with + | Some r -> + [(r, None)] + | None -> + [] + ) + ; shadow_multiplier= 1. + ; video_mib= 0 + } + + in + + (make_build_info direct.kernel builder_spec_info, "") + | PVH {boot= Indirect {devices= []; _}; _} -> + raise (Xenopsd_error No_bootable_device) + | PVH {boot= Indirect ({devices= d :: _; _} as i); _} -> + with_disk ~xc ~xs task d false (fun dev -> + let b = + Bootloader.extract task ~bootloader:i.bootloader + ~legacy_args:i.legacy_args ~extra_args:i.extra_args + ~pv_bootloader_args:i.bootloader_args ~disk:dev + ~vm:vm.Vm.id () + in + kernel_to_cleanup := Some b ; + let builder_spec_info = + Domain.BuildPVH + { + Domain.cmdline= b.Bootloader.kernel_args + ; modules= + ( b.Bootloader.kernel_path + , Some b.Bootloader.kernel_args + ) + :: + ( match b.Bootloader.initrd_path with + | Some r -> + [(r, None)] + | None -> + [] + ) + ; shadow_multiplier= 1. + ; video_mib= 0 + } + in + ( make_build_info b.Bootloader.kernel_path builder_spec_info + , "" + ) + ) in + Domain.build task ~xc ~xs ~store_domid ~console_domid ~timeoffset ~extras ~vgpus build_info (choose_xenguest vm.Vm.platformdata) @@ -2170,7 +2233,7 @@ module VM = struct ; ty= Some vm.ty } } - + ) in () @@ -2250,7 +2313,7 @@ module VM = struct (if saved_state then Device.Dm.restore else Device.Dm.start) task ~xc ~xs ~dm:qemu_dm info di.Xenctrl.domid ; Device.Serial.update_xenstore ~xs di.Xenctrl.domid - | Vm.PV _ | Vm.PVinPVH _ -> + | Vm.PV _ | Vm.PVinPVH _ | Vm.PVH _ -> assert false ) (create_device_model_config vm vmextra vbds vifs vgpus vusbs) ; @@ -2278,7 +2341,7 @@ module VM = struct xen_platform= Some (xen_platform_of ~vm ~vmextra:d) } } - + | _ -> d in @@ -2303,7 +2366,7 @@ module VM = struct `hvm | Vm.Domain_PV -> `pv - | Vm.Domain_PVinPVH -> + | Vm.Domain_PVinPVH | Vm.Domain_PVH -> `pvh | Vm.Domain_undefined -> failwith "undefined domain type: cannot save" @@ -2477,7 +2540,7 @@ module VM = struct `hvm | Vm.Domain_PV -> `pv - | Vm.Domain_PVinPVH -> + | Vm.Domain_PVinPVH | Vm.Domain_PVH -> `pvh | Vm.Domain_undefined -> failwith "undefined domain type: cannot save" @@ -2586,7 +2649,7 @@ module VM = struct suspend_memory_bytes= Memory.bytes_of_pages pages } } - + ) in () @@ -3371,7 +3434,7 @@ module PCI = struct let device = Device.PCI. {host= pci.address; guest= (index, guest_pci); qmp_add= advertise} - + in Device.PCI.add ~xc ~xs ~hvm [device] frontend_domid @@ -3556,7 +3619,7 @@ module VBD = struct ; BlockDevice {path= ""} ] } - + } | Some (Local path) -> { @@ -3570,7 +3633,7 @@ module VBD = struct ; BlockDevice {path} ] } - + } | Some (VDI path) -> let sr, vdi = Storage.get_disk_by_name task path in @@ -3806,7 +3869,7 @@ module VBD = struct (vbd.Vbd.id, q) :: vm_t.persistent.qemu_vbds } } - + ) in () @@ -3918,7 +3981,7 @@ module VBD = struct persistent.qemu_vbds } } - + ) else vm_t ) @@ -4391,7 +4454,7 @@ module VIF = struct vm_t.persistent.qemu_vifs } } - + | _, _ -> vm_t else @@ -4459,7 +4522,7 @@ module VIF = struct persistent.qemu_vifs } } - + | _, _ -> Some vm_t else From d5794f7a0a45c940f7cdb9638ea0533de9c1a107 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 3 Jan 2023 17:53:13 +0000 Subject: [PATCH 26/75] WiP --- ocaml/.editorconfig | 20 +++ ocaml/staticanalyzer/analyses/domainlock.ml | 145 ++++++++++++++++++++ ocaml/staticanalyzer/analyses/dune | 5 + ocaml/staticanalyzer/camlprim-attr.patcher | 5 + ocaml/staticanalyzer/dune | 12 ++ ocaml/staticanalyzer/goblint.ml | 87 ++++++++++++ ocaml/staticanalyzer/lintcstubs.ml | 9 ++ ocaml/xapi/xapi_xenops.ml | 8 +- 8 files changed, 288 insertions(+), 3 deletions(-) create mode 100644 ocaml/.editorconfig create mode 100644 ocaml/staticanalyzer/analyses/domainlock.ml create mode 100644 ocaml/staticanalyzer/analyses/dune create mode 100644 ocaml/staticanalyzer/camlprim-attr.patcher create mode 100644 ocaml/staticanalyzer/dune create mode 100644 ocaml/staticanalyzer/goblint.ml create mode 100644 ocaml/staticanalyzer/lintcstubs.ml diff --git a/ocaml/.editorconfig b/ocaml/.editorconfig new file mode 100644 index 00000000000..cb2f27c5819 --- /dev/null +++ b/ocaml/.editorconfig @@ -0,0 +1,20 @@ +# See ./CODING_STYLE +root = true + +[*] +end_of_line = lf +indent_style = space +charset = utf-8 +max_line_length = 79 +trim_trailing_whitespace = true +insert_final_newline = true + +# Makefiles must use tabs, otherwise they don't work +[{Makefile,*.mk,Makefile.rules}] +indent_style = tabs + +[*.{c,h}] +indent_size = 4 + +[*.{ml,mli}] +indent_size = 2 diff --git a/ocaml/staticanalyzer/analyses/domainlock.ml b/ocaml/staticanalyzer/analyses/domainlock.ml new file mode 100644 index 00000000000..3d379e129a1 --- /dev/null +++ b/ocaml/staticanalyzer/analyses/domainlock.ml @@ -0,0 +1,145 @@ +open Prelude.Ana +open Analyses +open Cilint + +(* OCaml 5 style per-domain lock which must be held before calling the OCaml + runtime functions. + + __thread local variables are not yet supported by goblint/CIL, + so it may report a race on caml_local_roots, which can be avoided by + wrapping memory.h local root manipulation with __VERIFIER_atomic_begin and + __VERIFIER_atomic_end + + For now declare the domain lock as a function-local variable to simplify + analysis (and we'll require that all ocaml runtime functions called have + that lock held, but it'll make function exit awkward as we'd be leaking a + lock, so we'll need to unlock it on return..) + + Actually we do have a threadid query which we can use + + Callbacks are more difficult to handle because we may not know the domain + lock state there, + and have to do interprocedural analysis... +*) + + +module ThreadLocal = +struct + module TID = ThreadIdDomain.FlagConfiguredTID + + module HC = Printable.HConsed(TID) + + let fallback_global = TID.threadinit ~multiple:false (makeGlobalVar "__fallback_global__" intType) + + (** if we can implement __thread of get_domain_state with this then maybe we + won't need the atomic begin/end + *) + + let get name (ctx) = + let ask = Analyses.ask_of_ctx ctx in + let tid = + match ThreadId.get_current ask with + | `Lifted tid -> tid + | `Top | `Bot -> fallback_global + in + let create_var tid = + let tid_name = + ThreadIdDomain.FlagConfiguredTID.show tid + in + Goblintutil.create_var (makeGlobalVar (name ^ "_" ^ tid_name) intType) + in + HC.lift_f create_var @@ HC.lift tid +end + +module DomainLock = struct + let get (ctx) = + LockDomain.Addr.from_var @@ ThreadLocal.get "__VERIFIER_ocaml_domain_lock" ctx + + let is_held ctx = + (* TODO: this should be tri or 4-state: known held, known notheld, and + unknown, or known to be called from both *) + let lockset = ctx.ask Queries.MustLockset in + let lock = get ctx |> LockDomain.Addr.to_var |> Option.get in + ignore (Pretty.printf "lockset: %a\n" Queries.LS.pretty lockset); + Queries.LS.mem (lock, `NoOffset) lockset +end + +module CStubs = struct + let is_cstub (f:fundec) = + (* This relies on patcher having patched caml/misc.h in the copy used by + the analyses, see 'camlprim-attr.patcher'. + Normally CAMLprim + *) + hasAttribute {|section|} f.svar.vattr +end + +module Spec : Analyses.MCPSpec = +struct + let name () = "domainlock" + + module D = Lattice.Unit + module C = D + let startstate v = D.bot () + let exitstate v = D.top () + + include Analyses.IdentitySpec + + let is_value_ptr = function + | TPtr (TNamed({tname = "value"; _}, _), _) -> true + | _ -> false + + (* TODO: use visitor class *) + let rec has_ocaml_value : exp -> bool = function + | Lval(Mem e, _) -> has_ocaml_value e + | CastE (t, e) -> + is_value_ptr t || has_ocaml_value e + | BinOp(_, a, b, _) -> + has_ocaml_value a || has_ocaml_value b + | e -> + (* TODO: trace ignore (Pretty.printf "has_ocaml_value? %a\n" Cil.d_exp e); *) + false + + let body ctx f = + if CStubs.is_cstub f then begin + (* TODO: handle finalizer too, lock held?.. *) + let lock = DomainLock.get ctx in + ctx.emit (Events.Lock (lock, true)); + end; + ctx.local + + let return ctx _ (f:fundec) = + if CStubs.is_cstub f then + let lock = DomainLock.get ctx in + ctx.emit (Events.Unlock lock); + ctx.local + + let special (ctx:(D.t, G.t, C.t,V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) = + match f.vname with + | "caml_enter_blocking_section" -> + let lock = DomainLock.get ctx in + ctx.emit (Events.Unlock (lock)); + ctx.local + | "caml_leave_blocking_section" -> + let lock = DomainLock.get ctx in + ctx.emit (Events.Lock (lock, true)); + ctx.local + | name when String.starts_with "caml_" name -> + (* call into OCaml runtime system, must hold domain lock *) + if not @@ DomainLock.is_held ctx then + (* TODO: perhaps show last lock/release position? *) + Messages.error ~category:Messages.Category.Race "DomainLock: must be held + when calling OCaml runtime function"; + ctx.local + | _ -> + let () = arglist |> List.iter @@ fun arg -> + if has_ocaml_value arg && not @@ DomainLock.is_held ctx then + Messages.error ~category:Messages.Category.Race + "DomainLock: Call using OCaml value after domain lock has been released: %s(... %a ...)" + f.vname Cil.d_exp arg + in + ctx.local + +end + +let () = + MCP.register_analysis (module Spec : MCPSpec) diff --git a/ocaml/staticanalyzer/analyses/dune b/ocaml/staticanalyzer/analyses/dune new file mode 100644 index 00000000000..a15e2ab8793 --- /dev/null +++ b/ocaml/staticanalyzer/analyses/dune @@ -0,0 +1,5 @@ +(library + (name lintcstubs_analysis) + (flags (:standard -open Goblint_lib)); make it compatible to how it would look like if it was part of Goblint itself + (libraries goblint.lib) + ) diff --git a/ocaml/staticanalyzer/camlprim-attr.patcher b/ocaml/staticanalyzer/camlprim-attr.patcher new file mode 100644 index 00000000000..5afdf7a1940 --- /dev/null +++ b/ocaml/staticanalyzer/camlprim-attr.patcher @@ -0,0 +1,5 @@ +<<<< see doc/cil.tex for format +#define CAMLprim +==== use a section attribute, because other attributes can't be attached to definitions directly +#define CAMLprim __attribute__((section("goblint-ocaml-cstub"))) +>>>> we need to be able to recognize CAMLprim in the analysis, but we work on preprocessed source code, so we need to introduce an attribute here diff --git a/ocaml/staticanalyzer/dune b/ocaml/staticanalyzer/dune new file mode 100644 index 00000000000..91446e67e63 --- /dev/null +++ b/ocaml/staticanalyzer/dune @@ -0,0 +1,12 @@ +(executable + (name lintcstubs) + (libraries lintcstubs_analysis goblint.sites.dune) + (flags :standard -linkall) +) + +; TODO: copy $(ocamlc -where) to a destpatch, +; then run on caml/misc.h or all files this: +; perl -I$(opam var lib)/perl5 ~/goblint-cil/lib/perl5/patcher +; --patch=camlprim-attr.patcher --dest=destpatch --ufile caml/misc.h --verbose +; --mode=GNUCC -I$(ocamlc -where) +; TODO: perl5/patcher is not shipped and needs a patch (PR opened for latter) diff --git a/ocaml/staticanalyzer/goblint.ml b/ocaml/staticanalyzer/goblint.ml new file mode 100644 index 00000000000..8dc2e3b00f1 --- /dev/null +++ b/ocaml/staticanalyzer/goblint.ml @@ -0,0 +1,87 @@ +open Goblint_lib +open GobConfig +open Goblintutil +open Maingoblint +open Prelude +open Printf + +(** the main function *) +let main () = + try + Cilfacade.init (); + Maingoblint.parse_arguments (); + + (* Timing. *) + Maingoblint.reset_stats (); + if get_bool "dbg.timing.enabled" then ( + let tef_filename = get_string "dbg.timing.tef" in + if tef_filename <> "" then + Goblint_timing.setup_tef tef_filename; + Timing.Default.start { + cputime = true; + walltime = true; + allocated = true; + count = true; + tef = true; + }; + Timing.Program.start { + cputime = false; + walltime = false; + allocated = false; + count = false; + tef = true; + } + ); + + handle_extraspecials (); + GoblintDir.init (); + + if get_bool "dbg.verbose" then ( + print_endline (localtime ()); + print_endline Goblintutil.command_line; + ); + let file = lazy (Fun.protect ~finally:GoblintDir.finalize preprocess_parse_merge) in + if get_bool "server.enabled" then ( + let file = + if get_bool "server.reparse" then + None + else + Some (Lazy.force file) + in + Server.start file + ) + else ( + let file = Lazy.force file in + let changeInfo = + if GobConfig.get_bool "incremental.load" || GobConfig.get_bool "incremental.save" then + diff_and_rename file + else + Analyses.empty_increment_data () + in + if get_bool "ana.autotune.enabled" then AutoTune.chooseConfig file; + file |> do_analyze changeInfo; + do_html_output (); + do_gobview (); + do_stats (); + Goblint_timing.teardown_tef (); + if !verified = Some false then exit 3 (* verifier failed! *) + ) + with + | Exit -> + do_stats (); + Goblint_timing.teardown_tef (); + exit 1 + | Sys.Break -> (* raised on Ctrl-C if `Sys.catch_break true` *) + do_stats (); + (* Printexc.print_backtrace BatInnerIO.stderr *) + eprintf "%s\n" (MessageUtil.colorize ~fd:Unix.stderr ("{RED}Analysis was aborted by SIGINT (Ctrl-C)!")); + Goblint_timing.teardown_tef (); + exit 131 (* same exit code as without `Sys.catch_break true`, otherwise 0 *) + | Timeout -> + do_stats (); + eprintf "%s\n" (MessageUtil.colorize ~fd:Unix.stderr ("{RED}Analysis was aborted because it reached the set timeout of " ^ get_string "dbg.timeout" ^ " or was signalled SIGPROF!")); + Goblint_timing.teardown_tef (); + exit 124 + +(* We do this since the evaluation order of top-level bindings is not defined, but we want `main` to run after all the other side-effects (e.g. registering analyses/solvers) have happened. *) +let () = at_exit main diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml new file mode 100644 index 00000000000..b1bc1ce9b92 --- /dev/null +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -0,0 +1,9 @@ +(* goblint.ml is a copy of the one in goblint itself + (it is not exposed in a library, although most of its functionality is + exposed through Maingoblint) + + We'll link any custom analysis by using dune's linkall features: + they will register themselves on startup. +*) + +let main = Goblint.main diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 0fec653dcd9..c7c6e36ff9c 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -339,12 +339,14 @@ let rtc_timeoffset_of_vm ~__context (vm, vm_t) vbds = (* /boot/ contains potentially sensitive files like xen-initrd, so we will only*) (* allow directly booting guests from the subfolder /boot/guest/ *) -let allowed_dom0_directory_for_boot_files = "/boot/guest/" +let allowed_dom0_directories_for_boot_files = ["/boot/guest/"; "/var/lib/xcp/guest/"] let is_boot_file_whitelisted filename = let safe_str str = not (String.has_substr str "..") in (* make sure the script prefix is the allowed dom0 directory *) - String.startswith allowed_dom0_directory_for_boot_files filename + List.exists (fun allowed_dom0_directory_for_boot_files -> + String.startswith allowed_dom0_directory_for_boot_files filename) + allowed_dom0_directories_for_boot_files (* avoid ..-style attacks and other weird things *) && safe_str filename @@ -535,7 +537,7 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = match Helpers. (check_domain_type vm.API.vM_domain_type, boot_method_of_vm ~__context ~vm) - + with | `hvm, Helpers.Hvmloader _ -> HVM (make_hvmloader_boot_record ()) From 611956e2a9cab2ad4988f234982fe44047c0f1c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 3 Jan 2023 18:17:54 +0000 Subject: [PATCH 27/75] wip --- ocaml/staticanalyzer/analyses/domainlock.ml | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/ocaml/staticanalyzer/analyses/domainlock.ml b/ocaml/staticanalyzer/analyses/domainlock.ml index 3d379e129a1..216acd0236e 100644 --- a/ocaml/staticanalyzer/analyses/domainlock.ml +++ b/ocaml/staticanalyzer/analyses/domainlock.ml @@ -59,9 +59,16 @@ module DomainLock = struct (* TODO: this should be tri or 4-state: known held, known notheld, and unknown, or known to be called from both *) let lockset = ctx.ask Queries.MustLockset in - let lock = get ctx |> LockDomain.Addr.to_var |> Option.get in + let mutex = get ctx in + let lock = mutex |> LockDomain.Addr.to_var |> Option.get in ignore (Pretty.printf "lockset: %a\n" Queries.LS.pretty lockset); Queries.LS.mem (lock, `NoOffset) lockset + + let protects ctx global = + let mutex = get ctx in + let must_be = ctx.ask Queries.(MustBeProtectedBy {mutex;global;write=false}) in + ignore (Pretty.printf "protects(_TODO_): %b\n" must_be); + must_be end module CStubs = struct @@ -132,7 +139,8 @@ struct ctx.local | _ -> let () = arglist |> List.iter @@ fun arg -> - if has_ocaml_value arg && not @@ DomainLock.is_held ctx then + (* TODO: need a varinfo from an exp *) + if has_ocaml_value arg && not @@ DomainLock.protects ctx arg then Messages.error ~category:Messages.Category.Race "DomainLock: Call using OCaml value after domain lock has been released: %s(... %a ...)" f.vname Cil.d_exp arg From 764ab129d30018819aacae9acb8a889ae2abb3d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Wed, 4 Jan 2023 18:19:02 +0000 Subject: [PATCH 28/75] wip --- ocaml/staticanalyzer/analyses/domainlock.ml | 153 ------------------- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 146 ++++++++++++++++++ 2 files changed, 146 insertions(+), 153 deletions(-) delete mode 100644 ocaml/staticanalyzer/analyses/domainlock.ml create mode 100644 ocaml/staticanalyzer/analyses/ocamlcstubs.ml diff --git a/ocaml/staticanalyzer/analyses/domainlock.ml b/ocaml/staticanalyzer/analyses/domainlock.ml deleted file mode 100644 index 216acd0236e..00000000000 --- a/ocaml/staticanalyzer/analyses/domainlock.ml +++ /dev/null @@ -1,153 +0,0 @@ -open Prelude.Ana -open Analyses -open Cilint - -(* OCaml 5 style per-domain lock which must be held before calling the OCaml - runtime functions. - - __thread local variables are not yet supported by goblint/CIL, - so it may report a race on caml_local_roots, which can be avoided by - wrapping memory.h local root manipulation with __VERIFIER_atomic_begin and - __VERIFIER_atomic_end - - For now declare the domain lock as a function-local variable to simplify - analysis (and we'll require that all ocaml runtime functions called have - that lock held, but it'll make function exit awkward as we'd be leaking a - lock, so we'll need to unlock it on return..) - - Actually we do have a threadid query which we can use - - Callbacks are more difficult to handle because we may not know the domain - lock state there, - and have to do interprocedural analysis... -*) - - -module ThreadLocal = -struct - module TID = ThreadIdDomain.FlagConfiguredTID - - module HC = Printable.HConsed(TID) - - let fallback_global = TID.threadinit ~multiple:false (makeGlobalVar "__fallback_global__" intType) - - (** if we can implement __thread of get_domain_state with this then maybe we - won't need the atomic begin/end - *) - - let get name (ctx) = - let ask = Analyses.ask_of_ctx ctx in - let tid = - match ThreadId.get_current ask with - | `Lifted tid -> tid - | `Top | `Bot -> fallback_global - in - let create_var tid = - let tid_name = - ThreadIdDomain.FlagConfiguredTID.show tid - in - Goblintutil.create_var (makeGlobalVar (name ^ "_" ^ tid_name) intType) - in - HC.lift_f create_var @@ HC.lift tid -end - -module DomainLock = struct - let get (ctx) = - LockDomain.Addr.from_var @@ ThreadLocal.get "__VERIFIER_ocaml_domain_lock" ctx - - let is_held ctx = - (* TODO: this should be tri or 4-state: known held, known notheld, and - unknown, or known to be called from both *) - let lockset = ctx.ask Queries.MustLockset in - let mutex = get ctx in - let lock = mutex |> LockDomain.Addr.to_var |> Option.get in - ignore (Pretty.printf "lockset: %a\n" Queries.LS.pretty lockset); - Queries.LS.mem (lock, `NoOffset) lockset - - let protects ctx global = - let mutex = get ctx in - let must_be = ctx.ask Queries.(MustBeProtectedBy {mutex;global;write=false}) in - ignore (Pretty.printf "protects(_TODO_): %b\n" must_be); - must_be -end - -module CStubs = struct - let is_cstub (f:fundec) = - (* This relies on patcher having patched caml/misc.h in the copy used by - the analyses, see 'camlprim-attr.patcher'. - Normally CAMLprim - *) - hasAttribute {|section|} f.svar.vattr -end - -module Spec : Analyses.MCPSpec = -struct - let name () = "domainlock" - - module D = Lattice.Unit - module C = D - let startstate v = D.bot () - let exitstate v = D.top () - - include Analyses.IdentitySpec - - let is_value_ptr = function - | TPtr (TNamed({tname = "value"; _}, _), _) -> true - | _ -> false - - (* TODO: use visitor class *) - let rec has_ocaml_value : exp -> bool = function - | Lval(Mem e, _) -> has_ocaml_value e - | CastE (t, e) -> - is_value_ptr t || has_ocaml_value e - | BinOp(_, a, b, _) -> - has_ocaml_value a || has_ocaml_value b - | e -> - (* TODO: trace ignore (Pretty.printf "has_ocaml_value? %a\n" Cil.d_exp e); *) - false - - let body ctx f = - if CStubs.is_cstub f then begin - (* TODO: handle finalizer too, lock held?.. *) - let lock = DomainLock.get ctx in - ctx.emit (Events.Lock (lock, true)); - end; - ctx.local - - let return ctx _ (f:fundec) = - if CStubs.is_cstub f then - let lock = DomainLock.get ctx in - ctx.emit (Events.Unlock lock); - ctx.local - - let special (ctx:(D.t, G.t, C.t,V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) = - match f.vname with - | "caml_enter_blocking_section" -> - let lock = DomainLock.get ctx in - ctx.emit (Events.Unlock (lock)); - ctx.local - | "caml_leave_blocking_section" -> - let lock = DomainLock.get ctx in - ctx.emit (Events.Lock (lock, true)); - ctx.local - | name when String.starts_with "caml_" name -> - (* call into OCaml runtime system, must hold domain lock *) - if not @@ DomainLock.is_held ctx then - (* TODO: perhaps show last lock/release position? *) - Messages.error ~category:Messages.Category.Race "DomainLock: must be held - when calling OCaml runtime function"; - ctx.local - | _ -> - let () = arglist |> List.iter @@ fun arg -> - (* TODO: need a varinfo from an exp *) - if has_ocaml_value arg && not @@ DomainLock.protects ctx arg then - Messages.error ~category:Messages.Category.Race - "DomainLock: Call using OCaml value after domain lock has been released: %s(... %a ...)" - f.vname Cil.d_exp arg - in - ctx.local - -end - -let () = - MCP.register_analysis (module Spec : MCPSpec) diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml new file mode 100644 index 00000000000..bfb3ab89873 --- /dev/null +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -0,0 +1,146 @@ +open Prelude.Ana +open Analyses +open! Cilint + +(* M.tracing is not enabled by default, use workaround *) +let tracing = true (* TODO: config bool *) +let tracel _ fmt = Pretty.printf ("OCAMLCSTUBS: " ^^ fmt ^^ "\n") + +module DomainLock = struct + (* This simulates OCaml 4.x semantics with a single global lock, + it should instead be configurable to use per-domain locks (e.g. N threads with M domains) + *) + let runtime_lock_var = Goblintutil.create_var @@ makeGlobalVar "[OCaml runtime lock]" intType + let runtime_lock_event = LockDomain.Addr.from_var runtime_lock_var + let runtime_lock = AddrOf (Cil.var runtime_lock_var) + + let must_be_held ctx name = + let lockset = ctx.ask Queries.MustLockset in + if tracing then + ignore @@ tracel __MODULE__ "OCaml domain lock must be held, current lockset is %a" Queries.LS.pretty lockset; + if not @@ Queries.LS.mem (runtime_lock_var, `NoOffset) lockset then begin + (* we could use something similar to MayLocks to track may lock and give + a better warning message: is the lock maybe held on some paths, or + surely not held? *) + Messages.error ~category:Messages.Category.Race "DomainLock: must be held when calling OCaml runtime function %s" name; + end; + ctx.local + + let must_be_protected_by ctx write (arg: varinfo) = + must_be_held ctx arg.vname; + if tracing then + ignore @@ tracel __MODULE__ "OCaml domain lock must protect access to OCaml value %s (write=%b)" arg.vname write; + let must = ctx.ask Queries.(MustBeProtectedBy {mutex = runtime_lock_event; write; global = arg }) in + if not must then + Messages.error ~category:Messages.Category.Race "DomainLock: must be held when dereferencing OCaml value %s" arg.vname; + if tracing then + ignore @@ tracel __MODULE__ "OCaml domain lock must protect access to OCaml value %s (write=%b, must = %b)" arg.vname write must; + ctx.local +end + +let ocaml_runtime_functions : (string * LibraryDesc.t) list = + LibraryDsl. + [ ("caml_leave_blocking_section", + special [] @@ Lock { lock = DomainLock.runtime_lock; try_ = false; write + = true; return_on_success = true }) + ; ("caml_enter_blocking_section", + special [] @@ Unlock DomainLock.runtime_lock) + (* TODO: more functions here *) + ] + +module Cstub = struct + + let is_cstub_entry _ctx f = + (* This relies on patcher having patched caml/misc.h in the copy used by + the analyses, see 'camlprim-attr.patcher'. + Normally CAMLprim + *) + let is = ContextUtil.has_attribute "section" "goblint-ocaml-cstub" f.svar.vattr in + if tracing then ignore @@ tracel __MODULE__ "function %s is an OCaml C stub: %b" f.svar.vname is; + is + + let enter_cstub ctx _ = + (* TODO: one CAMLprim can call another one, e.g. common in bytecode impl + that calls native, + so this should be a trylock, or there should be an outer function + locking and calling this. + For now take the lock here + *) + ctx.emit (Events.Lock (DomainLock.runtime_lock_event, true)); + ctx.local + + let leave_cstub ctx _ = + ctx.emit (Events.Unlock DomainLock.runtime_lock_event); + ctx.local + + let call_caml_runtime ctx f _arglist = + DomainLock.must_be_held ctx f.vname; + ctx.local +end + +let is_ocaml_value_type = function + | TNamed ({ tname = "value"; _}, _) -> true + | _ -> false + +class exp_ocaml_value_extractor (acc: varinfo list ref) = object + inherit nopCilVisitor + + method! vvrbl var = + if is_ocaml_value_type var.vtype then + acc := var :: !acc; + SkipChildren +end + +let ocaml_values_of_exp exp = + let values = ref [] in + let visitor = new exp_ocaml_value_extractor values in + let (_:exp) = visitCilExpr visitor exp in + !values + +module Spec : Analyses.MCPSpec = +struct + let name () = "ocamlcstubs" + + module D = Lattice.Unit + module C = D + let startstate _v = D.bot () + let exitstate _v = D.top () + + include Analyses.IdentitySpec + + let body ctx f = + (* TODO: set ctx bool that we're inside cstub, to avoid false positives on + runtime inline functions *) + if Cstub.is_cstub_entry ctx f then + Cstub.enter_cstub ctx f + else ctx.local + + let return ctx _ (f:fundec) = + if Cstub.is_cstub_entry ctx f then + Cstub.leave_cstub ctx f + else ctx.local + + let special (ctx:(D.t, G.t, C.t,V.t) ctx) (_lval: lval option) (f:varinfo) (arglist:exp list) = + if tracing then + ignore @@ tracel __MODULE__ "special(%s)" f.vname; + if String.starts_with f.vname "caml_" && f.vname <> "caml_leave_blocking_section" then + (* call into OCaml runtime system, must hold domain lock *) + Cstub.call_caml_runtime ctx f arglist + else ctx.local + + let event ctx e _octx = + match e with + | Events.Access {exp; kind; reach; _} -> + (* TODO: only for pointers *) + if tracing then + ignore @@ tracel __MODULE__ "access %a, kind %a, reach %b" Cil.d_exp exp AccessKind.pretty kind reach; + (* TODO: reject free and spawn kinds? *) + exp |> ocaml_values_of_exp |> + List.iter @@ DomainLock.must_be_protected_by ctx (kind = AccessKind.Write); + ctx.local + | _ -> ctx.local +end + +let () = + LibraryFunctions.register_library_functions ocaml_runtime_functions; + MCP.register_analysis ~dep:["access"] (module Spec : MCPSpec) From 918ab893049c66e951c35b905494af2818d62696 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 5 Jan 2023 09:16:16 +0000 Subject: [PATCH 29/75] wip --- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 245 +++++++++++++------ ocaml/staticanalyzer/goblint.ml | 87 ------- ocaml/staticanalyzer/lintcstubs.ml | 101 +++++++- 3 files changed, 265 insertions(+), 168 deletions(-) delete mode 100644 ocaml/staticanalyzer/goblint.ml diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index bfb3ab89873..41d0e32b03d 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -2,145 +2,240 @@ open Prelude.Ana open Analyses open! Cilint -(* M.tracing is not enabled by default, use workaround *) -let tracing = true (* TODO: config bool *) -let tracel _ fmt = Pretty.printf ("OCAMLCSTUBS: " ^^ fmt ^^ "\n") +(* M.tracing is not enabled by default in upstream goblint build for + performance reasons, use a boolean to turn tracing on/off just for this + module. + + Usage on the command line: '--enable dbg.debug' +*) +let trace_name = __MODULE__ + +let tracing_enabled = lazy (GobConfig.get_bool "dbg.debug") + +let tracing () = Lazy.force tracing_enabled + +let tracel fmt = M.tracel trace_name (fmt ^^ "\n") module DomainLock = struct (* This simulates OCaml 4.x semantics with a single global lock, it should instead be configurable to use per-domain locks (e.g. N threads with M domains) - *) - let runtime_lock_var = Goblintutil.create_var @@ makeGlobalVar "[OCaml runtime lock]" intType + *) + let runtime_lock_var = + Goblintutil.create_var @@ makeGlobalVar "[OCaml runtime lock]" intType + let runtime_lock_event = LockDomain.Addr.from_var runtime_lock_var + let runtime_lock = AddrOf (Cil.var runtime_lock_var) let must_be_held ctx name = let lockset = ctx.ask Queries.MustLockset in - if tracing then - ignore @@ tracel __MODULE__ "OCaml domain lock must be held, current lockset is %a" Queries.LS.pretty lockset; - if not @@ Queries.LS.mem (runtime_lock_var, `NoOffset) lockset then begin + if tracing () then + tracel "OCaml domain lock must be held, current lockset is %a" + Queries.LS.pretty lockset ; + if not @@ Queries.LS.mem (runtime_lock_var, `NoOffset) lockset then (* we could use something similar to MayLocks to track may lock and give - a better warning message: is the lock maybe held on some paths, or - surely not held? *) - Messages.error ~category:Messages.Category.Race "DomainLock: must be held when calling OCaml runtime function %s" name; - end; + a better warning message: is the lock maybe held on some paths, or + surely not held? *) + Messages.error ~category:Messages.Category.Race + "DomainLock: must be held when calling OCaml runtime function %s" name ; ctx.local - let must_be_protected_by ctx write (arg: varinfo) = - must_be_held ctx arg.vname; - if tracing then - ignore @@ tracel __MODULE__ "OCaml domain lock must protect access to OCaml value %s (write=%b)" arg.vname write; - let must = ctx.ask Queries.(MustBeProtectedBy {mutex = runtime_lock_event; write; global = arg }) in + let must_be_protected_by ctx write (arg : varinfo) = + if tracing () then + tracel + "OCaml domain lock must protect access to OCaml value %s (write=%b)" + arg.vname write ; + let must = + ctx.ask + Queries.( + MustBeProtectedBy {mutex= runtime_lock_event; write; global= arg} + ) + in if not must then - Messages.error ~category:Messages.Category.Race "DomainLock: must be held when dereferencing OCaml value %s" arg.vname; - if tracing then - ignore @@ tracel __MODULE__ "OCaml domain lock must protect access to OCaml value %s (write=%b, must = %b)" arg.vname write must; + Messages.error ~category:Messages.Category.Race + "DomainLock: must be held when dereferencing OCaml value %s" arg.vname ; + if tracing () then + tracel + "OCaml domain lock must protect access to OCaml value %s (write=%b, \ + must = %b)" + arg.vname write must ; + (* sometimes the must above answers true even if the domain lock is not + held? *) + must_be_held ctx arg.vname ; + (* TODO: this should say accessing OCaml value, + not runtime function *) ctx.local end let ocaml_runtime_functions : (string * LibraryDesc.t) list = LibraryDsl. - [ ("caml_leave_blocking_section", - special [] @@ Lock { lock = DomainLock.runtime_lock; try_ = false; write - = true; return_on_success = true }) - ; ("caml_enter_blocking_section", - special [] @@ Unlock DomainLock.runtime_lock) - (* TODO: more functions here *) - ] + [ + ( "caml_leave_blocking_section" + , special [] + @@ Lock + { + lock= DomainLock.runtime_lock + ; try_= false + ; write= true + ; return_on_success= true + } + ) + ; ( "caml_enter_blocking_section" + , special [] @@ Unlock DomainLock.runtime_lock + ) + (* TODO: more functions here *) + ] module Cstub = struct - - let is_cstub_entry _ctx f = + let is_cstub_entry_svar svar = (* This relies on patcher having patched caml/misc.h in the copy used by the analyses, see 'camlprim-attr.patcher'. Normally CAMLprim *) - let is = ContextUtil.has_attribute "section" "goblint-ocaml-cstub" f.svar.vattr in - if tracing then ignore @@ tracel __MODULE__ "function %s is an OCaml C stub: %b" f.svar.vname is; + let is = + ContextUtil.has_attribute "section" "goblint-ocaml-cstub" svar.vattr + in + if tracing () then + tracel "function %s is an OCaml C stub: %b" svar.vname is ; is + let find_all file = + [] + |> foldGlobals file @@ fun acc -> function + | GFun ({svar; _}, _) when is_cstub_entry_svar svar -> svar.vname :: acc + | _ -> acc + + let is_cstub_entry _ctx f = is_cstub_entry_svar f.svar + let enter_cstub ctx _ = (* TODO: one CAMLprim can call another one, e.g. common in bytecode impl - that calls native, - so this should be a trylock, or there should be an outer function - locking and calling this. - For now take the lock here - *) - ctx.emit (Events.Lock (DomainLock.runtime_lock_event, true)); + that calls native, + so this should be a trylock, or there should be an outer function + locking and calling this. + For now take the lock here + *) + ctx.emit (Events.Lock (DomainLock.runtime_lock_event, true)) ; ctx.local let leave_cstub ctx _ = - ctx.emit (Events.Unlock DomainLock.runtime_lock_event); + ctx.emit (Events.Unlock DomainLock.runtime_lock_event) ; ctx.local let call_caml_runtime ctx f _arglist = - DomainLock.must_be_held ctx f.vname; + DomainLock.must_be_held ctx f.vname ; ctx.local end let is_ocaml_value_type = function - | TNamed ({ tname = "value"; _}, _) -> true - | _ -> false - -class exp_ocaml_value_extractor (acc: varinfo list ref) = object - inherit nopCilVisitor - - method! vvrbl var = - if is_ocaml_value_type var.vtype then - acc := var :: !acc; - SkipChildren -end + | TNamed ({tname= "value"; _}, _) -> + true + | _ -> + false + +class exp_ocaml_value_extractor (acc : varinfo list ref) = + object + inherit nopCilVisitor + + method! vvrbl v = + if tracing () then + tracel "checking value use %s, type %a" v.vname Cil.d_type v.vtype ; + if is_ocaml_value_type v.vtype then ( + acc := v :: !acc ; + SkipChildren + ) else + DoChildren + end let ocaml_values_of_exp exp = let values = ref [] in let visitor = new exp_ocaml_value_extractor values in - let (_:exp) = visitCilExpr visitor exp in + let (_ : exp) = visitCilExpr visitor exp in + !values + +class exp_ocaml_value_deref_extractor (acc : varinfo list ref) = + object + inherit nopCilVisitor + + method! vlval = + function + | Mem exp, _ -> + if tracing () then + tracel "checking exp %a" Cil.d_exp exp ; + let ocaml_values = ocaml_values_of_exp exp in + acc := List.rev_append ocaml_values !acc ; + DoChildren + | _ -> + DoChildren + end + +let ocaml_value_derefs_of_exp exp = + let values = ref [] in + let visitor = new exp_ocaml_value_deref_extractor values in + let (_ : exp) = visitCilExpr visitor exp in !values -module Spec : Analyses.MCPSpec = -struct +module Spec : Analyses.MCPSpec = struct let name () = "ocamlcstubs" module D = Lattice.Unit module C = D + let startstate _v = D.bot () + let exitstate _v = D.top () include Analyses.IdentitySpec let body ctx f = (* TODO: set ctx bool that we're inside cstub, to avoid false positives on - runtime inline functions *) + runtime inline functions *) if Cstub.is_cstub_entry ctx f then Cstub.enter_cstub ctx f - else ctx.local + else + ctx.local - let return ctx _ (f:fundec) = - if Cstub.is_cstub_entry ctx f then - Cstub.leave_cstub ctx f - else ctx.local - - let special (ctx:(D.t, G.t, C.t,V.t) ctx) (_lval: lval option) (f:varinfo) (arglist:exp list) = - if tracing then - ignore @@ tracel __MODULE__ "special(%s)" f.vname; - if String.starts_with f.vname "caml_" && f.vname <> "caml_leave_blocking_section" then - (* call into OCaml runtime system, must hold domain lock *) - Cstub.call_caml_runtime ctx f arglist - else ctx.local + let return ctx _ (f : fundec) = + if Cstub.is_cstub_entry ctx f then + Cstub.leave_cstub ctx f + else + ctx.local + + let special (ctx : (D.t, G.t, C.t, V.t) ctx) (_lval : lval option) + (f : varinfo) (arglist : exp list) = + if tracing () then + tracel "special(%s)" f.vname ; + match f.vname with + | "caml_leave_blocking_section" -> + ctx.local + | "caml_alloc_custom" -> + let local = Cstub.call_caml_runtime ctx f arglist in + (* TODO: find functions in struct and register as C stub roots... *) + () + | n when String.starts_with n "caml_" -> + (* call into OCaml runtime system, must hold domain lock *) + Cstub.call_caml_runtime ctx f arglist + | _ -> + ctx.local let event ctx e _octx = match e with - | Events.Access {exp; kind; reach; _} -> + | Events.Access {exp; kind= AccessKind.(Read | Write) as kind; reach; _} -> (* TODO: only for pointers *) - if tracing then - ignore @@ tracel __MODULE__ "access %a, kind %a, reach %b" Cil.d_exp exp AccessKind.pretty kind reach; + if tracing () then + tracel "access %a, kind %a, reach %b" Cil.d_exp exp AccessKind.pretty + kind reach ; (* TODO: reject free and spawn kinds? *) - exp |> ocaml_values_of_exp |> - List.iter @@ DomainLock.must_be_protected_by ctx (kind = AccessKind.Write); + exp + |> ocaml_value_derefs_of_exp + |> List.iter + @@ DomainLock.must_be_protected_by ctx (kind = AccessKind.Write) ; + ctx.local + | _ -> ctx.local - | _ -> ctx.local end let () = - LibraryFunctions.register_library_functions ocaml_runtime_functions; - MCP.register_analysis ~dep:["access"] (module Spec : MCPSpec) + LibraryFunctions.register_library_functions ocaml_runtime_functions ; + MCP.register_analysis + ~dep:[AccessAnalysis.Spec.name ()] + (module Spec : MCPSpec) diff --git a/ocaml/staticanalyzer/goblint.ml b/ocaml/staticanalyzer/goblint.ml deleted file mode 100644 index 8dc2e3b00f1..00000000000 --- a/ocaml/staticanalyzer/goblint.ml +++ /dev/null @@ -1,87 +0,0 @@ -open Goblint_lib -open GobConfig -open Goblintutil -open Maingoblint -open Prelude -open Printf - -(** the main function *) -let main () = - try - Cilfacade.init (); - Maingoblint.parse_arguments (); - - (* Timing. *) - Maingoblint.reset_stats (); - if get_bool "dbg.timing.enabled" then ( - let tef_filename = get_string "dbg.timing.tef" in - if tef_filename <> "" then - Goblint_timing.setup_tef tef_filename; - Timing.Default.start { - cputime = true; - walltime = true; - allocated = true; - count = true; - tef = true; - }; - Timing.Program.start { - cputime = false; - walltime = false; - allocated = false; - count = false; - tef = true; - } - ); - - handle_extraspecials (); - GoblintDir.init (); - - if get_bool "dbg.verbose" then ( - print_endline (localtime ()); - print_endline Goblintutil.command_line; - ); - let file = lazy (Fun.protect ~finally:GoblintDir.finalize preprocess_parse_merge) in - if get_bool "server.enabled" then ( - let file = - if get_bool "server.reparse" then - None - else - Some (Lazy.force file) - in - Server.start file - ) - else ( - let file = Lazy.force file in - let changeInfo = - if GobConfig.get_bool "incremental.load" || GobConfig.get_bool "incremental.save" then - diff_and_rename file - else - Analyses.empty_increment_data () - in - if get_bool "ana.autotune.enabled" then AutoTune.chooseConfig file; - file |> do_analyze changeInfo; - do_html_output (); - do_gobview (); - do_stats (); - Goblint_timing.teardown_tef (); - if !verified = Some false then exit 3 (* verifier failed! *) - ) - with - | Exit -> - do_stats (); - Goblint_timing.teardown_tef (); - exit 1 - | Sys.Break -> (* raised on Ctrl-C if `Sys.catch_break true` *) - do_stats (); - (* Printexc.print_backtrace BatInnerIO.stderr *) - eprintf "%s\n" (MessageUtil.colorize ~fd:Unix.stderr ("{RED}Analysis was aborted by SIGINT (Ctrl-C)!")); - Goblint_timing.teardown_tef (); - exit 131 (* same exit code as without `Sys.catch_break true`, otherwise 0 *) - | Timeout -> - do_stats (); - eprintf "%s\n" (MessageUtil.colorize ~fd:Unix.stderr ("{RED}Analysis was aborted because it reached the set timeout of " ^ get_string "dbg.timeout" ^ " or was signalled SIGPROF!")); - Goblint_timing.teardown_tef (); - exit 124 - -(* We do this since the evaluation order of top-level bindings is not defined, but we want `main` to run after all the other side-effects (e.g. registering analyses/solvers) have happened. *) -let () = at_exit main diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml index b1bc1ce9b92..bf666493b46 100644 --- a/ocaml/staticanalyzer/lintcstubs.ml +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -1,9 +1,98 @@ -(* goblint.ml is a copy of the one in goblint itself - (it is not exposed in a library, although most of its functionality is - exposed through Maingoblint) +open Goblint_lib - We'll link any custom analysis by using dune's linkall features: - they will register themselves on startup. +(** [set_default_flags ()] initializes goblint with flags suitable for parsing OCaml C stubs *) +let set_default_flags () = + (* all the flag names are documented in the JSON schema at: + https://github.com/goblint/analyzer/blob/v2.1.0/src/util/options.schema.json + + list options can modified by adding with [+] or removing with [-] + *) + let open GobConfig in + (* workaround for incomplete C11 support, CIL only implements the GCC + attribute, not the C11 one: + https://github.com/goblint/cil/issues/13#issuecomment-1359176037 + + [pre.cppflags]: Pre-processing parameters (that you'd pass to [cpp]) + *) + set_auto "pre.cppflags[+]" "-D_Alignas(x)=__attribute__((__aligned__(x)))" ; + + (* activate our own analyses + + [ana.activated]: List of activated analyses + *) + set_auto "ana.activated[+]" @@ Lintcstubs_analysis.Ocamlcstubs.Spec.name () ; + + (* do not disable multithreaded analysis, even though there are no thread + creations in sight: we want to treat stubs as multi-threaded + + [ana.autotune.activated]: List of activated tuning options. By default all + are activated. + *) + set_auto "ana.autotune.activated[-]" "singleThreaded" + +(** [enable_tracing_if_needed ()] enables tracing messages in our analyses + if enabled on the CLI with [dbg.trace]. + *) +let enable_tracing_if_needed () = + if Lintcstubs_analysis.Ocamlcstubs.tracing () then + Tracing.addsystem Lintcstubs_analysis.Ocamlcstubs.trace_name + +(** [set_entrypoints file] finds all the C stubs and uses them as entrypoints + for the analyses. + + We don't want to use all non-static functions as entrypoints because we'd + get a lot of false positives about NULL dereferences, etc. but we know + those other functions can only be called from the C stubs. + + And without any entrypoints goblint would refuse to run. *) +let set_entrypoints file = + let cstubs = Lintcstubs_analysis.Ocamlcstubs.Cstub.find_all file in + GobConfig.set_list "otherfun" (cstubs |> List.map @@ fun fn -> `String fn) + +(** [with_goblint_tmpdir f] creates the [.goblint] temporary directory, runs + [f] and cleans up *) +let with_goblint_tmpdir f = + GoblintDir.init () ; + Fun.protect ~finally:GoblintDir.finalize f + +(** [report_results ()] reports the results in the configured formats. + Errors/warnings are reported immediately on standard output channels, + but additional formats can be requested. + + [--g2html] can be used on the CLI to request html output. + [--enable gobview --set save_run DIR] can be used to request [gobview] + output into [DIR] + + See https://goblint.readthedocs.io/en/latest/user-guide/inspecting/ + on how to view the output. + + If the verification fails then also set the tool's exitcode appropriately. + *) +let report_results () = + Maingoblint.do_html_output () ; + (* if [--enable gobview --set save_run DIR] is used output extra information + for [gobview] into [DIR]. *) + Maingoblint.do_gobview () ; + if !Goblintutil.verified = Some false then exit 3 (* verifier failed! *) + +(** [main ()] entrypoint for our C stub static analyzer. + + Compared to [goblint.ml] this is simplified to bare minimum: no timing + stats, no server mode. + *) +let main () = + Cilfacade.init () ; + set_default_flags () ; + (* for now we use goblint's CLI *) + Maingoblint.parse_arguments () ; + enable_tracing_if_needed () ; + let file = with_goblint_tmpdir Maingoblint.preprocess_parse_merge in + set_entrypoints file ; + AutoTune.chooseConfig file ; + file |> Maingoblint.do_analyze @@ Analyses.empty_increment_data () ; + report_results () -let main = Goblint.main +(* Based on goblint.ml: + We do this since the evaluation order of top-level bindings is not defined, but we want `main` to run after all the other side-effects (e.g. registering analyses/solvers) have happened. *) +let () = at_exit main From 236916f1e99c03b65a456c0b8d6b29b52c6e1000 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 5 Jan 2023 16:42:44 +0000 Subject: [PATCH 30/75] cstubs --- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 148 ++++++++++++++++++- ocaml/staticanalyzer/lintcstubs.ml | 2 +- 2 files changed, 143 insertions(+), 7 deletions(-) diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 41d0e32b03d..25304284f62 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -27,7 +27,7 @@ module DomainLock = struct let runtime_lock = AddrOf (Cil.var runtime_lock_var) - let must_be_held ctx name = + let must_be_held ctx what name = let lockset = ctx.ask Queries.MustLockset in if tracing () then tracel "OCaml domain lock must be held, current lockset is %a" @@ -37,7 +37,7 @@ module DomainLock = struct a better warning message: is the lock maybe held on some paths, or surely not held? *) Messages.error ~category:Messages.Category.Race - "DomainLock: must be held when calling OCaml runtime function %s" name ; + "DomainLock: must be held when %s %s" what name ; ctx.local let must_be_protected_by ctx write (arg : varinfo) = @@ -61,12 +61,28 @@ module DomainLock = struct arg.vname write must ; (* sometimes the must above answers true even if the domain lock is not held? *) - must_be_held ctx arg.vname ; + must_be_held ctx "dereferencing OCaml value" arg.vname ; (* TODO: this should say accessing OCaml value, not runtime function *) ctx.local end +let size_of_word = SizeOf voidPtrType + +let plus1 exp = constFoldBinOp true PlusA exp (kinteger IULong 1) ulongType + +let plus_word exp = constFoldBinOp true PlusA exp size_of_word ulongType + +let caml_alloc count = + LibraryDesc.Calloc {count= plus1 count; size= size_of_word} + +(* uninit return *) +let caml_malloc count = + LibraryDesc.Malloc + (constFoldBinOp true Mult (plus1 count) size_of_word ulongType) + +(* TODO: mark values as not null *) + let ocaml_runtime_functions : (string * LibraryDesc.t) list = LibraryDsl. [ @@ -84,8 +100,50 @@ let ocaml_runtime_functions : (string * LibraryDesc.t) list = , special [] @@ Unlock DomainLock.runtime_lock ) (* TODO: more functions here *) + ; ("caml_failwith", special [drop "message" [r]] Abort) + ; ("caml_raise_with_string", special [drop "tag" []; drop "msg" [r]] Abort) + ; ("caml_raise_out_of_memory", special [] Abort) + ; ("caml_invalid_argument", special [drop "msg" [r]] Abort) + ; ( "caml_alloc_custom" + , special + [drop "ops" [r]; __ "sizeof" []; drop "n" []; drop "m" []] + caml_alloc + ) + ; ("caml_alloc", special [__ "sizeof" []; drop "tag" []] caml_alloc) + ; ("caml_alloc_tuple", special [__ "sizeof" []] caml_alloc) + ; ("caml_alloc_small", special [__ "sizeof" []; drop "tag" []] caml_malloc) + ; ( "caml_copy_int64" + , special [drop "int" []] + @@ Calloc + { + count= constFoldBinOp true PlusA size_of_word (integer 8) uintType + ; size= one + } + ) + ; ( "caml_copy_int32" + , special [drop "int" []] + @@ Calloc + { + count= constFoldBinOp true PlusA size_of_word (integer 4) uintType + ; size= one + } + ) + ; ( "caml_copy_nativeint" + , special [drop "int" []] @@ Calloc {count= integer 2; size= size_of_word} + ) + ; ( "caml_copy_string" + , unknown [drop "str" [r]] (* TODO: allocates string length *) + ) + ; ("caml_modify", unknown [drop "dest" [w]; drop "src" []]) + ; ("caml_named_value", unknown [drop "name" [r]]) + (* TODO: also extra padding at end *) + ; ( "caml_alloc_string" + , special [__ "size_bytes" []] @@ fun size -> Malloc (plus_word size) + ) ] +let cstubs = ref [] + module Cstub = struct let is_cstub_entry_svar svar = (* This relies on patcher having patched caml/misc.h in the copy used by @@ -94,6 +152,7 @@ module Cstub = struct *) let is = ContextUtil.has_attribute "section" "goblint-ocaml-cstub" svar.vattr + || List.mem svar.vname !cstubs in if tracing () then tracel "function %s is an OCaml C stub: %b" svar.vname is ; @@ -122,7 +181,7 @@ module Cstub = struct ctx.local let call_caml_runtime ctx f _arglist = - DomainLock.must_be_held ctx f.vname ; + DomainLock.must_be_held ctx "calling OCaml runtime function" f.vname ; ctx.local end @@ -174,6 +233,34 @@ let ocaml_value_derefs_of_exp exp = let (_ : exp) = visitCilExpr visitor exp in !values +class init_visitor ask (acc : Lval.CilLval.t list ref) = + object + inherit nopCilVisitor + + method! vinit _ _ = + function + | SingleInit e -> + let typ = typeOf e in + if tracing () then + tracel "initializer %a (type %a)" Cil.d_exp e Cil.d_type typ ; + if isFunctionType typ then ( + let lvals = ask Queries.(MayPointTo e) in + if tracing () then + tracel "initializer %a may point to %a" Cil.d_exp e + Queries.LS.pretty lvals ; + acc := List.rev_append (Queries.LS.elements lvals) !acc + ) ; + SkipChildren + | CompoundInit _ -> + DoChildren + end + +let rec function_ptrs_of_init acc = function + | SingleInit e -> + e :: acc + | CompoundInit (_, lst) -> + lst |> List.map snd |> List.fold_left function_ptrs_of_init acc + module Spec : Analyses.MCPSpec = struct let name () = "ocamlcstubs" @@ -209,8 +296,45 @@ module Spec : Analyses.MCPSpec = struct ctx.local | "caml_alloc_custom" -> let local = Cstub.call_caml_runtime ctx f arglist in + (* the argument may not be an immediate pointer to a global, + query the points-to analyses on where it actually points to *) + let custom_ops = ctx.ask Queries.(MayPointTo (List.nth arglist 0)) in + if tracing () then + tracel "caml_alloc_custom points to %a" Queries.LS.pretty custom_ops ; + let () = + if not @@ Queries.LS.is_top custom_ops then ( + (* it points somewhere, all the function pointers in that struct's + initializer should be treated as C stubs + therefore this should be a separate analysis that just determines + whether it is a C stub or not that runs before this one.... + this may be a global, but not necessarily + *) + custom_ops + |> Queries.LS.iter @@ function + | {vinit= {init= None}; _}, _ -> + () + | {vinit= {init= Some init}; _}, _ -> + let funptrs = + init + |> function_ptrs_of_init [] + |> List.map @@ fun exp -> ctx.ask (Queries.MayPointTo exp) + in + if tracing () then + tracel "found function pointers: %a" + (Pretty.d_list "," Queries.LS.pretty) + funptrs ; + funptrs + |> List.iter @@ fun funptr -> + let new_stubs = + funptr + |> Queries.LS.elements + |> List.map (fun (fn, _) -> fn.vname) + in + cstubs := List.rev_append new_stubs !cstubs + ) + in (* TODO: find functions in struct and register as C stub roots... *) - () + local | n when String.starts_with n "caml_" -> (* call into OCaml runtime system, must hold domain lock *) Cstub.call_caml_runtime ctx f arglist @@ -236,6 +360,18 @@ end let () = LibraryFunctions.register_library_functions ocaml_runtime_functions ; + (* have to declare dependencies on analyses that can provide answers to + the [ctx.ask Queries] and that generate the [Events] we need + *) MCP.register_analysis - ~dep:[AccessAnalysis.Spec.name ()] + ~dep: + [ + AccessAnalysis.Spec.name () (* for Events.Access *) + ; MutexAnalysis.Spec.name + () (* for Queries.{MustLockset, MustBeProtectedBy} *) + ; (let module M = (val Base.get_main ()) in + M.name () + ) + (* for Queries.MayPointTo *) + ] (module Spec : MCPSpec) diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml index bf666493b46..0377b1854e5 100644 --- a/ocaml/staticanalyzer/lintcstubs.ml +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -60,7 +60,7 @@ let with_goblint_tmpdir f = Errors/warnings are reported immediately on standard output channels, but additional formats can be requested. - [--g2html] can be used on the CLI to request html output. + [--html] can be used on the CLI to request html output to [result/] [--enable gobview --set save_run DIR] can be used to request [gobview] output into [DIR] From 922a99463017561ea7216703479cd92e1ec38576 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 6 Jan 2023 14:23:30 +0000 Subject: [PATCH 31/75] wip --- .github/workflows/main.yml | 7 +++++++ Makefile | 4 ++++ dune-project | 2 +- ocaml/dune | 29 +++++++++++++++++++++++++++++ ocaml/staticanalyzer/dune | 3 ++- ocaml/staticanalyzer/lintcstubs.ml | 2 +- ocaml/xapi.stdout.reference | 1 + xapi-datamodel.opam | 8 +------- xapi-lintcstubs.opam | 14 ++++++++++++++ 9 files changed, 60 insertions(+), 10 deletions(-) create mode 100644 ocaml/dune create mode 100644 ocaml/xapi.stdout.reference create mode 100644 xapi-lintcstubs.opam diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 49f0a56cfc5..8832a7a1775 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -82,6 +82,13 @@ jobs: - name: Build run: opam exec -- make + - name: Run static analyzer + run: opam exec -- make analyze + + - uses: github/codeql-actions/upload-sarif@v2 + - with: + sarif_file: _build/default/ocaml/xapi.sarif + - name: Run tests run: opam exec -- make test diff --git a/Makefile b/Makefile index 92f09c02cf3..d233a5a5910 100644 --- a/Makefile +++ b/Makefile @@ -23,6 +23,9 @@ check: clean: dune clean +analyze: + dune build --profile=$(PROFILE) ocaml/xapi.sarif + lint: dune build @python pylint --disable=line-too-long,too-few-public-methods,unused-argument,no-self-use,invalid-name,broad-except,protected-access,redefined-builtin,too-many-lines,wildcard-import,too-many-branches,too-many-arguments,unused-wildcard-import,raising-format-tuple,too-many-statements,duplicate-code _build/default/xapi-storage/python/xapi/storage/api/v5/*.py @@ -31,6 +34,7 @@ lint: test: dune runtest --profile=$(PROFILE) --no-buffer -j $(JOBS) dune build @runtest-python --profile=$(PROFILE) + dune build @analyze --profile=$(PROFILE) stresstest: dune build @stresstest --profile=$(PROFILE) --no-buffer -j $(JOBS) diff --git a/dune-project b/dune-project index 78daeb45066..9e9cb189a5a 100644 --- a/dune-project +++ b/dune-project @@ -1,3 +1,3 @@ -(lang dune 2.0) +(lang dune 3.0) (formatting (enabled_for ocaml)) diff --git a/ocaml/dune b/ocaml/dune new file mode 100644 index 00000000000..d1b97c67f36 --- /dev/null +++ b/ocaml/dune @@ -0,0 +1,29 @@ +(rule + (with-stdout-to ctypesdir (run dirname %{lib:ctypes:cstubs_internals.h})) +) + +(rule + (targets xapi.sarif lintcstubs.stdout) + (deps + (:auth (glob_files auth/*.h)) + (:cstubs (glob_files_rec *_stubs.c))) + + ; enable only errors from our analyses + (action + (progn + (run rm -f goblint.sarif) + (run ln -s %{read-lines:ctypesdir} ctypes) + (with-stdout-to lintcstubs.stdout (run staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info + --disable warn.behavior + --disable warn.warning --disable warn.unsound --disable warn.imprecise --set ana.activated + "[\"base\",\"mallocWrapper\",\"escape\",\"mutex\",\"mutexEvents\",\"access\",\"ocamlcstubs\"]" + --sarif -I %{ocaml_where} -I staticanalyzer/destpatch/gcc_11 + -I auth -I ctypes + %{cstubs})))) + ) + +(rule + (alias analyze) + (deps lintcstubs.stdout) + (action (diff xapi.stdout.reference %{deps})) +) diff --git a/ocaml/staticanalyzer/dune b/ocaml/staticanalyzer/dune index 91446e67e63..8d154276ce5 100644 --- a/ocaml/staticanalyzer/dune +++ b/ocaml/staticanalyzer/dune @@ -1,7 +1,8 @@ (executable - (name lintcstubs) + (public_name lintcstubs) (libraries lintcstubs_analysis goblint.sites.dune) (flags :standard -linkall) + (package xapi-lintcstubs) ) ; TODO: copy $(ocamlc -where) to a destpatch, diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml index 0377b1854e5..8bbbd140e31 100644 --- a/ocaml/staticanalyzer/lintcstubs.ml +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -89,7 +89,7 @@ let main () = enable_tracing_if_needed () ; let file = with_goblint_tmpdir Maingoblint.preprocess_parse_merge in set_entrypoints file ; - AutoTune.chooseConfig file ; + (* AutoTune.chooseConfig file ; *) file |> Maingoblint.do_analyze @@ Analyses.empty_increment_data () ; report_results () diff --git a/ocaml/xapi.stdout.reference b/ocaml/xapi.stdout.reference new file mode 100644 index 00000000000..ab2648dd2e1 --- /dev/null +++ b/ocaml/xapi.stdout.reference @@ -0,0 +1 @@ +Writing Sarif to file: xapi.sarif diff --git a/xapi-datamodel.opam b/xapi-datamodel.opam index 4fdf0775775..2f8e64c9d8b 100644 --- a/xapi-datamodel.opam +++ b/xapi-datamodel.opam @@ -22,10 +22,4 @@ depends: [ "xapi-stdext-std" "xapi-stdext-unix" ] -synopsis: "The xapi toolstack daemon which implements the XenAPI" -description: """ -This daemon exposes the XenAPI and is used by clients such as 'xe' -and 'XenCenter' to manage clusters of Xen-enabled hosts.""" -url { - src: "https://github.com/xapi-project/xen-api/archive/master.tar.gz" -} +synopsis: "OCaml C stubs static analyzer" diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam new file mode 100644 index 00000000000..6dfc31556ce --- /dev/null +++ b/xapi-lintcstubs.opam @@ -0,0 +1,14 @@ +opam-version: "2.0" +homepage: "https://github.com/xapi-project/xen-api" +bug-reports: "https://github.com/xapi-project/xen-api/issues" +dev-repo: "git+https://github.com/xapi-project/xen-api.git" +build: [ + ["dune" "build" "-p" name "-j" jobs ] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +depends: [ + "ocaml" + "dune" {build & >= "3.0"} + "goblint" +] +synopsis: "OCaml C stub static analyzer" From 7d885d3d5a12cae6cce0d9d7049deb44418a0783 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 6 Jan 2023 14:33:40 +0000 Subject: [PATCH 32/75] wip --- ocaml/dune | 4 ++-- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 24 ++++++++++---------- ocaml/staticanalyzer/lintcstubs.ml | 10 ++++++-- 3 files changed, 22 insertions(+), 16 deletions(-) diff --git a/ocaml/dune b/ocaml/dune index d1b97c67f36..bdfc6784a30 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -15,8 +15,8 @@ (run ln -s %{read-lines:ctypesdir} ctypes) (with-stdout-to lintcstubs.stdout (run staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info --disable warn.behavior - --disable warn.warning --disable warn.unsound --disable warn.imprecise --set ana.activated - "[\"base\",\"mallocWrapper\",\"escape\",\"mutex\",\"mutexEvents\",\"access\",\"ocamlcstubs\"]" + --disable warn.warning --disable warn.unsound --disable warn.imprecise + --set ana.activated "[\"ocamlcstubs\"]" --sarif -I %{ocaml_where} -I staticanalyzer/destpatch/gcc_11 -I auth -I ctypes %{cstubs})))) diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 25304284f62..1eb7d86c333 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -358,20 +358,20 @@ module Spec : Analyses.MCPSpec = struct ctx.local end +let dep = + [ + AccessAnalysis.Spec.name () (* for Events.Access *) + ; MutexAnalysis.Spec.name + () (* for Queries.{MustLockset, MustBeProtectedBy} *) + ; (let module M = (val Base.get_main ()) in + M.name () + ) + (* for Queries.MayPointTo *) + ] + let () = LibraryFunctions.register_library_functions ocaml_runtime_functions ; (* have to declare dependencies on analyses that can provide answers to the [ctx.ask Queries] and that generate the [Events] we need *) - MCP.register_analysis - ~dep: - [ - AccessAnalysis.Spec.name () (* for Events.Access *) - ; MutexAnalysis.Spec.name - () (* for Queries.{MustLockset, MustBeProtectedBy} *) - ; (let module M = (val Base.get_main ()) in - M.name () - ) - (* for Queries.MayPointTo *) - ] - (module Spec : MCPSpec) + MCP.register_analysis ~dep (module Spec : MCPSpec) diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml index 8bbbd140e31..c4f76bb477c 100644 --- a/ocaml/staticanalyzer/lintcstubs.ml +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -1,5 +1,11 @@ open Goblint_lib +let rec activate name = + let id = MCPRegistry.find_id name in + let deps = (MCPRegistry.find_spec id).dep in + List.iter activate deps ; + GobConfig.set_auto "ana.activated[+]" name + (** [set_default_flags ()] initializes goblint with flags suitable for parsing OCaml C stubs *) let set_default_flags () = (* all the flag names are documented in the JSON schema at: @@ -20,7 +26,7 @@ let set_default_flags () = [ana.activated]: List of activated analyses *) - set_auto "ana.activated[+]" @@ Lintcstubs_analysis.Ocamlcstubs.Spec.name () ; + activate @@ Lintcstubs_analysis.Ocamlcstubs.Spec.name () ; (* do not disable multithreaded analysis, even though there are no thread creations in sight: we want to treat stubs as multi-threaded @@ -83,9 +89,9 @@ let report_results () = *) let main () = Cilfacade.init () ; - set_default_flags () ; (* for now we use goblint's CLI *) Maingoblint.parse_arguments () ; + set_default_flags () ; enable_tracing_if_needed () ; let file = with_goblint_tmpdir Maingoblint.preprocess_parse_merge in set_entrypoints file ; From 5a88ba73c5b4eeec6ce3072b8a4579351e098d91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 6 Jan 2023 14:56:58 +0000 Subject: [PATCH 33/75] tools/ocaml: register exceptions always MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- ocaml/dune | 18 ++++---- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 2 + ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 48 +++++++++++++------- 3 files changed, 43 insertions(+), 25 deletions(-) diff --git a/ocaml/dune b/ocaml/dune index bdfc6784a30..b59757e4a98 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -3,7 +3,7 @@ ) (rule - (targets xapi.sarif lintcstubs.stdout) + (targets xapi.sarif lintcstubs.stdout lintcstubs.stderr) (deps (:auth (glob_files auth/*.h)) (:cstubs (glob_files_rec *_stubs.c))) @@ -13,13 +13,15 @@ (progn (run rm -f goblint.sarif) (run ln -s %{read-lines:ctypesdir} ctypes) - (with-stdout-to lintcstubs.stdout (run staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info - --disable warn.behavior - --disable warn.warning --disable warn.unsound --disable warn.imprecise - --set ana.activated "[\"ocamlcstubs\"]" - --sarif -I %{ocaml_where} -I staticanalyzer/destpatch/gcc_11 - -I auth -I ctypes - %{cstubs})))) + (with-stdout-to lintcstubs.stdout + (with-stderr-to lintcstubs.stderr + (run staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info + --disable warn.behavior + --disable warn.warning --disable warn.unsound --disable warn.imprecise + --set ana.activated "[\"ocamlcstubs\"]" + --sarif -I %{ocaml_where} -I staticanalyzer/destpatch/gcc_11 + -I auth -I ctypes + %{cstubs}))))) ) (rule diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 1eb7d86c333..7fc544b6654 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -363,10 +363,12 @@ let dep = AccessAnalysis.Spec.name () (* for Events.Access *) ; MutexAnalysis.Spec.name () (* for Queries.{MustLockset, MustBeProtectedBy} *) + ; MutexEventsAnalysis.Spec.name () (* for Events.Lock *) ; (let module M = (val Base.get_main ()) in M.name () ) (* for Queries.MayPointTo *) + ; ThreadEscape.Spec.name () (* without everything that gets its address taken is considered global *) ] let () = diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 58d2f418c83..f7e6f0dfca3 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -191,9 +191,10 @@ CAMLprim value stub_xenctrlext_domain_get_acpi_s_state(value xch, value domid) CAMLparam2(xch, domid); unsigned long v; int ret; + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - ret = xc_get_hvm_param(_H(xch), _D(domid), HVM_PARAM_ACPI_S_STATE, &v); + ret = xc_get_hvm_param(xc, _D(domid), HVM_PARAM_ACPI_S_STATE, &v); caml_leave_blocking_section(); if ( ret != 0 ) failwith_xc(_H(xch)); @@ -204,8 +205,9 @@ CAMLprim value stub_xenctrlext_domain_get_acpi_s_state(value xch, value domid) CAMLprim value stub_xenctrlext_domain_send_s3resume(value xch, value domid) { CAMLparam2(xch, domid); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - xcext_domain_send_s3resume(_H(xch), _D(domid)); + xcext_domain_send_s3resume(xc, _D(domid)); caml_leave_blocking_section(); CAMLreturn(Val_unit); } @@ -214,10 +216,11 @@ CAMLprim value stub_xenctrlext_domain_set_timer_mode(value xch, value id, value mode) { CAMLparam3(xch, id, mode); + xc_interface* xc = _H(xch); int ret; caml_enter_blocking_section(); - ret = xcext_domain_set_timer_mode(_H(xch), _D(id), Int_val(mode)); + ret = xcext_domain_set_timer_mode(xc, _D(id), Int_val(mode)); caml_leave_blocking_section(); if ( ret < 0 ) failwith_xc(_H(xch)); @@ -228,10 +231,11 @@ CAMLprim value stub_xenctrlext_get_max_nr_cpus(value xch) { CAMLparam1(xch); xc_physinfo_t c_physinfo; + xc_interface* xc = _H(xch); int r; caml_enter_blocking_section(); - r = xc_physinfo(_H(xch), &c_physinfo); + r = xc_physinfo(xc, &c_physinfo); caml_leave_blocking_section(); if ( r ) @@ -244,9 +248,10 @@ CAMLprim value stub_xenctrlext_domain_set_target(value xch, value domid, value target) { CAMLparam3(xch, domid, target); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int retval = xc_domain_set_target(_H(xch), _D(domid), _D(target)); + int retval = xc_domain_set_target(xc, _D(domid), _D(target)); caml_leave_blocking_section(); if ( retval ) failwith_xc(_H(xch)); @@ -257,9 +262,10 @@ CAMLprim value stub_xenctrlext_physdev_map_pirq(value xch, value domid, value irq) { CAMLparam3(xch, domid, irq); + xc_interface* xc = _H(xch); int pirq = Int_val(irq); caml_enter_blocking_section(); - int retval = xc_physdev_map_pirq(_H(xch), _D(domid), pirq, &pirq); + int retval = xc_physdev_map_pirq(xc, _D(domid), pirq, &pirq); caml_leave_blocking_section(); if ( retval ) failwith_xc(_H(xch)); @@ -270,8 +276,9 @@ CAMLprim value stub_xenctrlext_assign_device(value xch, value domid, value machine_sbdf, value flag) { CAMLparam4(xch, domid, machine_sbdf, flag); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int retval = xc_assign_device(_H(xch), _D(domid), Int_val(machine_sbdf), + int retval = xc_assign_device(xc, _D(domid), Int_val(machine_sbdf), Int_val(flag)); caml_leave_blocking_section(); if ( retval ) @@ -283,6 +290,7 @@ CAMLprim value stub_xenctrlext_deassign_device(value xch, value domid, value machine_sbdf) { CAMLparam3(xch, domid, machine_sbdf); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); int retval = xc_deassign_device(_H(xch), _D(domid), Int_val(machine_sbdf)); caml_leave_blocking_section(); @@ -300,8 +308,9 @@ CAMLprim value stub_xenctrlext_domid_quarantine(value unit) CAMLprim value stub_xenctrlext_domain_soft_reset(value xch, value domid) { CAMLparam2(xch, domid); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int retval = xc_domain_soft_reset(_H(xch), _D(domid)); + int retval = xc_domain_soft_reset(xc, _D(domid)); caml_leave_blocking_section(); if ( retval ) failwith_xc(_H(xch)); @@ -313,11 +322,12 @@ CAMLprim value stub_xenctrlext_domain_update_channels(value xch, value domid, value console_port) { CAMLparam4(xch, domid, store_port, console_port); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int retval = xc_set_hvm_param(_H(xch), _D(domid), HVM_PARAM_STORE_EVTCHN, + int retval = xc_set_hvm_param(xc, _D(domid), HVM_PARAM_STORE_EVTCHN, Int_val(store_port)); if ( !retval ) - retval = xc_set_hvm_param(_H(xch), _D(domid), HVM_PARAM_CONSOLE_EVTCHN, + retval = xc_set_hvm_param(xc, _D(domid), HVM_PARAM_CONSOLE_EVTCHN, Int_val(console_port)); caml_leave_blocking_section(); if ( retval ) @@ -329,8 +339,9 @@ CAMLprim value stub_xenctrlext_domain_update_channels(value xch, value domid, static int get_cpumap_len(value xch, value cpumap) { int ml_len = Wosize_val(cpumap); + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int xc_len = xc_get_max_cpus(_H(xch)); + int xc_len = xc_get_max_cpus(xc); caml_leave_blocking_section(); return (ml_len < xc_len ? ml_len : xc_len); @@ -342,10 +353,11 @@ CAMLprim value stub_xenctrlext_vcpu_setaffinity_soft(value xch, value domid, CAMLparam4(xch, domid, vcpu, cpumap); int i, len = get_cpumap_len(xch, cpumap); xc_cpumap_t c_cpumap; + xc_interface* xc = _H(xch); int retval; caml_enter_blocking_section(); - c_cpumap = xc_cpumap_alloc(_H(xch)); + c_cpumap = xc_cpumap_alloc(xc); caml_leave_blocking_section(); if ( c_cpumap == NULL ) failwith_xc(_H(xch)); @@ -356,7 +368,7 @@ CAMLprim value stub_xenctrlext_vcpu_setaffinity_soft(value xch, value domid, c_cpumap[i / 8] |= 1 << (i & 7); } caml_enter_blocking_section(); - retval = xc_vcpu_setaffinity(_H(xch), _D(domid), Int_val(vcpu), NULL, + retval = xc_vcpu_setaffinity(xc, _D(domid), Int_val(vcpu), NULL, c_cpumap, XEN_VCPUAFFINITY_SOFT); free(c_cpumap); caml_leave_blocking_section(); @@ -373,11 +385,12 @@ CAMLprim value stub_xenctrlext_numainfo(value xch) unsigned max_nodes = 0; xc_meminfo_t *meminfo = NULL; uint32_t *distance = NULL; + xc_interface* xc = _H(xch); unsigned i, j; int retval; caml_enter_blocking_section(); - retval = xc_numainfo(_H(xch), &max_nodes, NULL, NULL); + retval = xc_numainfo(xc, &max_nodes, NULL, NULL); caml_leave_blocking_section(); if ( retval < 0 ) failwith_xc(_H(xch)); @@ -392,7 +405,7 @@ CAMLprim value stub_xenctrlext_numainfo(value xch) } caml_enter_blocking_section(); - retval = xc_numainfo(_H(xch), &max_nodes, meminfo, distance); + retval = xc_numainfo(xc, &max_nodes, meminfo, distance); caml_leave_blocking_section(); if ( retval < 0 ) { @@ -436,9 +449,10 @@ CAMLprim value stub_xenctrlext_cputopoinfo(value xch) xc_cputopo_t *cputopo = NULL; unsigned max_cpus, i; int retval; + xc_interface* xc = _H(xch); caml_enter_blocking_section(); - retval = xc_cputopoinfo(_H(xch), &max_cpus, NULL); + retval = xc_cputopoinfo(xc, &max_cpus, NULL); caml_leave_blocking_section(); if ( retval < 0 ) failwith_xc(_H(xch)); @@ -448,7 +462,7 @@ CAMLprim value stub_xenctrlext_cputopoinfo(value xch) caml_raise_out_of_memory(); caml_enter_blocking_section(); - retval = xc_cputopoinfo(_H(xch), &max_cpus, cputopo); + retval = xc_cputopoinfo(xc, &max_cpus, cputopo); caml_leave_blocking_section(); if ( retval < 0 ) { From 70a2c16d21058203f8ddda5d5daa09f7316eab2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 6 Jan 2023 14:58:36 +0000 Subject: [PATCH 34/75] wip --- ocaml/dune | 1 + ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/ocaml/dune b/ocaml/dune index b59757e4a98..4d3a6190d40 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -21,6 +21,7 @@ --set ana.activated "[\"ocamlcstubs\"]" --sarif -I %{ocaml_where} -I staticanalyzer/destpatch/gcc_11 -I auth -I ctypes + ; --enable dbg.debug --enable dbg.verbose %{cstubs}))))) ) diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 7fc544b6654..3e5a72bae87 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -368,7 +368,8 @@ let dep = M.name () ) (* for Queries.MayPointTo *) - ; ThreadEscape.Spec.name () (* without everything that gets its address taken is considered global *) + ; ThreadEscape.Spec.name () + (* without everything that gets its address taken is considered global *) ] let () = From a93d74a487feaf850fe3fa87462abcdc8ce88092 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 6 Jan 2023 15:05:05 +0000 Subject: [PATCH 35/75] wip --- ocaml/dune | 12 +++++++----- ocaml/xapi.stdout.reference | 2 +- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 2 +- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/ocaml/dune b/ocaml/dune index 4d3a6190d40..418a5e12cf3 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -9,21 +9,23 @@ (:cstubs (glob_files_rec *_stubs.c))) ; enable only errors from our analyses + ; so that the paths in the .sarif will be correct a chdir is needed (action (progn (run rm -f goblint.sarif) (run ln -s %{read-lines:ctypesdir} ctypes) (with-stdout-to lintcstubs.stdout (with-stderr-to lintcstubs.stderr - (run staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info + (chdir %{project_root} + (run ocaml/staticanalyzer/lintcstubs.exe -o ocaml/xapi.sarif --disable warn.info --disable warn.behavior --disable warn.warning --disable warn.unsound --disable warn.imprecise --set ana.activated "[\"ocamlcstubs\"]" - --sarif -I %{ocaml_where} -I staticanalyzer/destpatch/gcc_11 - -I auth -I ctypes - ; --enable dbg.debug --enable dbg.verbose - %{cstubs}))))) + --sarif -I %{ocaml_where} -I ocaml/staticanalyzer/destpatch/gcc_11 + -I ocaml/auth -I ocaml/ctypes + %{cstubs})))))) ) + ; --enable dbg.debug --enable dbg.verbose (rule (alias analyze) diff --git a/ocaml/xapi.stdout.reference b/ocaml/xapi.stdout.reference index ab2648dd2e1..769e3524dfe 100644 --- a/ocaml/xapi.stdout.reference +++ b/ocaml/xapi.stdout.reference @@ -1 +1 @@ -Writing Sarif to file: xapi.sarif +Writing Sarif to file: ocaml/xapi.sarif diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index f7e6f0dfca3..780099680b8 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -292,7 +292,7 @@ CAMLprim value stub_xenctrlext_deassign_device(value xch, value domid, CAMLparam3(xch, domid, machine_sbdf); xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int retval = xc_deassign_device(_H(xch), _D(domid), Int_val(machine_sbdf)); + int retval = xc_deassign_device(xc, _D(domid), Int_val(machine_sbdf)); caml_leave_blocking_section(); if ( retval ) failwith_xc(_H(xch)); From 9731add813f64b33773f7bf333712ba9d10cd370 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 6 Jan 2023 15:29:01 +0000 Subject: [PATCH 36/75] wip --- .github/workflows/main.yml | 2 +- dune | 64 +++ dune-project | 3 +- ocaml/dune | 34 -- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 50 +- ocaml/staticanalyzer/arity/arity.t | 106 ++++ ocaml/staticanalyzer/arity/dune | 12 + ocaml/staticanalyzer/arity/dune-workspace.all | 9 + .../staticanalyzer/arity/lintcstubs_arity.ml | 158 ++++++ ocaml/staticanalyzer/genmain/arity.t | 106 ++++ ocaml/staticanalyzer/genmain/dune | 16 + .../staticanalyzer/genmain/dune-workspace.all | 9 + .../genmain/lintcstubs_genmain.ml | 188 +++++++ ocaml/staticanalyzer/model/dune | 10 + ocaml/staticanalyzer/model/dune-workspace.all | 9 + ocaml/staticanalyzer/model/include/goblint.h | 12 + ocaml/staticanalyzer/model/runtime.model.c | 501 ++++++++++++++++++ ocaml/vhd-tool/src/dune | 7 + ocaml/xenopsd/c_stubs/dune | 2 + ocaml/xenopsd/{lib => c_stubs}/sockopt.ml | 0 ocaml/xenopsd/{lib => c_stubs}/sockopt.mli | 0 ocaml/xenopsd/{xc => c_stubs}/tuntap.ml | 0 ocaml/xenopsd/{xc => c_stubs}/tuntap.mli | 0 ocaml/xenopsd/{xc => c_stubs}/xenctrlext.ml | 0 ocaml/xenopsd/{xc => c_stubs}/xenctrlext.mli | 0 xapi-lintcstubs.opam | 2 +- ....stdout.reference => xapi.stdout.reference | 0 27 files changed, 1220 insertions(+), 80 deletions(-) delete mode 100644 ocaml/dune create mode 100644 ocaml/staticanalyzer/arity/arity.t create mode 100644 ocaml/staticanalyzer/arity/dune create mode 100644 ocaml/staticanalyzer/arity/dune-workspace.all create mode 100644 ocaml/staticanalyzer/arity/lintcstubs_arity.ml create mode 100644 ocaml/staticanalyzer/genmain/arity.t create mode 100644 ocaml/staticanalyzer/genmain/dune create mode 100644 ocaml/staticanalyzer/genmain/dune-workspace.all create mode 100644 ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml create mode 100644 ocaml/staticanalyzer/model/dune create mode 100644 ocaml/staticanalyzer/model/dune-workspace.all create mode 100644 ocaml/staticanalyzer/model/include/goblint.h create mode 100644 ocaml/staticanalyzer/model/runtime.model.c rename ocaml/xenopsd/{lib => c_stubs}/sockopt.ml (100%) rename ocaml/xenopsd/{lib => c_stubs}/sockopt.mli (100%) rename ocaml/xenopsd/{xc => c_stubs}/tuntap.ml (100%) rename ocaml/xenopsd/{xc => c_stubs}/tuntap.mli (100%) rename ocaml/xenopsd/{xc => c_stubs}/xenctrlext.ml (100%) rename ocaml/xenopsd/{xc => c_stubs}/xenctrlext.mli (100%) rename ocaml/xapi.stdout.reference => xapi.stdout.reference (100%) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 8832a7a1775..4c3303d9dbe 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -87,7 +87,7 @@ jobs: - uses: github/codeql-actions/upload-sarif@v2 - with: - sarif_file: _build/default/ocaml/xapi.sarif + sarif_file: _build/default/xapi.sarif - name: Run tests run: opam exec -- make test diff --git a/dune b/dune index 1774031f056..f385da3131d 100644 --- a/dune +++ b/dune @@ -13,3 +13,67 @@ (executable (name configure) (libraries dune-configurator findlib cmdliner unix)) + + +(rule + (with-stdout-to ctypesdir (run dirname %{lib:ctypes:cstubs_internals.h})) +) + +; This is a single invocation but it is very quick (<0.2s), +; no need to parallelize, also output can be cached. +; Only depend on ML files that contain C stubs though, +; and these .ml also don't require preprocessing for easier use +(rule + (deps + ocaml/staticanalyzer/arity/lintcstubs_arity.exe + (:mlfiles + (glob_files ocaml/auth/*.ml) + (glob_files ocaml/libs/log/*.ml) + (glob_files ocaml/vhd-tool/src/channels.ml) + (glob_files ocaml/xenopsd/c_stubs/*.ml) + (glob_files ocaml/xxhash/lib/*.ml) + (glob_files unixpwd/src/*.ml) + )) + (action + (with-stdout-to primitives.h + (run ocaml/staticanalyzer/arity/lintcstubs_arity.exe %{mlfiles}) + )) +) + +; once we upgrade to Dune 3.x we can use glob_files_rec here +(rule + (targets xapi.sarif lintcstubs.stdout) + (deps + (:headers (glob_files ocaml/auth/*.h) (glob_files unixpwd/c/*.h) primitives.h) + (:runtime_model ocaml/staticanalyzer/model/runtime.model.c) + (:cstubs + (glob_files ocaml/auth/*.c) + (glob_files ocaml/libs/log/*.c) + (glob_files ocaml/vhd-tool/src/*.c) + (glob_files ocaml/xenopsd/c_stubs/*.c) + (glob_files unixpwd/c/*.c))) + + ; enable only errors from our analyses + ; so that the paths in the .sarif will be correct a chdir is needed + ; --disable warn.warning --disable warn.unsound --disable warn.imprecise + (action + (progn + (run rm -f goblint.sarif) + (run ln -s %{read-lines:ctypesdir} ctypes) + (with-stdout-to lintcstubs.stdout + (run ocaml/staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info + --disable warn.behavior + --set ana.activated "[\"ocamlcstubs\",\"escape\"]" + --sarif -I %{ocaml_where} + -I ocaml/auth -I ctypes -I unixpwd/c + %{runtime_model} + primitives.h + %{cstubs})))) + ) + ; --enable dbg.debug --enable dbg.verbose + +(rule + (alias analyze) + (deps lintcstubs.stdout) + (action (diff xapi.stdout.reference %{deps})) +) diff --git a/dune-project b/dune-project index 9e9cb189a5a..2bb8483a939 100644 --- a/dune-project +++ b/dune-project @@ -1,3 +1,4 @@ -(lang dune 3.0) +(lang dune 2.8) +(cram enable) (formatting (enabled_for ocaml)) diff --git a/ocaml/dune b/ocaml/dune deleted file mode 100644 index 418a5e12cf3..00000000000 --- a/ocaml/dune +++ /dev/null @@ -1,34 +0,0 @@ -(rule - (with-stdout-to ctypesdir (run dirname %{lib:ctypes:cstubs_internals.h})) -) - -(rule - (targets xapi.sarif lintcstubs.stdout lintcstubs.stderr) - (deps - (:auth (glob_files auth/*.h)) - (:cstubs (glob_files_rec *_stubs.c))) - - ; enable only errors from our analyses - ; so that the paths in the .sarif will be correct a chdir is needed - (action - (progn - (run rm -f goblint.sarif) - (run ln -s %{read-lines:ctypesdir} ctypes) - (with-stdout-to lintcstubs.stdout - (with-stderr-to lintcstubs.stderr - (chdir %{project_root} - (run ocaml/staticanalyzer/lintcstubs.exe -o ocaml/xapi.sarif --disable warn.info - --disable warn.behavior - --disable warn.warning --disable warn.unsound --disable warn.imprecise - --set ana.activated "[\"ocamlcstubs\"]" - --sarif -I %{ocaml_where} -I ocaml/staticanalyzer/destpatch/gcc_11 - -I ocaml/auth -I ocaml/ctypes - %{cstubs})))))) - ) - ; --enable dbg.debug --enable dbg.verbose - -(rule - (alias analyze) - (deps lintcstubs.stdout) - (action (diff xapi.stdout.reference %{deps})) -) diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 3e5a72bae87..4837726423a 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -83,6 +83,7 @@ let caml_malloc count = (* TODO: mark values as not null *) +(* TODO: use .c models instead *) let ocaml_runtime_functions : (string * LibraryDesc.t) list = LibraryDsl. [ @@ -99,47 +100,7 @@ let ocaml_runtime_functions : (string * LibraryDesc.t) list = ; ( "caml_enter_blocking_section" , special [] @@ Unlock DomainLock.runtime_lock ) - (* TODO: more functions here *) - ; ("caml_failwith", special [drop "message" [r]] Abort) - ; ("caml_raise_with_string", special [drop "tag" []; drop "msg" [r]] Abort) - ; ("caml_raise_out_of_memory", special [] Abort) - ; ("caml_invalid_argument", special [drop "msg" [r]] Abort) - ; ( "caml_alloc_custom" - , special - [drop "ops" [r]; __ "sizeof" []; drop "n" []; drop "m" []] - caml_alloc - ) - ; ("caml_alloc", special [__ "sizeof" []; drop "tag" []] caml_alloc) - ; ("caml_alloc_tuple", special [__ "sizeof" []] caml_alloc) - ; ("caml_alloc_small", special [__ "sizeof" []; drop "tag" []] caml_malloc) - ; ( "caml_copy_int64" - , special [drop "int" []] - @@ Calloc - { - count= constFoldBinOp true PlusA size_of_word (integer 8) uintType - ; size= one - } - ) - ; ( "caml_copy_int32" - , special [drop "int" []] - @@ Calloc - { - count= constFoldBinOp true PlusA size_of_word (integer 4) uintType - ; size= one - } - ) - ; ( "caml_copy_nativeint" - , special [drop "int" []] @@ Calloc {count= integer 2; size= size_of_word} - ) - ; ( "caml_copy_string" - , unknown [drop "str" [r]] (* TODO: allocates string length *) - ) - ; ("caml_modify", unknown [drop "dest" [w]; drop "src" []]) ; ("caml_named_value", unknown [drop "name" [r]]) - (* TODO: also extra padding at end *) - ; ( "caml_alloc_string" - , special [__ "size_bytes" []] @@ fun size -> Malloc (plus_word size) - ) ] let cstubs = ref [] @@ -292,6 +253,9 @@ module Spec : Analyses.MCPSpec = struct if tracing () then tracel "special(%s)" f.vname ; match f.vname with + | "caml_stat_free" -> + (* does not require runtime lock to be held! *) + ctx.local | "caml_leave_blocking_section" -> ctx.local | "caml_alloc_custom" -> @@ -360,7 +324,9 @@ end let dep = [ - AccessAnalysis.Spec.name () (* for Events.Access *) + ThreadEscape.Spec.name () + (* without everything that gets its address taken is considered global *) + ; AccessAnalysis.Spec.name () (* for Events.Access *) ; MutexAnalysis.Spec.name () (* for Queries.{MustLockset, MustBeProtectedBy} *) ; MutexEventsAnalysis.Spec.name () (* for Events.Lock *) @@ -368,8 +334,6 @@ let dep = M.name () ) (* for Queries.MayPointTo *) - ; ThreadEscape.Spec.name () - (* without everything that gets its address taken is considered global *) ] let () = diff --git a/ocaml/staticanalyzer/arity/arity.t b/ocaml/staticanalyzer/arity/arity.t new file mode 100644 index 00000000000..83ff21ceb15 --- /dev/null +++ b/ocaml/staticanalyzer/arity/arity.t @@ -0,0 +1,106 @@ +Test using the examples from the OCaml manual: https://v2.ocaml.org/manual/intfc.html +Type abbreviations are not expanded: + + $ cat >test.ml < external seek_in : in_channel -> int -> unit = "caml_ml_seek_in" + > external seek_in_pair: in_channel * int -> unit = "caml_ml_seek_in_pair" + > type int_endo = int -> int + > external f : int_endo -> int_endo = "f" + > external g : (int -> int) -> (int -> int) = "g" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value caml_ml_seek_in(value, value); + CAMLprim value caml_ml_seek_in_pair(value); + CAMLprim value f(value); + CAMLprim value g(value, value); + +With --verifier output a special attribute recognized by the static analyzer. +This is needed so it can find all the C stubs (CAMLprim is defined to empty in +headers, and thus normally disappears after preprocessing, +and the static analyzer works on preprocessed source code): + $ lintcstubs_arity --verifier test.ml + #define CAML_NAME_SPACE + #include + #undef CAMLprim + #define CAMLprim __attribute__((section("goblint-ocaml-cstub"))) + CAMLprim value caml_ml_seek_in(value, value); + CAMLprim value caml_ml_seek_in_pair(value); + CAMLprim value f(value); + CAMLprim value g(value, value); + + +Arity <= 5 is implemented directly: + $ cat >test.ml < external input : in_channel -> bytes -> int -> int -> int = "input" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value input(value, value, value, value); + +Arity > 5 is implemented differently in bytecode and native code: + $ cat >test.ml < external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int + > = "add_nat_bytecode" "add_nat_native" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value add_nat_native(value, value, value, value, value, value, value); + CAMLprim value add_nat_bytecode(value *argv, int argn); + +Native code can take some arguments unboxed, but that would require a typedtree +to be done correctly (it is possible to redefine 'type int = string'), so just print a warning here. + $ cat >test.ml < external foo + > : (float [@unboxed]) + > -> (float [@unboxed]) + > -> (float [@unboxed]) + > = "foo_byte" "foo" + > external foo : float -> float -> float = "foo2_byte" "foo2" [@@unboxed] + > external f : string -> (int [@untagged]) = "f_byte" "f" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + File "test.ml", lines 1-5, characters 0-18: + 1 | external foo + 2 | : (float [@unboxed]) + 3 | -> (float [@unboxed]) + 4 | -> (float [@unboxed]) + 5 | = "foo_byte" "foo" + Warning 22 [preprocessor]: Ignored primitive declaration "foo": has attributes + File "test.ml", line 6, characters 0-71: + 6 | external foo : float -> float -> float = "foo2_byte" "foo2" [@@unboxed] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning 22 [preprocessor]: Ignored primitive declaration "foo": has attributes + File "test.ml", line 7, characters 0-55: + 7 | external f : string -> (int [@untagged]) = "f_byte" "f" + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning 22 [preprocessor]: Ignored primitive declaration "f": has attributes + +Noalloc makes it possible to call C code directly, however unboxed is not +supported by this tool for the same reason as above: + $ cat >test.ml < external sqrt : float -> float = "caml_sqrt_float" "sqrt" + > [@@unboxed] [@@noalloc] + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + File "test.ml", lines 1-2, characters 0-23: + 1 | external sqrt : float -> float = "caml_sqrt_float" "sqrt" + 2 | [@@unboxed] [@@noalloc] + Warning 22 [preprocessor]: Ignored primitive declaration "sqrt": has attributes + +Noalloc can also be used without unboxed: + $ cat >test.ml < external unsafe_blit: t -> int -> t -> int -> int -> unit = + > "caml_floatarray_blit" [@@noalloc] + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value caml_floatarray_blit(value, value, value, value, value); diff --git a/ocaml/staticanalyzer/arity/dune b/ocaml/staticanalyzer/arity/dune new file mode 100644 index 00000000000..3669485845e --- /dev/null +++ b/ocaml/staticanalyzer/arity/dune @@ -0,0 +1,12 @@ +(executable + (public_name lintcstubs_arity) + (libraries compiler-libs.common) + (package xapi-lintcstubs) +) + +(cram (deps %{bin:lintcstubs_arity})) + +; Given a checkout of the OCaml source code the following can be used to check +; whether we covered most C stub declarations. +; It is expected to print some warnings, but must not fail: +; dune exec ./lintcstubs_arity.exe ~/git/ocaml/otherlibs/**/*.ml ~/git/ocaml/stdlib/**/*.ml diff --git a/ocaml/staticanalyzer/arity/dune-workspace.all b/ocaml/staticanalyzer/arity/dune-workspace.all new file mode 100644 index 00000000000..b1b4f25896f --- /dev/null +++ b/ocaml/staticanalyzer/arity/dune-workspace.all @@ -0,0 +1,9 @@ +(lang dune 2.7) +(context (opam (switch vanilla-4.08.1))) +(context (opam (switch vanilla-4.09.1))) +(context (opam (switch vanilla-4.10.2))) +(context (opam (switch vanilla-4.11.2))) +(context (opam (switch vanilla-4.12.1))) +(context (opam (switch vanilla-4.13.1))) +(context (opam (switch vanilla-4.14.1))) +(context (opam (switch vanilla-5.0.0))) diff --git a/ocaml/staticanalyzer/arity/lintcstubs_arity.ml b/ocaml/staticanalyzer/arity/lintcstubs_arity.ml new file mode 100644 index 00000000000..3ac16677d17 --- /dev/null +++ b/ocaml/staticanalyzer/arity/lintcstubs_arity.ml @@ -0,0 +1,158 @@ +(** Parse a .ml file, extract all 'external ...' primitives, + and print prototypes of C functions based on their number of arguments. + + If --verifier is specified then output attributes for [lintcstubs] to + recognize the C stubs as entry points. + + Uses compiler-libs, which has an unstable API that can change between + compiler versions, so extract only the minimal information needed here. + If this breaks with newer compiler versions then + ocaml-migrate-parsetree could be used. + Currently require a 4.08 AST minimum (although this could be relaxed with + migrate-parsetree). + + [ocamlc -dparsetree foo.ml] can be used to see how the parsetree looks + like. + *) +let verifier = ref false + +(** [spec] defines command line arguments parsed by [Arg.parse] *) +let spec = + [("--verifier", Arg.Set verifier, "output attributes for static analyzer")] + +let tool_name = Sys.executable_name + +let usage_msg = Printf.sprintf "%s [FILE.ml...]" tool_name + +(** [argity_of_type typ] returns the number of arguments for the function type [typ]. + + Type aliases are not expanded, and we only recurse on right hand side of + the type arrow. + @see examples in the manual. + *) +let rec arity_of_type = + let open Parsetree in + function + | {ptyp_desc= Ptyp_arrow (_, _t1, t2); _} -> 1 + arity_of_type t2 | _ -> 0 + +(** [print_c_prototype ~arity bytename nativename] prints C prototypes for + calls to user defined primitives implemented by [bytename] + (in bytecode mode) and [nativename] (in native code mode). + [arity] is the number of arguments, when <= 5 [bytename] and [nativename] + are the same. + + Does not support unboxed or untagged calls (filtered out by caller). +*) +let print_c_prototype ~arity bytename nativename = + let args = List.init arity @@ fun _ -> "value" in + let str_of_args args = String.concat ", " @@ List.rev args in + Printf.printf "CAMLprim value %s(%s);\n" nativename @@ str_of_args args ; + if arity <= 5 then + assert (bytename = nativename) + else + Printf.printf "CAMLprim value %s(value *argv, int argn);\n" bytename + +(** [warning loc fmt] prints a warning at source location [loc], + with message format defined by [fmt]. + *) +let warning loc = + Printf.ksprintf @@ fun msg -> + Location.prerr_warning loc (Preprocessor msg) + +(** [no_attrs typ] returns true if there are no attributes on the type + (components). + + @see +*) +let rec no_attrs = + let open Parsetree in + function + | {ptyp_attributes= _ :: _; _} -> + false + | {ptyp_desc= Ptyp_arrow (_, t1, t2); _} -> + no_attrs t1 && no_attrs t2 + | _ -> + true + +(** [value_description _ vd] is invoked by the AST iterator for value + descriptions, including primitives ('external ...'). + + @see +*) +let value_description _ vd = + let open Parsetree in + let arity = arity_of_type vd.pval_type in + match vd.pval_prim, vd.pval_attributes with + | [], _ -> () (* not a primitive *) + | _, ([] | [{attr_name= {txt= "noalloc"; _}; _}]) when no_attrs vd.pval_type -> ( + (* only process descriptions with no attributes, or with the [@@noalloc] + attribute: in these cases the C stub is always called with [value] + arguments. + *) + match vd.pval_prim with + | [] -> + () (* not a primitive *) + | builtin :: _ when builtin.[0] = '%' -> + () (* call to builtin primitive, no prototypes to print *) + | [cfunction] -> + print_c_prototype ~arity cfunction cfunction + | [bytecode_c_function; native_c_function] -> + print_c_prototype ~arity bytecode_c_function native_c_function + | _ -> + (* According to https://v2.ocaml.org/manual/intfc.html#ss:c-prim-decl + extra flags names are reserved for the standard library's use + *) + warning vd.pval_loc + "Ignored primitive declaration %S: flag names are not supported" + vd.pval_name.txt + ) + | _ -> + (* Would need a Typedtree to correctly interpret these, see + lintcstubs_cmt. + It is in theory possible to redefine builtin types like + 'type int = string', + thus we need the final, resolved type name to be sure. + In this tool just ignore them. + *) + warning vd.pval_loc "Ignored primitive declaration %S: has attributes" + vd.pval_name.txt + +let verifier_section = "goblint-ocaml-cstub" + +let () = + let files = + (* use Arg for parsing to minimize dependencies *) + let lst = ref [] in + Arg.parse spec (fun file -> lst := file :: !lst) usage_msg ; + !lst + in + (* [CAML_NAME_SPACE] is recommended by the manual *) + print_endline "#define CAML_NAME_SPACE" ; + (* get the definition of [value] *) + print_endline "#include " ; + + if !verifier then ( + print_endline "#undef CAMLprim" ; + (* The section name here must match the one used by the static analyzer, + TODO export as a variable + *) + Printf.printf {|#define CAMLprim __attribute__((section("%s")))|} + verifier_section ; + print_endline "" + ) ; + try + files + |> List.iter @@ fun path -> + let open Ast_iterator in + (* use the AST iterator, because primitives might be declared inside a + module, not necessarily at top level. *) + let primitives_iterator = {default_iterator with value_description} in + path + (* have to parse the implementation, because the .mli may hide that it + is a C stub by defining a 'val name ...' instead of 'external name ...'. *) + |> Pparse.parse_implementation ~tool_name + |> primitives_iterator.structure primitives_iterator + with e -> + (* if there are any syntax errors, or other exceptions escaping from + compiler-libs this will report them properly *) + Location.report_exception Format.err_formatter e diff --git a/ocaml/staticanalyzer/genmain/arity.t b/ocaml/staticanalyzer/genmain/arity.t new file mode 100644 index 00000000000..83ff21ceb15 --- /dev/null +++ b/ocaml/staticanalyzer/genmain/arity.t @@ -0,0 +1,106 @@ +Test using the examples from the OCaml manual: https://v2.ocaml.org/manual/intfc.html +Type abbreviations are not expanded: + + $ cat >test.ml < external seek_in : in_channel -> int -> unit = "caml_ml_seek_in" + > external seek_in_pair: in_channel * int -> unit = "caml_ml_seek_in_pair" + > type int_endo = int -> int + > external f : int_endo -> int_endo = "f" + > external g : (int -> int) -> (int -> int) = "g" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value caml_ml_seek_in(value, value); + CAMLprim value caml_ml_seek_in_pair(value); + CAMLprim value f(value); + CAMLprim value g(value, value); + +With --verifier output a special attribute recognized by the static analyzer. +This is needed so it can find all the C stubs (CAMLprim is defined to empty in +headers, and thus normally disappears after preprocessing, +and the static analyzer works on preprocessed source code): + $ lintcstubs_arity --verifier test.ml + #define CAML_NAME_SPACE + #include + #undef CAMLprim + #define CAMLprim __attribute__((section("goblint-ocaml-cstub"))) + CAMLprim value caml_ml_seek_in(value, value); + CAMLprim value caml_ml_seek_in_pair(value); + CAMLprim value f(value); + CAMLprim value g(value, value); + + +Arity <= 5 is implemented directly: + $ cat >test.ml < external input : in_channel -> bytes -> int -> int -> int = "input" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value input(value, value, value, value); + +Arity > 5 is implemented differently in bytecode and native code: + $ cat >test.ml < external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int + > = "add_nat_bytecode" "add_nat_native" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value add_nat_native(value, value, value, value, value, value, value); + CAMLprim value add_nat_bytecode(value *argv, int argn); + +Native code can take some arguments unboxed, but that would require a typedtree +to be done correctly (it is possible to redefine 'type int = string'), so just print a warning here. + $ cat >test.ml < external foo + > : (float [@unboxed]) + > -> (float [@unboxed]) + > -> (float [@unboxed]) + > = "foo_byte" "foo" + > external foo : float -> float -> float = "foo2_byte" "foo2" [@@unboxed] + > external f : string -> (int [@untagged]) = "f_byte" "f" + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + File "test.ml", lines 1-5, characters 0-18: + 1 | external foo + 2 | : (float [@unboxed]) + 3 | -> (float [@unboxed]) + 4 | -> (float [@unboxed]) + 5 | = "foo_byte" "foo" + Warning 22 [preprocessor]: Ignored primitive declaration "foo": has attributes + File "test.ml", line 6, characters 0-71: + 6 | external foo : float -> float -> float = "foo2_byte" "foo2" [@@unboxed] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning 22 [preprocessor]: Ignored primitive declaration "foo": has attributes + File "test.ml", line 7, characters 0-55: + 7 | external f : string -> (int [@untagged]) = "f_byte" "f" + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning 22 [preprocessor]: Ignored primitive declaration "f": has attributes + +Noalloc makes it possible to call C code directly, however unboxed is not +supported by this tool for the same reason as above: + $ cat >test.ml < external sqrt : float -> float = "caml_sqrt_float" "sqrt" + > [@@unboxed] [@@noalloc] + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + File "test.ml", lines 1-2, characters 0-23: + 1 | external sqrt : float -> float = "caml_sqrt_float" "sqrt" + 2 | [@@unboxed] [@@noalloc] + Warning 22 [preprocessor]: Ignored primitive declaration "sqrt": has attributes + +Noalloc can also be used without unboxed: + $ cat >test.ml < external unsafe_blit: t -> int -> t -> int -> int -> unit = + > "caml_floatarray_blit" [@@noalloc] + > EOF + $ lintcstubs_arity test.ml + #define CAML_NAME_SPACE + #include + CAMLprim value caml_floatarray_blit(value, value, value, value, value); diff --git a/ocaml/staticanalyzer/genmain/dune b/ocaml/staticanalyzer/genmain/dune new file mode 100644 index 00000000000..c17bafa3b5e --- /dev/null +++ b/ocaml/staticanalyzer/genmain/dune @@ -0,0 +1,16 @@ +(executable + (public_name lintcstubs_genmain) + (libraries compiler-libs.common) + (package xapi-lintcstubs) +) + +(cram (deps %{bin:lintcstubs_genmain})) + +(rule + (alias runtest) + (deps + (:cmt (glob_files %{ocaml_where}/*.cmt)) + (:linter %{bin:lintcstubs_genmain}) + ) + (action (run %{linter} %{cmt})) +) diff --git a/ocaml/staticanalyzer/genmain/dune-workspace.all b/ocaml/staticanalyzer/genmain/dune-workspace.all new file mode 100644 index 00000000000..b1b4f25896f --- /dev/null +++ b/ocaml/staticanalyzer/genmain/dune-workspace.all @@ -0,0 +1,9 @@ +(lang dune 2.7) +(context (opam (switch vanilla-4.08.1))) +(context (opam (switch vanilla-4.09.1))) +(context (opam (switch vanilla-4.10.2))) +(context (opam (switch vanilla-4.11.2))) +(context (opam (switch vanilla-4.12.1))) +(context (opam (switch vanilla-4.13.1))) +(context (opam (switch vanilla-4.14.1))) +(context (opam (switch vanilla-5.0.0))) diff --git a/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml b/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml new file mode 100644 index 00000000000..bba7f1966a1 --- /dev/null +++ b/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml @@ -0,0 +1,188 @@ +(** Load a .cmt file which contains a Typedtree, + and use it to extract primitives along with the shapes of their arguments, + and generate a 'main' function to call them all for the purpose of static + analysis. + + [ocamlc -dtypedtree foo.ml] can be used to see how the typedtree looks + like. + + A Typedtree is better than a Parsetree for this purpose because it contains + resolved types and type immediacy information from the compiler itself. + *) + +let tool_name = Sys.executable_name + +let usage_msg = Printf.sprintf "%s [FILE.cmt...]" tool_name + +(** [args_of_type typ] returns the sequence of arguments for the function type [typ]. + + Type aliases are not expanded, and we only recurse on right hand side of + the type arrow. + @see examples in the manual. + *) +let rec args_of_type = + let open Typedtree in + function + | {ctyp_desc= Ttyp_arrow (_, t1, t2); _} -> + fun () -> Seq.Cons (t1, args_of_type t2) + | t -> + Seq.return t + +let has_attr name lst = + (* typedtree attributes are the same as in parsetree *) + let open Parsetree in + Option.is_some (lst |> List.find_opt @@ fun attr -> attr.attr_name.txt = name) + +let ctype_of_ocaml ~is_unboxed = + let open Typedtree in + function + | {ctyp_desc= Ttyp_constr (path, _, _); ctyp_attributes; _} + when is_unboxed + || has_attr "unboxed" ctyp_attributes + || has_attr "untagged" ctyp_attributes -> + let is_predef = Path.same path in + if is_predef Predef.path_float then + "double" + else if is_predef Predef.path_int32 then + "int32" + else if is_predef Predef.path_int64 then + "int64" + else if is_predef Predef.path_nativeint then + "intnat" + else if is_predef Predef.path_int then + "intnat" + else + invalid_arg + @@ Format.asprintf "unknown type name for unboxed: %a" Path.print path + | {ctyp_attributes= []; _} -> + "value" + | {ctyp_attributes= attrs; _} -> + let attrnames = attrs |> List.map @@ fun a -> a.Parsetree.attr_name.txt in + invalid_arg + @@ Printf.sprintf "unknown attributes: %s" (String.concat ", " attrnames) + +(** [print_c_prototype ~arity bytename nativename] prints C prototypes for + calls to user defined primitives implemented by [bytename] + (in bytecode mode) and [nativename] (in native code mode). + [arity] is the number of arguments, when <= 5 [bytename] and [nativename] + are the same. + + Does not support unboxed or untagged calls (filtered out by caller). +*) +let print_c_prototype ~arity bytename nativename = + let args = List.init arity @@ fun _ -> "value" in + let str_of_args args = String.concat ", " @@ List.rev args in + Printf.printf "CAMLprim value %s(%s);\n" nativename @@ str_of_args args ; + if arity <= 5 then + assert (bytename = nativename) + else + Printf.printf "CAMLprim value %s(value *argv, int argn);\n" bytename + +(** [warning loc fmt] prints a warning at source location [loc], + with message format defined by [fmt]. + *) +let warning loc = + Printf.ksprintf @@ fun msg -> Location.prerr_warning loc (Preprocessor msg) + +(** [no_attrs typ] returns true if there are no attributes on the type + (components). + + @see +*) +let rec no_attrs = + let open Parsetree in + function + | {ptyp_attributes= _ :: _; _} -> + false + | {ptyp_desc= Ptyp_arrow (_, t1, t2); _} -> + no_attrs t1 && no_attrs t2 + | _ -> + true + + (* TODO: gen*) +let str_of_native_repr = + let open Primitive in + function + | Same_as_ocaml_repr -> + "value" + | Unboxed_float -> + "double" + | Unboxed_integer Pnativeint -> + "intnat" + | Unboxed_integer Pint32 -> + "int32_t" + | Unboxed_integer Pint64 -> + "int64_t" + | Untagged_int -> + "intnat" + +let primitive_description desc = + let open Primitive in + if native_name_is_external desc then ( + (* only process primitives defined by the user (not the compiler) *) + Printf.printf "void __call_%s(void) { %s result = %s(%s); }\n" + (native_name desc) + (str_of_native_repr desc.prim_native_repr_res) + (native_name desc) + @@ String.concat ", " + @@ List.map str_of_native_repr desc.prim_native_repr_args ; + let bytecode_args = + String.concat ", " @@ List.init desc.prim_arity @@ fun _ -> "__VERIFIER_nondet_value()" + in + (* only output bytecode call if different *) + if desc.prim_arity > 5 then + Printf.printf + "void __call_%s(void) { value argv[%d] = {%s}; value result =\n\ + \ %s(argv, %d);}\n" + desc.prim_name desc.prim_arity bytecode_args desc.prim_name + desc.prim_arity + else if + List.exists (( <> ) Same_as_ocaml_repr) desc.prim_native_repr_args + || desc.prim_native_repr_res <> Same_as_ocaml_repr + then + Printf.printf "void __call_%s(void) { value result = %s(%s);}\n" + desc.prim_name desc.prim_name bytecode_args + ) + +(** [value_description _ mc] is invoked by the TAST iterator for + value descriptions. + Recursively iterate until we find a [primitive_coercion]. +*) +let rec value_description _ vd = + let open Typedtree in + let open Types in + match vd.val_val.val_kind with + | Val_prim prim -> + primitive_description prim + | _ -> + () + +let verifier_section = "goblint-ocaml-cstub" + +let () = + let files = + (* use Arg for parsing to minimize dependencies *) + let lst = ref [] in + Arg.parse [] (fun file -> lst := file :: !lst) usage_msg ; + !lst + in + + print_endline {|#include "primitives.h"|} ; + try + files + |> List.iter @@ fun path -> + let open Tast_iterator in + path + (* have to parse the implementation, because the .mli may hide that it + is a C stub by defining a 'val name ...' instead of 'external name ...'. *) + |> Cmt_format.read_cmt + |> function + | Cmt_format.{cmt_annots= Implementation typedtree; _} -> + let iterator = {default_iterator with value_description} in + iterator.structure iterator typedtree + | _ -> + invalid_arg "not a .cmt file (missing implementation)" + with e -> + (* if there are any syntax errors, or other exceptions escaping from + compiler-libs this will report them properly *) + Location.report_exception Format.err_formatter e diff --git a/ocaml/staticanalyzer/model/dune b/ocaml/staticanalyzer/model/dune new file mode 100644 index 00000000000..3e31dbbfd7e --- /dev/null +++ b/ocaml/staticanalyzer/model/dune @@ -0,0 +1,10 @@ +; check that the model compiles with usual compiler +(library + (name modeltest) + (foreign_stubs + (language c) + (include_dirs include) + (names runtime.model) + ) + (package xapi-lintcstubs) +) diff --git a/ocaml/staticanalyzer/model/dune-workspace.all b/ocaml/staticanalyzer/model/dune-workspace.all new file mode 100644 index 00000000000..b1b4f25896f --- /dev/null +++ b/ocaml/staticanalyzer/model/dune-workspace.all @@ -0,0 +1,9 @@ +(lang dune 2.7) +(context (opam (switch vanilla-4.08.1))) +(context (opam (switch vanilla-4.09.1))) +(context (opam (switch vanilla-4.10.2))) +(context (opam (switch vanilla-4.11.2))) +(context (opam (switch vanilla-4.12.1))) +(context (opam (switch vanilla-4.13.1))) +(context (opam (switch vanilla-4.14.1))) +(context (opam (switch vanilla-5.0.0))) diff --git a/ocaml/staticanalyzer/model/include/goblint.h b/ocaml/staticanalyzer/model/include/goblint.h new file mode 100644 index 00000000000..7118946cc82 --- /dev/null +++ b/ocaml/staticanalyzer/model/include/goblint.h @@ -0,0 +1,12 @@ +/* from the goblint package, to simplify testing across multiple compiler + * versions we do not require goblint to be installed though, + * so have a local copy */ + +void __goblint_check(int exp); +void __goblint_assume(int exp); +void __goblint_assert(int exp); + +void __goblint_assume_join(/* pthread_t thread */); // undeclared argument to avoid pthread.h interfering with Linux kernel headers + +void __goblint_split_begin(int exp); +void __goblint_split_end(int exp); diff --git a/ocaml/staticanalyzer/model/runtime.model.c b/ocaml/staticanalyzer/model/runtime.model.c new file mode 100644 index 00000000000..372182d5172 --- /dev/null +++ b/ocaml/staticanalyzer/model/runtime.model.c @@ -0,0 +1,501 @@ +/* Describes the behaviour of OCaml C runtime functions for + * the goblint static analyzer. + * + * This only describes a simplified behaviour relevant to static analyses. + */ +#define DEBUG +#define CAML_NAME_SPACE +#include +#include +#include +#include +#include + +#include +#include +#include + +#include +#include + +#include + +#include +#include +#include +#include +#include + +#if OCAML_VERSION < 40800 +#error "static analysis model for OCaml runtime requires OCaml >= 4.08" +#endif +/* it'd require a lot more ifdefs to support older versions */ + +/* See + * https://goblint.readthedocs.io/en/stable/user-guide/annotating/#functions */ +#include + +int __VERIFIER_nondet_int(void); +#define STUB __attribute__((goblint_stub)) + +void caml_failed_assert(char *msg, char *os, int n) STUB +{ + /* always fail assertion when called by CAMLassert */ + assert(!msg); + assert(os); + (void)n; + abort(); +} + +/* very important to not have ';' before CAMLnoreturn_end, or the attribute + * doesn't end up on the function! + * Also this is just 'noreturn' instead of 'abort', because the entire program + * may not necessarily terminate, e.g. if there is an exception handler */ +CAMLnoreturn_start void __caml_exception_raised() CAMLnoreturn_end STUB; + +#define __access_Val(v) \ + do \ + { \ + if ( !Is_block(v) ) \ + (void)Tag_val(v); \ + } while ( 0 ) + +static header_t __atoms[Num_tags]; + +/* the static analyzer will ensure that all these caml_ functions check + * that the runtime lock is held, can't easily express that as an assertion + * (except with a trylock, but that is not modeled either) + */ + +value caml_alloc_atom(tag_t tag) STUB +{ + assert(tag < Num_tags); + header_t *hp = &__atoms[tag]; + __goblint_assume(*hp == Make_header(0, tag, 0)); + return Val_hp(hp); +} + +/* could be a linked list, for simplicity it is not. + * this should be enough for may-points-to analysis to pick up the ops */ +static struct +{ + const struct custom_operations *ops; + value v; +} a_custom_op; + +static int __custom_ops_running; + +static void __caml_maybe_run_finalizer(void) STUB +{ + const struct custom_operations *ops = a_custom_op.ops; + value v = a_custom_op.v; + uintnat bsize_32, bsize_64; + + if ( !ops || !Is_block(v) ) + return; + /* only call finalizer once */ + a_custom_op.ops = NULL; + a_custom_op.v = Val_unit; + __goblint_assume(Custom_ops_val(v) == ops); + + /* See https://v2.ocaml.org/manual/intfc.html#ss:c-custom-ops + * these functions are not allowed to trigger a GC */ + assert(!__custom_ops_running); + __custom_ops_running = 1; + /* Before finalizing check that other custom ops work if defined. + * However they can raise exceptions, so use a nondeterministic int + * to decide whether to call it or not, to ensure the finalizer is actually + * reachable. + * */ + if ( ops->compare && __VERIFIER_nondet_int() ) + (void)ops->compare(v, v); + if ( ops->compare_ext && __VERIFIER_nondet_int() ) + (void)ops->compare_ext(v, v); + if ( ops->hash && __VERIFIER_nondet_int() ) + (void)ops->hash(v); + if ( ops->serialize && __VERIFIER_nondet_int() ) + { + void *dst; + uintnat size; + ops->serialize(v, &bsize_32, &bsize_64); + size = sizeof(void *) == 8 ? bsize_64 : bsize_32; + dst = malloc(size); + if ( !dst ) + caml_raise_out_of_memory(); + if ( ops->deserialize && __VERIFIER_nondet_int() ) + { + uintnat ret = ops->deserialize(dst); + assert(ret == size); + /* should be initialized */ + (void)memchr(dst, 0, size); + } + free(dst); + + if ( ops->fixed_length ) + (void)*ops->fixed_length; + } + + if ( ops->finalize ) + ops->finalize(v); + __custom_ops_running = 0; +} + +static void __caml_move(value arg, volatile value *dest) STUB +{ + if ( !Is_block(arg) ) + return; + if ( arg == a_custom_op.v ) + { + /* reachable, remove it */ + a_custom_op.v = Val_unit; + a_custom_op.ops = NULL; + } + mlsize_t len = Bhsize_wosize(Wosize_val(arg)); + header_t *p = malloc(len); + if ( !p ) + caml_raise_out_of_memory(); + void *orig = Hp_val(arg); + memcpy(p, orig, len); + *dest = Val_hp(p); + free(orig); +} + +#ifndef CAML_LOCAL_ROOTS +#define CAML_LOCAL_ROOTS caml_local_roots +#endif + +/* anything can happen, including more allocations, etc. */ +static void __caml_maybe_run_gc(void) STUB +{ + if ( !__VERIFIER_nondet_int() ) + return; + + struct caml__roots_block *lr; + int i, j; + value *sp; + + for ( lr = CAML_LOCAL_ROOTS; lr != NULL; lr = lr->next ) + { + for ( i = 0; i < lr->ntables; i++ ) + { + for ( j = 0; j < lr->nitems; j++ ) + { + sp = &(lr->tables[i][j]); + if ( *sp != 0 ) + { + __caml_move(*sp, sp); + } + } + } + } + + __caml_maybe_run_finalizer(); +} + +value caml_alloc_shr(mlsize_t wosize, tag_t tag) STUB +{ + /* See https://v2.ocaml.org/manual/intfc.html#sss:c-simple-allocation + * have to use Atom(t) for 0 sized blocks */ + assert(wosize > 0); + assert(tag < Num_tags); + assert(wosize <= Max_wosize); + __caml_maybe_run_gc(); + /* Byte+header size from word size */ + value *p = malloc(Bhsize_wosize(wosize)); + if ( !p ) + caml_raise_out_of_memory(); + __goblint_assume(!((intnat)p & 1)); + Hd_hp(p) = Make_header(wosize, tag, 0); + + return Val_hp(p); +} + +value caml_alloc_small(mlsize_t wosize, tag_t tag) STUB +{ + assert(wosize <= Max_young_wosize); + /* alloc_small is just an optimization, + * so for the static analyzer these are equivalent */ + return caml_alloc_shr(wosize, tag); +} + +value caml_alloc(mlsize_t wosize, tag_t tag) STUB +{ + unsigned i; + value p = caml_alloc_shr(wosize, tag); + if ( tag < No_scan_tag ) + { + for ( i = 0; i < wosize; i++ ) + Field(p, i) = Val_unit; + } + return Val_hp(p); +} + +#if OCAML_VERSION < 50000 +value caml_alloc_custom(struct custom_operations *ops, uintnat size, + mlsize_t mem, mlsize_t max) STUB +#else +value caml_alloc_custom(const struct custom_operations * ops, uintnat size, + mlsize_t mem, mlsize_t max) STUB +#endif +{ + assert(!!ops); + assert(size <= Bsize_wsize(Max_wosize)); + value result = caml_alloc_shr(1 + Bsize_wsize(size + sizeof(value) - 1), + Custom_tag); + Custom_ops_val(result) = ops; + (void)strlen(ops->identifier); + /* make finalizer reachable from global, so the static analyzer can check + * it */ + a_custom_op.ops = ops; + a_custom_op.v = result; + (void)mem; + (void)max; + return result; +} + +value caml_alloc_tuple(mlsize_t wosize) STUB { return caml_alloc(wosize, 0); } + +value caml_alloc_string(mlsize_t len) STUB +{ + /* Sys.max_string_length */ + assert(len < Bsize_wsize(Max_wosize)); + + mlsize_t wosize = Wsize_bsize(len + sizeof(value)); + value *result = malloc(Bhsize_wosize(wosize)); + if ( !result ) + caml_raise_out_of_memory(); + __goblint_assume(!((intnat)result & 1)); + Hd_hp(result) = Make_header(wosize, String_tag, 0); + Field(result, wosize - 1) = 0; + return Val_hp(result); +} + +value caml_alloc_initialized_string(mlsize_t len, const char *p) STUB +{ + value result = caml_alloc_string(len); + memcpy(Bytes_val(result), p, len); + return result; +} + +value caml_copy_string(const char *s) STUB +{ + assert(!!s); + return caml_alloc_initialized_string(strlen(s), s); +} + +value caml_copy_double(double f) STUB +{ + value v = caml_alloc_small(Double_wosize, Double_tag); + Store_double_val(v, f); + return v; +} + +static struct custom_operations default_ops = { "default", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, + custom_fixed_length_default }; + +value caml_copy_int32(int32_t i) STUB +{ + value v = caml_alloc_custom(&default_ops, sizeof(i), 0, 1); + Int32_val(v) = i; + return v; +} + +value caml_copy_int64(int64_t i) STUB +{ + value v = caml_alloc_custom(&default_ops, sizeof(i), 0, 1); + Int64_val(v) = i; + return v; +} + +value caml_copy_nativeint(intnat i) STUB +{ + value v = caml_alloc_custom(&default_ops, sizeof(i), 0, 1); + Nativeint_val(v) = i; + return v; +} + +/* constness is different causing a compile error with 5.0, + * unless we use the correct definition */ +#if OCAML_VERSION < 50000 +value caml_alloc_array(value (*funct)(char const *), char const **array) STUB +#else +value caml_alloc_array (value (*funct) (char const *), + char const * const * array) STUB +#endif +{ + CAMLparam0(); + CAMLlocal2(v, p); + mlsize_t i, n = 0; + while ( array[n] ) + n++; + + p = caml_alloc(n, 0); + for ( i = 0; i < n; i++ ) + { + v = funct(array[n]); + assert(Tag_val(v) != Double_tag); + caml_modify(&Field(p, n), v); + } + CAMLreturn(p); +} + +#if OCAML_VERSION < 50000 +value caml_copy_string_array(char const **arr) STUB +#else +value caml_copy_string_array (char const * const* arr) STUB +#endif +{ + return caml_alloc_array(caml_copy_string, arr); +} + +value caml_alloc_float_array(mlsize_t n) STUB +{ + /* no flat float array */ + return caml_alloc(n, 0); +} + +#ifndef Tag_some +#define Tag_some 0 +#endif + +value caml_alloc_some(value v) STUB +{ + value r = caml_alloc_small(1, Tag_some); + Field(r, 0) = v; + return r; +} + +void caml_raise_with_arg(value exn, value arg) STUB +{ + assert(Is_block(exn)); + __access_Val(exn); + __access_Val(arg); + __caml_exception_raised(); +} + +void caml_raise_with_string(value exn, const char *s) STUB +{ + CAMLparam1(exn); + CAMLlocal1(str); + str = caml_copy_string(s); + caml_raise_with_arg(exn, str); + CAMLnoreturn; +} + +static value __exn_Failure, __exn_Invalid_arg, __exn_Unix_error; + +void caml_failwith(const char *msg) STUB +{ + caml_raise_with_string(__exn_Failure, msg); +} + +void caml_invalid_argument(const char *msg) STUB +{ + caml_raise_with_string(__exn_Invalid_arg, msg); +} + +void caml_raise_constant(value exn) STUB +{ + assert(Is_block(exn)); + __access_Val(exn); + __caml_exception_raised(); +} + +void caml_raise_with_args(value exn, int nargs, value arg[]) STUB +{ + int i; + assert(Is_block(exn)); + assert(nargs >= 0); + __access_Val(exn); + for ( i = 0; i < nargs; i++ ) + __access_Val(arg[i]); + __caml_exception_raised(); +} + +void caml_unix_error(int errcode, const char *cmdname, value arg) STUB +{ + CAMLparam1(arg); + CAMLlocal1(str); + str = caml_copy_string(cmdname); + value args[3] = { Val_int(errcode), str, arg }; + caml_raise_with_args(__exn_Unix_error, 3, args); + CAMLnoreturn; +} + +void caml_uerror(const char *cmdname, value arg) STUB +{ + caml_unix_error(errno, cmdname, arg); +} + +/* TODO: for 5.0 this needs to simulate multiple domains and threads instead */ +pthread_mutex_t __VERIFIER_ocaml_runtime_lock = PTHREAD_MUTEX_INITIALIZER; + +void __caml_run_other_thread(void); + +static void *__caml_maybe_call_gc(void *arg) STUB +{ + (void)arg; + int rc; + rc = pthread_mutex_lock(&__VERIFIER_ocaml_runtime_lock); + __goblint_assume(!rc); + + __caml_maybe_run_gc(); + + rc = pthread_mutex_unlock(&__VERIFIER_ocaml_runtime_lock); + __goblint_assume(!rc); + return NULL; +} + +static void __caml_maybe_run_another_thread(void) STUB +{ + pthread_attr_t attr; + pthread_t thread; + int rc; + /* create thread detached, so no join will be needed */ + rc = pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); + __goblint_assume(!rc); + /* Make it very obvious that another thread might run here, by creating one + */ + rc = pthread_create(&thread, &attr, __caml_maybe_call_gc, NULL); + __goblint_assume(!rc); +} + +void caml_enter_blocking_section(void) STUB +{ + int rc; + __caml_maybe_run_another_thread(); + rc = pthread_mutex_unlock(&__VERIFIER_ocaml_runtime_lock); + __goblint_assume(!rc); +} + +void caml_leave_blocking_section(void) STUB +{ + int rc; + __caml_maybe_run_another_thread(); + rc = pthread_mutex_lock(&__VERIFIER_ocaml_runtime_lock); + __goblint_assume(!rc); +} + +caml_stat_block caml_stat_alloc(asize_t s) STUB +{ + char* p = malloc(s + 2); + if (!p) + caml_raise_out_of_memory(); + return (p+2); /* ensure pointer cannot be passed to free as is */ +} + +/* only this and caml_enter_blocking_section can be called without runtime lock + * held! (the caml_stat_alloc_noexn too, but not implemented here) */ +void caml_stat_free(caml_stat_block b) STUB +{ + assert(b); + char* p = (b - 2); + assert(p); + free(p); +} diff --git a/ocaml/vhd-tool/src/dune b/ocaml/vhd-tool/src/dune index 0d8436915ae..65fda25f08e 100644 --- a/ocaml/vhd-tool/src/dune +++ b/ocaml/vhd-tool/src/dune @@ -1,13 +1,20 @@ (library + (name channel_stubs) + (modules channels) (foreign_stubs (language c) (names direct_copy_stubs) ) +) + +(library (name local_lib) (wrapped false) + (modules (:standard \ channels)) (libraries astring bigarray-compat + channel_stubs cohttp cohttp-lwt cstruct diff --git a/ocaml/xenopsd/c_stubs/dune b/ocaml/xenopsd/c_stubs/dune index 31e6c4a29c0..0c62c60f72b 100644 --- a/ocaml/xenopsd/c_stubs/dune +++ b/ocaml/xenopsd/c_stubs/dune @@ -2,6 +2,7 @@ (name c_stubs) (public_name xapi-xenopsd.c_stubs) (wrapped false) + (modules sockopt) (foreign_stubs (language c) (names sockopt_stubs) @@ -13,6 +14,7 @@ (public_name xapi-xenopsd-xc.c_stubs) (wrapped false) (libraries xenctrl) + (modules tuntap xenctrlext) (foreign_stubs (language c) (names tuntap_stubs xenctrlext_stubs) diff --git a/ocaml/xenopsd/lib/sockopt.ml b/ocaml/xenopsd/c_stubs/sockopt.ml similarity index 100% rename from ocaml/xenopsd/lib/sockopt.ml rename to ocaml/xenopsd/c_stubs/sockopt.ml diff --git a/ocaml/xenopsd/lib/sockopt.mli b/ocaml/xenopsd/c_stubs/sockopt.mli similarity index 100% rename from ocaml/xenopsd/lib/sockopt.mli rename to ocaml/xenopsd/c_stubs/sockopt.mli diff --git a/ocaml/xenopsd/xc/tuntap.ml b/ocaml/xenopsd/c_stubs/tuntap.ml similarity index 100% rename from ocaml/xenopsd/xc/tuntap.ml rename to ocaml/xenopsd/c_stubs/tuntap.ml diff --git a/ocaml/xenopsd/xc/tuntap.mli b/ocaml/xenopsd/c_stubs/tuntap.mli similarity index 100% rename from ocaml/xenopsd/xc/tuntap.mli rename to ocaml/xenopsd/c_stubs/tuntap.mli diff --git a/ocaml/xenopsd/xc/xenctrlext.ml b/ocaml/xenopsd/c_stubs/xenctrlext.ml similarity index 100% rename from ocaml/xenopsd/xc/xenctrlext.ml rename to ocaml/xenopsd/c_stubs/xenctrlext.ml diff --git a/ocaml/xenopsd/xc/xenctrlext.mli b/ocaml/xenopsd/c_stubs/xenctrlext.mli similarity index 100% rename from ocaml/xenopsd/xc/xenctrlext.mli rename to ocaml/xenopsd/c_stubs/xenctrlext.mli diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam index 6dfc31556ce..134978719b9 100644 --- a/xapi-lintcstubs.opam +++ b/xapi-lintcstubs.opam @@ -7,7 +7,7 @@ build: [ ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ - "ocaml" + "ocaml" {>= "4.08"} "dune" {build & >= "3.0"} "goblint" ] diff --git a/ocaml/xapi.stdout.reference b/xapi.stdout.reference similarity index 100% rename from ocaml/xapi.stdout.reference rename to xapi.stdout.reference From 93236bfba340cba22560c47dae918e5f946d20a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Mon, 9 Jan 2023 17:55:48 +0000 Subject: [PATCH 37/75] genmain fixed, and fix wrong number of arguments bug --- dune | 35 +- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 66 ++-- ocaml/staticanalyzer/genmain/arity.t | 106 ------ ocaml/staticanalyzer/genmain/dune | 36 ++- .../genmain/lintcstubs_genmain.ml | 302 +++++++++--------- .../genmain/primitives_of_cmt.ml | 136 ++++++++ ocaml/staticanalyzer/model/dune | 1 + ocaml/staticanalyzer/model/runtime.model.c | 116 ++++--- ocaml/vhd-tool/src/dune | 6 +- ocaml/xenopsd/c_stubs/dune | 4 +- ocaml/xenopsd/c_stubs/xenctrlext.ml | 2 +- ocaml/xenopsd/c_stubs/xenctrlext.mli | 2 +- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 2 +- ocaml/xenopsd/{c_stubs => xc}/tuntap.ml | 0 unixpwd/c/unixpwd_stubs.c | 2 +- 15 files changed, 454 insertions(+), 362 deletions(-) delete mode 100644 ocaml/staticanalyzer/genmain/arity.t create mode 100644 ocaml/staticanalyzer/genmain/primitives_of_cmt.ml rename ocaml/xenopsd/{c_stubs => xc}/tuntap.ml (100%) diff --git a/dune b/dune index f385da3131d..7852f7a36fd 100644 --- a/dune +++ b/dune @@ -20,6 +20,7 @@ ) ; This is a single invocation but it is very quick (<0.2s), +; although depends on the machine sometimes can be ~1.5s too ; no need to parallelize, also output can be cached. ; Only depend on ML files that contain C stubs though, ; and these .ml also don't require preprocessing for easier use @@ -40,35 +41,59 @@ )) ) +(rule + (deps + ocaml/staticanalyzer/genmain/lintcstubs_genmain.exe + (:cmtfiles + (glob_files ocaml/auth/.pam.objs/byte/*.cmt) + (glob_files ocaml/libs/log/.log.objs/byte/*.cmt) + (glob_files ocaml/vhd-tool/src/.channel_stubs.objs/byte/*.cmt) + (glob_files ocaml/xenopsd/c_stubs/.xc_stubs.objs/byte/*.cmt) + (glob_files ocaml/xenopsd/c_stubs/.c_stubs.objs/byte/*.cmt) + (glob_files ocaml/xxhash/stubs/.xxhash_bindings.objs/byte/*.cmt) + (glob_files ocaml/xxhash/lib/.xxhash.objs/byte/*.cmt) + (glob_files unixpwd/src/.unixpwd.objs/byte/*.cmt) + ) + ) + (action + (with-stdout-to primitives.model.c + (run ocaml/staticanalyzer/genmain/lintcstubs_genmain.exe %{cmtfiles}) + ) + ) +) + ; once we upgrade to Dune 3.x we can use glob_files_rec here (rule (targets xapi.sarif lintcstubs.stdout) (deps (:headers (glob_files ocaml/auth/*.h) (glob_files unixpwd/c/*.h) primitives.h) (:runtime_model ocaml/staticanalyzer/model/runtime.model.c) + (:primitives_model primitives.model.c) (:cstubs (glob_files ocaml/auth/*.c) (glob_files ocaml/libs/log/*.c) (glob_files ocaml/vhd-tool/src/*.c) (glob_files ocaml/xenopsd/c_stubs/*.c) - (glob_files unixpwd/c/*.c))) + (glob_files unixpwd/c/unix*.c))) ; enable only errors from our analyses ; so that the paths in the .sarif will be correct a chdir is needed - ; --disable warn.warning --disable warn.unsound --disable warn.imprecise + ; --disable warn.warning (action (progn (run rm -f goblint.sarif) (run ln -s %{read-lines:ctypesdir} ctypes) (with-stdout-to lintcstubs.stdout (run ocaml/staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info + --disable warn.unsound --disable warn.imprecise + --disable warn.deadcode --disable warn.behavior --set ana.activated "[\"ocamlcstubs\",\"escape\"]" --sarif -I %{ocaml_where} -I ocaml/auth -I ctypes -I unixpwd/c - %{runtime_model} - primitives.h - %{cstubs})))) + %{runtime_model} %{primitives_model} + %{cstubs} + )))) ) ; --enable dbg.debug --enable dbg.verbose diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 4837726423a..9c93667a064 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -21,18 +21,31 @@ module DomainLock = struct it should instead be configurable to use per-domain locks (e.g. N threads with M domains) *) let runtime_lock_var = - Goblintutil.create_var @@ makeGlobalVar "[OCaml runtime lock]" intType - - let runtime_lock_event = LockDomain.Addr.from_var runtime_lock_var - - let runtime_lock = AddrOf (Cil.var runtime_lock_var) + let g = ref None in + fun () -> + match !g with + | Some v -> v + | None -> + let k = "__VERIFIER_ocaml_runtime_lock" in + match VarQuery.varqueries_from_names !Cilfacade.current_file [k] with + | [VarQuery.Global v], _ -> + g := Some v; + v + | _ -> + let v = Goblintutil.create_var @@ makeGlobalVar k intType in + g := Some v; + v + + let runtime_lock_event () = LockDomain.Addr.from_var @@ runtime_lock_var () + + let runtime_lock () = AddrOf (Cil.var @@ runtime_lock_var ()) let must_be_held ctx what name = let lockset = ctx.ask Queries.MustLockset in if tracing () then tracel "OCaml domain lock must be held, current lockset is %a" Queries.LS.pretty lockset ; - if not @@ Queries.LS.mem (runtime_lock_var, `NoOffset) lockset then + if not @@ Queries.LS.mem (runtime_lock_var (), `NoOffset) lockset then (* we could use something similar to MayLocks to track may lock and give a better warning message: is the lock maybe held on some paths, or surely not held? *) @@ -48,7 +61,7 @@ module DomainLock = struct let must = ctx.ask Queries.( - MustBeProtectedBy {mutex= runtime_lock_event; write; global= arg} + MustBeProtectedBy {mutex= runtime_lock_event (); write; global= arg} ) in if not must then @@ -81,28 +94,6 @@ let caml_malloc count = LibraryDesc.Malloc (constFoldBinOp true Mult (plus1 count) size_of_word ulongType) -(* TODO: mark values as not null *) - -(* TODO: use .c models instead *) -let ocaml_runtime_functions : (string * LibraryDesc.t) list = - LibraryDsl. - [ - ( "caml_leave_blocking_section" - , special [] - @@ Lock - { - lock= DomainLock.runtime_lock - ; try_= false - ; write= true - ; return_on_success= true - } - ) - ; ( "caml_enter_blocking_section" - , special [] @@ Unlock DomainLock.runtime_lock - ) - ; ("caml_named_value", unknown [drop "name" [r]]) - ] - let cstubs = ref [] module Cstub = struct @@ -128,17 +119,12 @@ module Cstub = struct let is_cstub_entry _ctx f = is_cstub_entry_svar f.svar let enter_cstub ctx _ = - (* TODO: one CAMLprim can call another one, e.g. common in bytecode impl - that calls native, - so this should be a trylock, or there should be an outer function - locking and calling this. - For now take the lock here - *) - ctx.emit (Events.Lock (DomainLock.runtime_lock_event, true)) ; ctx.local - let leave_cstub ctx _ = - ctx.emit (Events.Unlock DomainLock.runtime_lock_event) ; + let leave_cstub ctx f = + (* runtime lock must be held when exiting the C stub, because it'll return + to OCaml code *) + DomainLock.must_be_held ctx "exiting C stub" f.vname ; ctx.local let call_caml_runtime ctx f _arglist = @@ -244,7 +230,7 @@ module Spec : Analyses.MCPSpec = struct let return ctx _ (f : fundec) = if Cstub.is_cstub_entry ctx f then - Cstub.leave_cstub ctx f + Cstub.leave_cstub ctx f.svar else ctx.local @@ -337,7 +323,7 @@ let dep = ] let () = - LibraryFunctions.register_library_functions ocaml_runtime_functions ; + (*LibraryFunctions.register_library_functions ocaml_runtime_functions ;*) (* have to declare dependencies on analyses that can provide answers to the [ctx.ask Queries] and that generate the [Events] we need *) diff --git a/ocaml/staticanalyzer/genmain/arity.t b/ocaml/staticanalyzer/genmain/arity.t deleted file mode 100644 index 83ff21ceb15..00000000000 --- a/ocaml/staticanalyzer/genmain/arity.t +++ /dev/null @@ -1,106 +0,0 @@ -Test using the examples from the OCaml manual: https://v2.ocaml.org/manual/intfc.html -Type abbreviations are not expanded: - - $ cat >test.ml < external seek_in : in_channel -> int -> unit = "caml_ml_seek_in" - > external seek_in_pair: in_channel * int -> unit = "caml_ml_seek_in_pair" - > type int_endo = int -> int - > external f : int_endo -> int_endo = "f" - > external g : (int -> int) -> (int -> int) = "g" - > EOF - $ lintcstubs_arity test.ml - #define CAML_NAME_SPACE - #include - CAMLprim value caml_ml_seek_in(value, value); - CAMLprim value caml_ml_seek_in_pair(value); - CAMLprim value f(value); - CAMLprim value g(value, value); - -With --verifier output a special attribute recognized by the static analyzer. -This is needed so it can find all the C stubs (CAMLprim is defined to empty in -headers, and thus normally disappears after preprocessing, -and the static analyzer works on preprocessed source code): - $ lintcstubs_arity --verifier test.ml - #define CAML_NAME_SPACE - #include - #undef CAMLprim - #define CAMLprim __attribute__((section("goblint-ocaml-cstub"))) - CAMLprim value caml_ml_seek_in(value, value); - CAMLprim value caml_ml_seek_in_pair(value); - CAMLprim value f(value); - CAMLprim value g(value, value); - - -Arity <= 5 is implemented directly: - $ cat >test.ml < external input : in_channel -> bytes -> int -> int -> int = "input" - > EOF - $ lintcstubs_arity test.ml - #define CAML_NAME_SPACE - #include - CAMLprim value input(value, value, value, value); - -Arity > 5 is implemented differently in bytecode and native code: - $ cat >test.ml < external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int - > = "add_nat_bytecode" "add_nat_native" - > EOF - $ lintcstubs_arity test.ml - #define CAML_NAME_SPACE - #include - CAMLprim value add_nat_native(value, value, value, value, value, value, value); - CAMLprim value add_nat_bytecode(value *argv, int argn); - -Native code can take some arguments unboxed, but that would require a typedtree -to be done correctly (it is possible to redefine 'type int = string'), so just print a warning here. - $ cat >test.ml < external foo - > : (float [@unboxed]) - > -> (float [@unboxed]) - > -> (float [@unboxed]) - > = "foo_byte" "foo" - > external foo : float -> float -> float = "foo2_byte" "foo2" [@@unboxed] - > external f : string -> (int [@untagged]) = "f_byte" "f" - > EOF - $ lintcstubs_arity test.ml - #define CAML_NAME_SPACE - #include - File "test.ml", lines 1-5, characters 0-18: - 1 | external foo - 2 | : (float [@unboxed]) - 3 | -> (float [@unboxed]) - 4 | -> (float [@unboxed]) - 5 | = "foo_byte" "foo" - Warning 22 [preprocessor]: Ignored primitive declaration "foo": has attributes - File "test.ml", line 6, characters 0-71: - 6 | external foo : float -> float -> float = "foo2_byte" "foo2" [@@unboxed] - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Warning 22 [preprocessor]: Ignored primitive declaration "foo": has attributes - File "test.ml", line 7, characters 0-55: - 7 | external f : string -> (int [@untagged]) = "f_byte" "f" - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Warning 22 [preprocessor]: Ignored primitive declaration "f": has attributes - -Noalloc makes it possible to call C code directly, however unboxed is not -supported by this tool for the same reason as above: - $ cat >test.ml < external sqrt : float -> float = "caml_sqrt_float" "sqrt" - > [@@unboxed] [@@noalloc] - > EOF - $ lintcstubs_arity test.ml - #define CAML_NAME_SPACE - #include - File "test.ml", lines 1-2, characters 0-23: - 1 | external sqrt : float -> float = "caml_sqrt_float" "sqrt" - 2 | [@@unboxed] [@@noalloc] - Warning 22 [preprocessor]: Ignored primitive declaration "sqrt": has attributes - -Noalloc can also be used without unboxed: - $ cat >test.ml < external unsafe_blit: t -> int -> t -> int -> int -> unit = - > "caml_floatarray_blit" [@@noalloc] - > EOF - $ lintcstubs_arity test.ml - #define CAML_NAME_SPACE - #include - CAMLprim value caml_floatarray_blit(value, value, value, value, value); diff --git a/ocaml/staticanalyzer/genmain/dune b/ocaml/staticanalyzer/genmain/dune index c17bafa3b5e..a735f71664b 100644 --- a/ocaml/staticanalyzer/genmain/dune +++ b/ocaml/staticanalyzer/genmain/dune @@ -1,16 +1,46 @@ +; compiler-libs has unstable API, ensure only one module uses it to simplify +; maintenance +(library + (name primitives_of_cmt) + (modules primitives_of_cmt) + (libraries compiler-libs.common) + ) + (executable (public_name lintcstubs_genmain) - (libraries compiler-libs.common) + (modules lintcstubs_genmain) + (libraries primitives_of_cmt) (package xapi-lintcstubs) ) (cram (deps %{bin:lintcstubs_genmain})) (rule - (alias runtest) + (target genmain_test.model.c) (deps (:cmt (glob_files %{ocaml_where}/*.cmt)) (:linter %{bin:lintcstubs_genmain}) ) - (action (run %{linter} %{cmt})) + (action (with-stdout-to %{target} (run %{linter} %{cmt}))) +) + +(rule + (deps + (:linter ../arity/lintcstubs_arity.exe) + (:mlfiles (glob_files %{ocaml_where}/*.ml))) + (action + (with-stdout-to primitives.h + (run %{linter} %{mlfiles}) + ))) + +; check that the model compiles with usual compiler +(library + (name genmain_test) + (modules) + (foreign_stubs + (language c) + (names genmain_test.model) + (include_dirs ../model/include) + ) + (package xapi-lintcstubs) ) diff --git a/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml b/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml index bba7f1966a1..1fda872aceb 100644 --- a/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml +++ b/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml @@ -10,73 +10,7 @@ resolved types and type immediacy information from the compiler itself. *) -let tool_name = Sys.executable_name - -let usage_msg = Printf.sprintf "%s [FILE.cmt...]" tool_name - -(** [args_of_type typ] returns the sequence of arguments for the function type [typ]. - - Type aliases are not expanded, and we only recurse on right hand side of - the type arrow. - @see examples in the manual. - *) -let rec args_of_type = - let open Typedtree in - function - | {ctyp_desc= Ttyp_arrow (_, t1, t2); _} -> - fun () -> Seq.Cons (t1, args_of_type t2) - | t -> - Seq.return t - -let has_attr name lst = - (* typedtree attributes are the same as in parsetree *) - let open Parsetree in - Option.is_some (lst |> List.find_opt @@ fun attr -> attr.attr_name.txt = name) - -let ctype_of_ocaml ~is_unboxed = - let open Typedtree in - function - | {ctyp_desc= Ttyp_constr (path, _, _); ctyp_attributes; _} - when is_unboxed - || has_attr "unboxed" ctyp_attributes - || has_attr "untagged" ctyp_attributes -> - let is_predef = Path.same path in - if is_predef Predef.path_float then - "double" - else if is_predef Predef.path_int32 then - "int32" - else if is_predef Predef.path_int64 then - "int64" - else if is_predef Predef.path_nativeint then - "intnat" - else if is_predef Predef.path_int then - "intnat" - else - invalid_arg - @@ Format.asprintf "unknown type name for unboxed: %a" Path.print path - | {ctyp_attributes= []; _} -> - "value" - | {ctyp_attributes= attrs; _} -> - let attrnames = attrs |> List.map @@ fun a -> a.Parsetree.attr_name.txt in - invalid_arg - @@ Printf.sprintf "unknown attributes: %s" (String.concat ", " attrnames) - -(** [print_c_prototype ~arity bytename nativename] prints C prototypes for - calls to user defined primitives implemented by [bytename] - (in bytecode mode) and [nativename] (in native code mode). - [arity] is the number of arguments, when <= 5 [bytename] and [nativename] - are the same. - - Does not support unboxed or untagged calls (filtered out by caller). -*) -let print_c_prototype ~arity bytename nativename = - let args = List.init arity @@ fun _ -> "value" in - let str_of_args args = String.concat ", " @@ List.rev args in - Printf.printf "CAMLprim value %s(%s);\n" nativename @@ str_of_args args ; - if arity <= 5 then - assert (bytename = nativename) - else - Printf.printf "CAMLprim value %s(value *argv, int argn);\n" bytename +let usage_msg = Printf.sprintf "%s [FILE.cmt...]" Sys.executable_name (** [warning loc fmt] prints a warning at source location [loc], with message format defined by [fmt]. @@ -84,80 +18,116 @@ let print_c_prototype ~arity bytename nativename = let warning loc = Printf.ksprintf @@ fun msg -> Location.prerr_warning loc (Preprocessor msg) -(** [no_attrs typ] returns true if there are no attributes on the type - (components). +(** [nondet ctype] is a generator for [ctype]. + See [sv-comp.c] in [goblint], these are the nondeterministic value + generators used in static verifier competitions, and supported by various + static analyzers + *) +let nondet typ = "__VERIFIER_nondet_" ^ typ + +let print_nondet_prototype t = + let open Primitives_of_cmt in + let ctype = ctype_of_native_arg t in + Printf.printf "%s %s(void);" ctype (nondet ctype) - @see -*) -let rec no_attrs = - let open Parsetree in - function - | {ptyp_attributes= _ :: _; _} -> - false - | {ptyp_desc= Ptyp_arrow (_, t1, t2); _} -> - no_attrs t1 && no_attrs t2 - | _ -> - true - - (* TODO: gen*) -let str_of_native_repr = - let open Primitive in +let gen_of_native_arg args = + let open Primitives_of_cmt in function - | Same_as_ocaml_repr -> - "value" - | Unboxed_float -> - "double" - | Unboxed_integer Pnativeint -> - "intnat" - | Unboxed_integer Pint32 -> - "int32_t" - | Unboxed_integer Pint64 -> - "int64_t" - | Untagged_int -> - "intnat" + (* TODO: we could do more analysis on the type for value to determine whether + it is an integer or not, what tag it can have, etc. *) + | (Value | Double | Int32 | Int64 | Intnat) as arg -> + nondet @@ ctype_of_native_arg arg ^ "()" + | Bytecode_argv -> + Printf.sprintf "value[]{%s}" + @@ String.concat ", " + @@ List.map ctype_of_native_arg args + | Bytecode_argn -> + List.length args |> string_of_int + +module StringSet = Set.Make(String) +let calls = ref StringSet.empty + +let print_call ~noalloc res name args = + let open Printf in + if not @@ StringSet.mem name !calls then begin + calls := StringSet.add name !calls; + printf "static void __call_%s(void) {\n" name ; + if noalloc then + printf "\tCAMLnoalloc;\n" ; + printf "\t%s res = %s(%s);\n" (Primitives_of_cmt.ctype_of_native_arg res) name + @@ String.concat ", " + @@ List.map (gen_of_native_arg args) args ; + if res = Value then + printf "\t__access_Val(res);\n" + (* check that the value is valid *) + (* TODO: could insert more assertions based on actual type *) + else + printf "\t(void)res;\n" ; + (* suppress unused value warning *) + print_endline "}" + end + +let print_c_prototype ~noalloc res name args = + let open Primitives_of_cmt in + Printf.printf "CAMLprim %s %s(%s);\n" (ctype_of_native_arg res) name + @@ String.concat ",\n " + @@ List.map ctype_of_native_arg args ; + print_call ~noalloc res name args + +let print_c_prototype_arity arity byte_name = + let open Primitives_of_cmt in + print_c_prototype Value byte_name @@ List.init arity (fun _ -> Value) let primitive_description desc = - let open Primitive in - if native_name_is_external desc then ( - (* only process primitives defined by the user (not the compiler) *) - Printf.printf "void __call_%s(void) { %s result = %s(%s); }\n" - (native_name desc) - (str_of_native_repr desc.prim_native_repr_res) - (native_name desc) - @@ String.concat ", " - @@ List.map str_of_native_repr desc.prim_native_repr_args ; - let bytecode_args = - String.concat ", " @@ List.init desc.prim_arity @@ fun _ -> "__VERIFIER_nondet_value()" - in - (* only output bytecode call if different *) - if desc.prim_arity > 5 then - Printf.printf - "void __call_%s(void) { value argv[%d] = {%s}; value result =\n\ - \ %s(argv, %d);}\n" - desc.prim_name desc.prim_arity bytecode_args desc.prim_name - desc.prim_arity - else if - List.exists (( <> ) Same_as_ocaml_repr) desc.prim_native_repr_args - || desc.prim_native_repr_res <> Same_as_ocaml_repr - then - Printf.printf "void __call_%s(void) { value result = %s(%s);}\n" - desc.prim_name desc.prim_name bytecode_args - ) - -(** [value_description _ mc] is invoked by the TAST iterator for - value descriptions. - Recursively iterate until we find a [primitive_coercion]. -*) -let rec value_description _ vd = - let open Typedtree in - let open Types in - match vd.val_val.val_kind with - | Val_prim prim -> - primitive_description prim - | _ -> - () - -let verifier_section = "goblint-ocaml-cstub" + let open Primitives_of_cmt in + (* print native first *) + let noalloc = not desc.alloc in + print_c_prototype ~noalloc desc.native_result desc.native_name + desc.native_args ; + (* if the bytecode one is different, print it *) + if desc.native_name <> desc.byte_name then + if desc.arity <= 5 then + print_c_prototype_arity ~noalloc desc.arity desc.byte_name + else + print_c_prototype ~noalloc Value desc.byte_name + [Bytecode_argv; Bytecode_argn] + else + (* according to https://v2.ocaml.org/manual/intfc.html#ss:c-prim-impl + if the primitive takes more than 5 arguments then bytecode and native + mode implementations must be different *) + assert (desc.arity <= 5); + print_endline "" + +let print_call_all () = + (* TODO: could use Format module *) + print_endline "static void* __call__all(void* arg) {" ; + print_endline "\t(void)arg;"; + print_endline "\tcaml_leave_blocking_section();"; + (* some of these may raise exceptions, so use a nondet to choose which one to + call, to ensure they are all seen as called *) + print_endline "\tswitch(__VERIFIER_nondet_int()) {" ; + let () = + !calls + |> StringSet.elements |> List.iteri @@ fun i name -> + Printf.printf "\tcase %d: __call_%s(); break;\n" i name + in + print_endline "\tdefault: __caml_maybe_run_gc(); break;" ; + print_endline "\t}" ; + print_endline "\tcaml_enter_blocking_section();"; + print_endline "}"; + + print_endline ""; + print_endline "#include "; + print_endline "int main(void)"; + print_endline "{"; + print_endline "\tpthread_t thread;"; + print_endline "\tint rc = pthread_create(&thread, NULL, __call__all, NULL);"; + print_endline "\t__goblint_assume(!rc);"; (* don't model thread creation failure *) + print_endline "\t(void)__call__all(NULL);"; + print_endline "\trc = pthread_join(thread, NULL);"; + print_endline "\t__goblint_assume(!rc);"; (* don't model thread creation failure *) + print_endline "\treturn 0;"; + print_endline "}" let () = let files = @@ -167,22 +137,42 @@ let () = !lst in - print_endline {|#include "primitives.h"|} ; - try - files - |> List.iter @@ fun path -> - let open Tast_iterator in - path - (* have to parse the implementation, because the .mli may hide that it - is a C stub by defining a 'val name ...' instead of 'external name ...'. *) - |> Cmt_format.read_cmt - |> function - | Cmt_format.{cmt_annots= Implementation typedtree; _} -> - let iterator = {default_iterator with value_description} in - iterator.structure iterator typedtree - | _ -> - invalid_arg "not a .cmt file (missing implementation)" - with e -> - (* if there are any syntax errors, or other exceptions escaping from - compiler-libs this will report them properly *) - Location.report_exception Format.err_formatter e + print_endline {|#include "primitives.h"|} ; + print_endline {|#include |}; + print_endline {|#include "caml/threads.h"|}; + Printf.printf {| +#ifndef CAMLnoalloc +/* GC status assertions. + + CAMLnoalloc at the start of a block means that the GC must not be + invoked during the block. */ +#if defined(__GNUC__) && defined(DEBUG) +int caml_noalloc_begin(void); +void caml_noalloc_end(int*); +void caml_alloc_point_here(void); +#define CAMLnoalloc \ + int caml__noalloc \ + __attribute__((cleanup(caml_noalloc_end),unused)) \ + = caml_noalloc_begin() +#define CAMLalloc_point_here (caml_alloc_point_here()) +#else +#define CAMLnoalloc +#define CAMLalloc_point_here ((void)0) +#endif +#endif + |}; + + let () = + (* TODO: put in a header *) + Printf.printf "int __VERIFIER_nondet_int(void);\n"; + Printf.printf "void __access_Val(value);\n"; + Primitives_of_cmt.[Value; Double; Int32; Int64; Intnat] + |> List.iter @@ fun t -> print_nondet_prototype t + in + print_endline "void __caml_maybe_run_gc(void);"; + Primitives_of_cmt.with_report_exceptions @@ fun () -> + let () = files + |> List.iter @@ fun path -> + Primitives_of_cmt.iter_primitives_exn ~path primitive_description; + in + print_call_all (); diff --git a/ocaml/staticanalyzer/genmain/primitives_of_cmt.ml b/ocaml/staticanalyzer/genmain/primitives_of_cmt.ml new file mode 100644 index 00000000000..be5adbbdc1d --- /dev/null +++ b/ocaml/staticanalyzer/genmain/primitives_of_cmt.ml @@ -0,0 +1,136 @@ +(** [Typedtree] and [Primitive] have an unstable API (depends on compiler version), + so extract the parts we need and convert to types defined in this file. + If the build breaks with new compiler versions then only this module needs + to be updated (perhaps by using Dune's support to conditionally select + files based on compiler versions) +*) + +type native_arg = + | Value + | Double + | Int32 + | Int64 + | Intnat + | Bytecode_argv + | Bytecode_argn + +let native_arg_of_primitive = + let open Primitive in + function + | Same_as_ocaml_repr -> + Value + | Unboxed_float -> + Double + | Unboxed_integer Pnativeint -> + Intnat + | Unboxed_integer Pint32 -> + Int32 + | Unboxed_integer Pint64 -> + Int64 + | Untagged_int -> + (* the range of this is one bit less than Pnativeint, but still same type on C side *) + Intnat + +(** [ctype_of_native_arg arg] returns the C type used when implementing + primitives for native code mode. + + @see on the use of [intnat]*) +let ctype_of_native_arg = function + | Value -> + "value" + | Double -> + "double" + | Int32 -> + "int32_t" + | Int64 -> + "int64_t" + | Intnat -> + "intnat" + | Bytecode_argv -> + "value *" + | Bytecode_argn -> + "int" + +type t = { + byte_name: string + (** name of C function implementing the primitive in bytecode mode *) + ; native_name: string + (** name of C function implementinmg the primitive in native code mode *) + ; arity: int (** number of arguments to C function in native code mode *) + ; alloc: bool (** whether it allocates/raises exceptions *) + ; native_result: native_arg + (** result type of the C function implementing the primitive in native code mode*) + ; native_args: native_arg list + (** type of the arguments of the C function implementing the primitive in native code mode *) +} + +(** [with_report_exceptions f] will report any compiler-libs exceptions + escaping from [f] and exit the process with code 2. *) +let with_report_exceptions f = + try f () + with e -> + (* if there are any errors loading or processing the .cmt file, + or other exceptions escaping from compiler-libs this will report them properly *) + Location.report_exception Format.err_formatter e ; + exit 2 + +(** [warning loc fmt] prints a warning at source location [loc], + with message format defined by [fmt]. + + This will issue a warning 22 (preprocessor). + *) +let warning loc = + Printf.ksprintf @@ fun msg -> Location.prerr_warning loc (Preprocessor msg) + +(** [iter_primitives_exn ~path primitive_description] will load the .cmt/.cmti file + [path] and iterate on any primitives defined using [primitive_description]. + + Exceptions from compiler-libs may escape, so it is recommended to wrap calls + using [with_report_exceptions]. + *) +let iter_primitives_exn ~path f = + let primitive_description pd = + let open Primitive in + if native_name_is_external pd then + (* only process primitives implemented by the user, not the ones defined + by the compiler itself *) + let t = + { + byte_name= byte_name pd + ; native_name= native_name pd + ; arity= pd.prim_arity + ; native_result= native_arg_of_primitive pd.prim_native_repr_res + ; alloc= pd.prim_alloc + ; native_args= List.map native_arg_of_primitive pd.prim_native_repr_args + } + in + f t + in + let rec value_description _ vd = + let open Typedtree in + let open Types in + match vd.val_val.val_kind with + | Val_prim prim -> + primitive_description prim + | _ -> + () + in + let open Tast_iterator in + let iterator = {default_iterator with value_description} in + path + |> Cmt_format.read_cmt + |> + let open Cmt_format in + function + | {cmt_annots= Implementation structure; _} -> + iterator.structure iterator structure + | {cmt_annots= Interface signature; _} -> + (* this won't find all primitives, because the interface is allowed to + hide the implementation detail by using 'val ...' instead of 'external ...' + *) + warning (Location.in_file path) + "Loaded a .cmti file. May not contain all primitives" ; + iterator.signature iterator signature + | _ -> + invalid_arg + "Could not find an implementation or interface in the .cmt/.cmti file" diff --git a/ocaml/staticanalyzer/model/dune b/ocaml/staticanalyzer/model/dune index 3e31dbbfd7e..836eb3e7f4d 100644 --- a/ocaml/staticanalyzer/model/dune +++ b/ocaml/staticanalyzer/model/dune @@ -4,6 +4,7 @@ (foreign_stubs (language c) (include_dirs include) + (flags (:standard -Wno-attributes)) (names runtime.model) ) (package xapi-lintcstubs) diff --git a/ocaml/staticanalyzer/model/runtime.model.c b/ocaml/staticanalyzer/model/runtime.model.c index 372182d5172..c9d982fbad8 100644 --- a/ocaml/staticanalyzer/model/runtime.model.c +++ b/ocaml/staticanalyzer/model/runtime.model.c @@ -38,7 +38,7 @@ int __VERIFIER_nondet_int(void); #define STUB __attribute__((goblint_stub)) -void caml_failed_assert(char *msg, char *os, int n) STUB +STUB void caml_failed_assert(char *msg, char *os, int n) { /* always fail assertion when called by CAMLassert */ assert(!msg); @@ -53,12 +53,11 @@ void caml_failed_assert(char *msg, char *os, int n) STUB * may not necessarily terminate, e.g. if there is an exception handler */ CAMLnoreturn_start void __caml_exception_raised() CAMLnoreturn_end STUB; -#define __access_Val(v) \ - do \ - { \ - if ( !Is_block(v) ) \ - (void)Tag_val(v); \ - } while ( 0 ) +STUB void __access_Val(value v) +{ + if ( !Is_block(v) ) + (void)Tag_val(v); +} static header_t __atoms[Num_tags]; @@ -67,7 +66,7 @@ static header_t __atoms[Num_tags]; * (except with a trylock, but that is not modeled either) */ -value caml_alloc_atom(tag_t tag) STUB +STUB value caml_alloc_atom(tag_t tag) { assert(tag < Num_tags); header_t *hp = &__atoms[tag]; @@ -85,7 +84,7 @@ static struct static int __custom_ops_running; -static void __caml_maybe_run_finalizer(void) STUB +STUB static void __caml_maybe_run_finalizer(void) { const struct custom_operations *ops = a_custom_op.ops; value v = a_custom_op.v; @@ -140,7 +139,7 @@ static void __caml_maybe_run_finalizer(void) STUB __custom_ops_running = 0; } -static void __caml_move(value arg, volatile value *dest) STUB +STUB static void __caml_move(value arg, volatile value *dest) { if ( !Is_block(arg) ) return; @@ -165,7 +164,7 @@ static void __caml_move(value arg, volatile value *dest) STUB #endif /* anything can happen, including more allocations, etc. */ -static void __caml_maybe_run_gc(void) STUB +STUB void __caml_maybe_run_gc(void) { if ( !__VERIFIER_nondet_int() ) return; @@ -192,7 +191,7 @@ static void __caml_maybe_run_gc(void) STUB __caml_maybe_run_finalizer(); } -value caml_alloc_shr(mlsize_t wosize, tag_t tag) STUB +STUB value caml_alloc_shr(mlsize_t wosize, tag_t tag) { /* See https://v2.ocaml.org/manual/intfc.html#sss:c-simple-allocation * have to use Atom(t) for 0 sized blocks */ @@ -210,7 +209,7 @@ value caml_alloc_shr(mlsize_t wosize, tag_t tag) STUB return Val_hp(p); } -value caml_alloc_small(mlsize_t wosize, tag_t tag) STUB +STUB value caml_alloc_small(mlsize_t wosize, tag_t tag) { assert(wosize <= Max_young_wosize); /* alloc_small is just an optimization, @@ -218,7 +217,7 @@ value caml_alloc_small(mlsize_t wosize, tag_t tag) STUB return caml_alloc_shr(wosize, tag); } -value caml_alloc(mlsize_t wosize, tag_t tag) STUB +STUB value caml_alloc(mlsize_t wosize, tag_t tag) { unsigned i; value p = caml_alloc_shr(wosize, tag); @@ -232,10 +231,10 @@ value caml_alloc(mlsize_t wosize, tag_t tag) STUB #if OCAML_VERSION < 50000 value caml_alloc_custom(struct custom_operations *ops, uintnat size, - mlsize_t mem, mlsize_t max) STUB +STUB mlsize_t mem, mlsize_t max) #else value caml_alloc_custom(const struct custom_operations * ops, uintnat size, - mlsize_t mem, mlsize_t max) STUB +STUB mlsize_t mem, mlsize_t max) #endif { assert(!!ops); @@ -253,9 +252,9 @@ value caml_alloc_custom(const struct custom_operations * ops, uintnat size, return result; } -value caml_alloc_tuple(mlsize_t wosize) STUB { return caml_alloc(wosize, 0); } +STUB value caml_alloc_tuple(mlsize_t wosize) { return caml_alloc(wosize, 0); } -value caml_alloc_string(mlsize_t len) STUB +STUB value caml_alloc_string(mlsize_t len) { /* Sys.max_string_length */ assert(len < Bsize_wsize(Max_wosize)); @@ -270,20 +269,21 @@ value caml_alloc_string(mlsize_t len) STUB return Val_hp(result); } -value caml_alloc_initialized_string(mlsize_t len, const char *p) STUB +STUB value caml_alloc_initialized_string(mlsize_t len, const char *p) { value result = caml_alloc_string(len); memcpy(Bytes_val(result), p, len); return result; } -value caml_copy_string(const char *s) STUB +STUB value caml_copy_string(const char *s) { assert(!!s); return caml_alloc_initialized_string(strlen(s), s); } -value caml_copy_double(double f) STUB + +STUB value caml_copy_double(double f) { value v = caml_alloc_small(Double_wosize, Double_tag); Store_double_val(v, f); @@ -299,21 +299,21 @@ static struct custom_operations default_ops = { "default", custom_compare_ext_default, custom_fixed_length_default }; -value caml_copy_int32(int32_t i) STUB +STUB value caml_copy_int32(int32_t i) { value v = caml_alloc_custom(&default_ops, sizeof(i), 0, 1); Int32_val(v) = i; return v; } -value caml_copy_int64(int64_t i) STUB +STUB value caml_copy_int64(int64_t i) { value v = caml_alloc_custom(&default_ops, sizeof(i), 0, 1); Int64_val(v) = i; return v; } -value caml_copy_nativeint(intnat i) STUB +STUB value caml_copy_nativeint(intnat i) { value v = caml_alloc_custom(&default_ops, sizeof(i), 0, 1); Nativeint_val(v) = i; @@ -323,10 +323,10 @@ value caml_copy_nativeint(intnat i) STUB /* constness is different causing a compile error with 5.0, * unless we use the correct definition */ #if OCAML_VERSION < 50000 -value caml_alloc_array(value (*funct)(char const *), char const **array) STUB +STUB value caml_alloc_array(value (*funct)(char const *), char const **array) #else value caml_alloc_array (value (*funct) (char const *), - char const * const * array) STUB +STUB char const * const * array) #endif { CAMLparam0(); @@ -346,15 +346,15 @@ value caml_alloc_array (value (*funct) (char const *), } #if OCAML_VERSION < 50000 -value caml_copy_string_array(char const **arr) STUB +STUB value caml_copy_string_array(char const **arr) #else -value caml_copy_string_array (char const * const* arr) STUB +STUB value caml_copy_string_array (char const * const* arr) #endif { return caml_alloc_array(caml_copy_string, arr); } -value caml_alloc_float_array(mlsize_t n) STUB +STUB value caml_alloc_float_array(mlsize_t n) { /* no flat float array */ return caml_alloc(n, 0); @@ -364,14 +364,14 @@ value caml_alloc_float_array(mlsize_t n) STUB #define Tag_some 0 #endif -value caml_alloc_some(value v) STUB +STUB value caml_alloc_some(value v) { value r = caml_alloc_small(1, Tag_some); Field(r, 0) = v; return r; } -void caml_raise_with_arg(value exn, value arg) STUB +STUB void caml_raise_with_arg(value exn, value arg) { assert(Is_block(exn)); __access_Val(exn); @@ -379,7 +379,7 @@ void caml_raise_with_arg(value exn, value arg) STUB __caml_exception_raised(); } -void caml_raise_with_string(value exn, const char *s) STUB +STUB void caml_raise_with_string(value exn, const char *s) { CAMLparam1(exn); CAMLlocal1(str); @@ -390,24 +390,24 @@ void caml_raise_with_string(value exn, const char *s) STUB static value __exn_Failure, __exn_Invalid_arg, __exn_Unix_error; -void caml_failwith(const char *msg) STUB +STUB void caml_failwith(const char *msg) { caml_raise_with_string(__exn_Failure, msg); } -void caml_invalid_argument(const char *msg) STUB +STUB void caml_invalid_argument(const char *msg) { caml_raise_with_string(__exn_Invalid_arg, msg); } -void caml_raise_constant(value exn) STUB +STUB void caml_raise_constant(value exn) { assert(Is_block(exn)); __access_Val(exn); __caml_exception_raised(); } -void caml_raise_with_args(value exn, int nargs, value arg[]) STUB +STUB void caml_raise_with_args(value exn, int nargs, value arg[]) { int i; assert(Is_block(exn)); @@ -418,7 +418,7 @@ void caml_raise_with_args(value exn, int nargs, value arg[]) STUB __caml_exception_raised(); } -void caml_unix_error(int errcode, const char *cmdname, value arg) STUB +STUB void caml_unix_error(int errcode, const char *cmdname, value arg) { CAMLparam1(arg); CAMLlocal1(str); @@ -428,7 +428,7 @@ void caml_unix_error(int errcode, const char *cmdname, value arg) STUB CAMLnoreturn; } -void caml_uerror(const char *cmdname, value arg) STUB +STUB void caml_uerror(const char *cmdname, value arg) { caml_unix_error(errno, cmdname, arg); } @@ -438,7 +438,7 @@ pthread_mutex_t __VERIFIER_ocaml_runtime_lock = PTHREAD_MUTEX_INITIALIZER; void __caml_run_other_thread(void); -static void *__caml_maybe_call_gc(void *arg) STUB +STUB static void *__caml_maybe_call_gc(void *arg) { (void)arg; int rc; @@ -452,7 +452,7 @@ static void *__caml_maybe_call_gc(void *arg) STUB return NULL; } -static void __caml_maybe_run_another_thread(void) STUB +STUB static void __caml_maybe_run_another_thread(void) { pthread_attr_t attr; pthread_t thread; @@ -466,7 +466,7 @@ static void __caml_maybe_run_another_thread(void) STUB __goblint_assume(!rc); } -void caml_enter_blocking_section(void) STUB +STUB void caml_enter_blocking_section(void) { int rc; __caml_maybe_run_another_thread(); @@ -474,7 +474,7 @@ void caml_enter_blocking_section(void) STUB __goblint_assume(!rc); } -void caml_leave_blocking_section(void) STUB +STUB void caml_leave_blocking_section(void) { int rc; __caml_maybe_run_another_thread(); @@ -482,7 +482,7 @@ void caml_leave_blocking_section(void) STUB __goblint_assume(!rc); } -caml_stat_block caml_stat_alloc(asize_t s) STUB +STUB caml_stat_block caml_stat_alloc(asize_t s) { char* p = malloc(s + 2); if (!p) @@ -492,10 +492,38 @@ caml_stat_block caml_stat_alloc(asize_t s) STUB /* only this and caml_enter_blocking_section can be called without runtime lock * held! (the caml_stat_alloc_noexn too, but not implemented here) */ -void caml_stat_free(caml_stat_block b) STUB +STUB void caml_stat_free(caml_stat_block b) { assert(b); char* p = (b - 2); assert(p); free(p); } + +/* see sv-comp.c, the use of uninitialized value here is on purpose */ +STUB int32_t __VERIFIER_nondet_int32(void) +{ int32_t val; return val; } + +STUB int64_t __VERIFIER_nondet_int64(void) +{ int64_t val; return val; } + +STUB value __VERIFIER_nondet_value(void) +{ value val; return val; } + +static int __in_noalloc; + +STUB int caml_noalloc_begin(void) +{ + __in_noalloc++; +} + +STUB int caml_noalloc_end(int *noalloc) +{ + --__in_noalloc; + __goblint_assert(__in_noalloc == *noalloc); +} + +STUB int caml_alloc_point_here(void) +{ + __goblint_assert(!__in_noalloc); +} diff --git a/ocaml/vhd-tool/src/dune b/ocaml/vhd-tool/src/dune index 65fda25f08e..4df704f8d00 100644 --- a/ocaml/vhd-tool/src/dune +++ b/ocaml/vhd-tool/src/dune @@ -1,16 +1,18 @@ (library (name channel_stubs) - (modules channels) + (modules channels iO) (foreign_stubs (language c) (names direct_copy_stubs) ) + (libraries cstruct io-page.unix lwt lwt.unix lwt_ssl) + (wrapped false) ) (library (name local_lib) (wrapped false) - (modules (:standard \ channels)) + (modules (:standard \ channels iO)) (libraries astring bigarray-compat diff --git a/ocaml/xenopsd/c_stubs/dune b/ocaml/xenopsd/c_stubs/dune index 0c62c60f72b..159b9c7d042 100644 --- a/ocaml/xenopsd/c_stubs/dune +++ b/ocaml/xenopsd/c_stubs/dune @@ -13,8 +13,8 @@ (name xc_stubs) (public_name xapi-xenopsd-xc.c_stubs) (wrapped false) - (libraries xenctrl) - (modules tuntap xenctrlext) + (libraries xenctrl xentoollog) + (modules xenctrlext) (foreign_stubs (language c) (names tuntap_stubs xenctrlext_stubs) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext.ml b/ocaml/xenopsd/c_stubs/xenctrlext.ml index a13aa2e1c29..f53b311c72a 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext.ml +++ b/ocaml/xenopsd/c_stubs/xenctrlext.ml @@ -112,7 +112,7 @@ module Xenforeignmemory = struct type prot = {read: bool; write: bool; exec: bool} - external acquire : Xentoollog.handle option -> handle + external acquire : Xentoollog.handle option -> int -> handle = "stub_xenforeignmemory_open" external release : handle -> unit = "stub_xenforeignmemory_close" diff --git a/ocaml/xenopsd/c_stubs/xenctrlext.mli b/ocaml/xenopsd/c_stubs/xenctrlext.mli index 1f88f2781e5..673a98ffb9d 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext.mli +++ b/ocaml/xenopsd/c_stubs/xenctrlext.mli @@ -93,7 +93,7 @@ module Xenforeignmemory : sig type prot = {read: bool; write: bool; exec: bool} - val acquire : Xentoollog.handle option -> handle + val acquire : Xentoollog.handle option -> int -> handle val release : handle -> unit diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 780099680b8..8c64b4c25d3 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -88,7 +88,7 @@ static void failwith_xc(xc_interface *xch) raise_unix_errno_msg(real_errno, error_str); } -CAMLprim value stub_xenctrlext_interface_open(void) +CAMLprim value stub_xenctrlext_interface_open(value _unused) { CAMLparam0(); CAMLlocal1(result); diff --git a/ocaml/xenopsd/c_stubs/tuntap.ml b/ocaml/xenopsd/xc/tuntap.ml similarity index 100% rename from ocaml/xenopsd/c_stubs/tuntap.ml rename to ocaml/xenopsd/xc/tuntap.ml diff --git a/unixpwd/c/unixpwd_stubs.c b/unixpwd/c/unixpwd_stubs.c index 7b2bdd6cb72..ab5d142e43f 100644 --- a/unixpwd/c/unixpwd_stubs.c +++ b/unixpwd/c/unixpwd_stubs.c @@ -105,7 +105,7 @@ CAMLprim value caml_unixpwd_setspw(value caml_user, value caml_password) unixpwd_setspw); } -CAMLprim value caml_unixpwd_unshadow(void) +CAMLprim value caml_unixpwd_unshadow(value _unused) { CAMLparam0(); char *passwords; From c2dae6ab262c0556f0fb237e107b80f822446202 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 10:28:15 +0000 Subject: [PATCH 38/75] fix a few more _H these are not visible to static analysis by default due to ifdefs --- dune | 5 +++-- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 13 ++++++++----- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/dune b/dune index 7852f7a36fd..31f44165982 100644 --- a/dune +++ b/dune @@ -83,6 +83,7 @@ (progn (run rm -f goblint.sarif) (run ln -s %{read-lines:ctypesdir} ctypes) + (with-stderr-to lintcstubs.stderr (with-stdout-to lintcstubs.stdout (run ocaml/staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info --disable warn.unsound --disable warn.imprecise @@ -93,10 +94,10 @@ -I ocaml/auth -I ctypes -I unixpwd/c %{runtime_model} %{primitives_model} %{cstubs} - )))) + ))))) ) ; --enable dbg.debug --enable dbg.verbose - +; TODO: show stderr too (rule (alias analyze) (deps lintcstubs.stdout) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 8c64b4c25d3..3a0b001f621 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -112,14 +112,16 @@ CAMLprim value stub_xenctrlext_get_runstate_info(value xch, value domid) CAMLparam2(xch, domid); #if defined(XENCTRL_HAS_GET_RUNSTATE_INFO) CAMLlocal1(result); + xc_interface *xc = _H(xch); xc_runstate_info_t info; int retval; caml_enter_blocking_section(); - retval = xc_get_runstate_info(_H(xch), _D(domid), &info); + /* TODO: analyzer doesn't find it due to old mock */ + retval = xc_get_runstate_info(xc, _D(domid), &info); caml_leave_blocking_section(); if ( retval < 0 ) - failwith_xc(_H(xch)); + failwith_xc(xc); /* Store 0 : state (int32) @@ -149,14 +151,15 @@ CAMLprim value stub_xenctrlext_get_boot_cpufeatures(value xch) CAMLparam1(xch); #if defined(XENCTRL_HAS_GET_CPUFEATURES) CAMLlocal1(v); + xc_interface *xc = _H(xch); uint32_t a, b, c, d, e, f, g, h; int ret; caml_enter_blocking_section(); - ret = xc_get_boot_cpufeatures(_H(xch), &a, &b, &c, &d, &e, &f, &g, &h); + ret = xc_get_boot_cpufeatures(xc, &a, &b, &c, &d, &e, &f, &g, &h); caml_leave_blocking_section(); if ( ret < 0 ) - failwith_xc(_H(xch)); + failwith_xc(xc); v = caml_alloc_tuple(8); Store_field(v, 0, caml_copy_int32(a)); @@ -197,7 +200,7 @@ CAMLprim value stub_xenctrlext_domain_get_acpi_s_state(value xch, value domid) ret = xc_get_hvm_param(xc, _D(domid), HVM_PARAM_ACPI_S_STATE, &v); caml_leave_blocking_section(); if ( ret != 0 ) - failwith_xc(_H(xch)); + failwith_xc(xc); CAMLreturn(Val_int(v)); } From 0994d963ddcae750081cb27c7661fed7aa09b3f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:11:26 +0000 Subject: [PATCH 39/75] wip --- xapi-lintcstubs.opam | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam index 134978719b9..556c1a37486 100644 --- a/xapi-lintcstubs.opam +++ b/xapi-lintcstubs.opam @@ -8,7 +8,6 @@ build: [ ] depends: [ "ocaml" {>= "4.08"} - "dune" {build & >= "3.0"} - "goblint" + "goblint" {>= "2.1.0"} ] synopsis: "OCaml C stub static analyzer" From 56a02a9853e629e67ef2c582488200454748e78b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:15:02 +0000 Subject: [PATCH 40/75] wip --- ocaml/vhd-tool/src/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/vhd-tool/src/dune b/ocaml/vhd-tool/src/dune index 4df704f8d00..2a7a7b5ded3 100644 --- a/ocaml/vhd-tool/src/dune +++ b/ocaml/vhd-tool/src/dune @@ -5,7 +5,7 @@ (language c) (names direct_copy_stubs) ) - (libraries cstruct io-page.unix lwt lwt.unix lwt_ssl) + (libraries cstruct io-page lwt lwt.unix lwt_ssl) (wrapped false) ) From e551fe4de551b9c278292d46cd1029a09f68bc57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:15:23 +0000 Subject: [PATCH 41/75] wip --- xapi.stdout.reference | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/xapi.stdout.reference b/xapi.stdout.reference index 769e3524dfe..ab2648dd2e1 100644 --- a/xapi.stdout.reference +++ b/xapi.stdout.reference @@ -1 +1 @@ -Writing Sarif to file: ocaml/xapi.sarif +Writing Sarif to file: xapi.sarif From cfff1f0dfc801f6a5203d6756e4d3aa6ccfc2ed9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:17:30 +0000 Subject: [PATCH 42/75] pin my fork of xs-opam DO NOT MERGE --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 4c3303d9dbe..a7f31bddac1 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -43,7 +43,7 @@ jobs: - name: Pull configuration from xs-opam run: | - curl --fail --silent https://raw.githubusercontent.com/xapi-project/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env + curl --fail --silent https://raw.githubusercontent.com/edwintorok/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env - name: Load environment file id: dotenv From 8b85543f6cc9353b3a3cfd21e7ebd536caadc31d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:18:51 +0000 Subject: [PATCH 43/75] DO NOT MERGE: reintroduce one of the race conditions to check .sarif in CI --- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 3a0b001f621..b373f6acb48 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -279,9 +279,8 @@ CAMLprim value stub_xenctrlext_assign_device(value xch, value domid, value machine_sbdf, value flag) { CAMLparam4(xch, domid, machine_sbdf, flag); - xc_interface* xc = _H(xch); caml_enter_blocking_section(); - int retval = xc_assign_device(xc, _D(domid), Int_val(machine_sbdf), + int retval = xc_assign_device(_H(xch), _D(domid), Int_val(machine_sbdf), Int_val(flag)); caml_leave_blocking_section(); if ( retval ) From 6dd0a87fd12ae3c657fa007e0af389ce3f55643c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:19:51 +0000 Subject: [PATCH 44/75] fix SARIF path --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index d233a5a5910..e7e5ac255ec 100644 --- a/Makefile +++ b/Makefile @@ -24,7 +24,7 @@ clean: dune clean analyze: - dune build --profile=$(PROFILE) ocaml/xapi.sarif + dune build --profile=$(PROFILE) xapi.sarif lint: dune build @python From 10d249251151a7b80781d0952ff9b785edca401d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:22:42 +0000 Subject: [PATCH 45/75] fix SARIF rule --- .github/workflows/main.yml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index a7f31bddac1..4b3060e1d40 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -85,9 +85,10 @@ jobs: - name: Run static analyzer run: opam exec -- make analyze - - uses: github/codeql-actions/upload-sarif@v2 - - with: - sarif_file: _build/default/xapi.sarif + - name: Upload SARIF + uses: github/codeql-actions/upload-sarif@v2 + with: + sarif_file: _build/default/xapi.sarif - name: Run tests run: opam exec -- make test From 3b5af13f39b67e91af28e9282c2a203e6b22ddc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:25:14 +0000 Subject: [PATCH 46/75] fix SARIF rule --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 4b3060e1d40..f6d3cebff3a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -86,7 +86,7 @@ jobs: run: opam exec -- make analyze - name: Upload SARIF - uses: github/codeql-actions/upload-sarif@v2 + uses: github/codeql-action/upload-sarif@v2 with: sarif_file: _build/default/xapi.sarif From dc6c1ed4be86cee78f1e5568b75c5679c4ceb58d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:45:30 +0000 Subject: [PATCH 47/75] run static analyzer first. TODO move back --- .github/workflows/main.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index f6d3cebff3a..6c61ce8ce6c 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -79,9 +79,6 @@ jobs: - name: Configure run: opam exec -- ./configure --xapi_version="$XAPI_VERSION" - - name: Build - run: opam exec -- make - - name: Run static analyzer run: opam exec -- make analyze @@ -90,6 +87,9 @@ jobs: with: sarif_file: _build/default/xapi.sarif + - name: Build + run: opam exec -- make + - name: Run tests run: opam exec -- make test From 5b79c749c1e79e773c2dc4b9d3c2c5f18348c816 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:54:32 +0000 Subject: [PATCH 48/75] iopage --- ocaml/xenopsd/dbgring/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xenopsd/dbgring/dune b/ocaml/xenopsd/dbgring/dune index 74af0e00de9..32754e37869 100644 --- a/ocaml/xenopsd/dbgring/dune +++ b/ocaml/xenopsd/dbgring/dune @@ -4,7 +4,7 @@ (package xapi-xenopsd-xc) (libraries dune-build-info - io-page-unix + io-page xen-gnt xen-gnt-unix ) From 9452c0dd67adf850691fe16c0f349ab333c69abb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 14:56:59 +0000 Subject: [PATCH 49/75] disable opam cache for now, TODO: make it invalidate based on source repo --- .github/workflows/main.yml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 6c61ce8ce6c..544cdc78505 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -54,13 +54,13 @@ jobs: run: echo "::set-output name=date::$(/bin/date -u "+%Y%m%d")" shell: bash - - name: Restore opam cache - id: opam-cache - uses: actions/cache@v2 - with: - path: "~/.opam" - # invalidate cache daily, gets built daily using a scheduled job - key: ${{ steps.cache-key.outputs.date }} + #- name: Restore opam cache + # id: opam-cache + #uses: actions/cache@v2 + #with: +# path: "~/.opam" +# # invalidate cache daily, gets built daily using a scheduled job +# key: ${{ steps.cache-key.outputs.date }} - name: Use ocaml uses: avsm/setup-ocaml@v1 From 95433a399bd408b62231c2c0eaca9c7b8ff0a959 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 15:09:37 +0000 Subject: [PATCH 50/75] unixpwd: fix build needs uerror --- unixpwd/test/dune | 1 + 1 file changed, 1 insertion(+) diff --git a/unixpwd/test/dune b/unixpwd/test/dune index 77d360eedad..86c4717c549 100644 --- a/unixpwd/test/dune +++ b/unixpwd/test/dune @@ -4,6 +4,7 @@ (libraries unixpwd_stubs unixpwd + unix ) ) From 74d6f197a63ba8ba87e54d414440060e81b489d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 15:16:45 +0000 Subject: [PATCH 51/75] add xapi-lintcstubs to CI, needed for static analyzer --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 544cdc78505..7d2bc23d675 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -25,7 +25,7 @@ jobs: name: Ocaml tests runs-on: ubuntu-20.04 env: - package: "xapi-cli-protocol xapi-client xapi-consts xapi-database xapi-datamodel xapi-types xapi xe xen-api-sdk xen-api-client xen-api-client-lwt xen-api-client-async xapi-rrdd xapi-rrdd-plugin xapi-rrd-transport xapi-rrd-transport-utils rrd-transport rrdd-plugin rrdd-plugins rrddump gzip http-svr pciutil safe-resources sexpr stunnel uuid xapi-compression xml-light2 zstd vhd-tool xapi-networkd xapi-squeezed xapi-xenopsd xapi-xenopsd-cli xapi-xenopsd-simulator xapi-xenopsd-xc message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-storage-cli wsproxy xapi-nbd varstored-guard xapi-log xapi-open-uri" + package: "xapi-cli-protocol xapi-client xapi-consts xapi-database xapi-datamodel xapi-types xapi xe xen-api-sdk xen-api-client xen-api-client-lwt xen-api-client-async xapi-rrdd xapi-rrdd-plugin xapi-rrd-transport xapi-rrd-transport-utils rrd-transport rrdd-plugin rrdd-plugins rrddump gzip http-svr pciutil safe-resources sexpr stunnel uuid xapi-compression xml-light2 zstd vhd-tool xapi-networkd xapi-squeezed xapi-xenopsd xapi-xenopsd-cli xapi-xenopsd-simulator xapi-xenopsd-xc message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-storage-cli wsproxy xapi-nbd varstored-guard xapi-log xapi-open-uri xapi-lintcstubs" XAPI_VERSION: "v0.0.0-${{ github.sha }}" steps: From a7440f1d7b6c356f9d0c7bae4a59d9b85050930c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 15:20:08 +0000 Subject: [PATCH 52/75] fixup! genmain fixed, and fix wrong number of arguments bug --- ocaml/xenopsd/c_stubs/xenctrlext.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext.ml b/ocaml/xenopsd/c_stubs/xenctrlext.ml index f53b311c72a..a13aa2e1c29 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext.ml +++ b/ocaml/xenopsd/c_stubs/xenctrlext.ml @@ -112,7 +112,7 @@ module Xenforeignmemory = struct type prot = {read: bool; write: bool; exec: bool} - external acquire : Xentoollog.handle option -> int -> handle + external acquire : Xentoollog.handle option -> handle = "stub_xenforeignmemory_open" external release : handle -> unit = "stub_xenforeignmemory_close" From ba3f1ddcbe7f942dc8d29a2ea5dc61d4a3d14efc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 15:20:27 +0000 Subject: [PATCH 53/75] fixup! genmain fixed, and fix wrong number of arguments bug --- ocaml/xenopsd/c_stubs/xenctrlext.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext.mli b/ocaml/xenopsd/c_stubs/xenctrlext.mli index 673a98ffb9d..1f88f2781e5 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext.mli +++ b/ocaml/xenopsd/c_stubs/xenctrlext.mli @@ -93,7 +93,7 @@ module Xenforeignmemory : sig type prot = {read: bool; write: bool; exec: bool} - val acquire : Xentoollog.handle option -> int -> handle + val acquire : Xentoollog.handle option -> handle val release : handle -> unit From 95c70db95cb98f8f0240a8fc01b34844fbb05832 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 16:47:54 +0000 Subject: [PATCH 54/75] revert github workflow changes --- .github/workflows/main.yml | 26 +++++++++----------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 7d2bc23d675..49f0a56cfc5 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -25,7 +25,7 @@ jobs: name: Ocaml tests runs-on: ubuntu-20.04 env: - package: "xapi-cli-protocol xapi-client xapi-consts xapi-database xapi-datamodel xapi-types xapi xe xen-api-sdk xen-api-client xen-api-client-lwt xen-api-client-async xapi-rrdd xapi-rrdd-plugin xapi-rrd-transport xapi-rrd-transport-utils rrd-transport rrdd-plugin rrdd-plugins rrddump gzip http-svr pciutil safe-resources sexpr stunnel uuid xapi-compression xml-light2 zstd vhd-tool xapi-networkd xapi-squeezed xapi-xenopsd xapi-xenopsd-cli xapi-xenopsd-simulator xapi-xenopsd-xc message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-storage-cli wsproxy xapi-nbd varstored-guard xapi-log xapi-open-uri xapi-lintcstubs" + package: "xapi-cli-protocol xapi-client xapi-consts xapi-database xapi-datamodel xapi-types xapi xe xen-api-sdk xen-api-client xen-api-client-lwt xen-api-client-async xapi-rrdd xapi-rrdd-plugin xapi-rrd-transport xapi-rrd-transport-utils rrd-transport rrdd-plugin rrdd-plugins rrddump gzip http-svr pciutil safe-resources sexpr stunnel uuid xapi-compression xml-light2 zstd vhd-tool xapi-networkd xapi-squeezed xapi-xenopsd xapi-xenopsd-cli xapi-xenopsd-simulator xapi-xenopsd-xc message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-storage-cli wsproxy xapi-nbd varstored-guard xapi-log xapi-open-uri" XAPI_VERSION: "v0.0.0-${{ github.sha }}" steps: @@ -43,7 +43,7 @@ jobs: - name: Pull configuration from xs-opam run: | - curl --fail --silent https://raw.githubusercontent.com/edwintorok/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env + curl --fail --silent https://raw.githubusercontent.com/xapi-project/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env - name: Load environment file id: dotenv @@ -54,13 +54,13 @@ jobs: run: echo "::set-output name=date::$(/bin/date -u "+%Y%m%d")" shell: bash - #- name: Restore opam cache - # id: opam-cache - #uses: actions/cache@v2 - #with: -# path: "~/.opam" -# # invalidate cache daily, gets built daily using a scheduled job -# key: ${{ steps.cache-key.outputs.date }} + - name: Restore opam cache + id: opam-cache + uses: actions/cache@v2 + with: + path: "~/.opam" + # invalidate cache daily, gets built daily using a scheduled job + key: ${{ steps.cache-key.outputs.date }} - name: Use ocaml uses: avsm/setup-ocaml@v1 @@ -79,14 +79,6 @@ jobs: - name: Configure run: opam exec -- ./configure --xapi_version="$XAPI_VERSION" - - name: Run static analyzer - run: opam exec -- make analyze - - - name: Upload SARIF - uses: github/codeql-action/upload-sarif@v2 - with: - sarif_file: _build/default/xapi.sarif - - name: Build run: opam exec -- make From 93a656db460bdf35ea055447e3adeba8c6afdbbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 16:48:05 +0000 Subject: [PATCH 55/75] add new workflow with own caching --- .github/workflows/staticanalysis.yml | 48 ++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 .github/workflows/staticanalysis.yml diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml new file mode 100644 index 00000000000..e3804ab1072 --- /dev/null +++ b/.github/workflows/staticanalysis.yml @@ -0,0 +1,48 @@ +name: Run OCaml C stub static analyzer on XAPI's C stubs + +on: + pull_request: + branches: + - master + - 'feature/**' + - '*-lcm' + +jobs: + ocaml-format: + name: Ocaml files + runs-on: ubuntu-22.04 + env: + package: "xapi-lintcstubs" + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Pull configuration from xs-opam + run: | + curl --fail --silent https://raw.githubusercontent.com/edwintorok/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env + + - name: Load environment file + id: dotenv + uses: falti/dotenv-action@v1.0.2 + + - name: Use ocaml + uses: avsm/setup-ocaml@v2 + with: + ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} + opam-repository: ${{ steps.dotenv.outputs.repository }} + dune-cache: true + + - name: Install dependencies for static analyzer + run: | + opam update + opam pin add xapi-lintcstubs . --no-action + opam install --deps-only ${{env.package}} + + - name: Run static analyzer + run: opam exec -- make analyze + + - name: Upload SARIF report + uses: github/codeql-action/upload-sarif@v2 + with: + sarif_file: _build/default/xapi.sarif From baa47c7ae07249d8eb219e6125399534509543bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:12:14 +0000 Subject: [PATCH 56/75] run on push --- .github/workflows/staticanalysis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index e3804ab1072..edbbb395e33 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -1,6 +1,7 @@ name: Run OCaml C stub static analyzer on XAPI's C stubs on: + push: pull_request: branches: - master From 6dfe4da22a5379c9f612b32a147078d37a8f3ced Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:14:23 +0000 Subject: [PATCH 57/75] opam-repositories for action v2 --- .github/workflows/staticanalysis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index edbbb395e33..adae43c3a43 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -31,14 +31,14 @@ jobs: uses: avsm/setup-ocaml@v2 with: ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} - opam-repository: ${{ steps.dotenv.outputs.repository }} + opam-repositories: ${{ steps.dotenv.outputs.repository }} dune-cache: true - name: Install dependencies for static analyzer run: | opam update opam pin add xapi-lintcstubs . --no-action - opam install --deps-only ${{env.package}} + opam install --deps-only ${{ env.package }} - name: Run static analyzer run: opam exec -- make analyze From 68e3d3c00d23e578cd83730cb35d0a83f0c80bba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:15:45 +0000 Subject: [PATCH 58/75] ocaml-compiler for action v2 --- .github/workflows/staticanalysis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index adae43c3a43..c5688367c27 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -30,7 +30,7 @@ jobs: - name: Use ocaml uses: avsm/setup-ocaml@v2 with: - ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} + ocaml-compiler: ${{ steps.dotenv.outputs.ocaml_version_full }} opam-repositories: ${{ steps.dotenv.outputs.repository }} dune-cache: true From dc4299ceb9b6ae674aba74b74a9b97a525ba31e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:18:23 +0000 Subject: [PATCH 59/75] log-vars for action v2 --- .github/workflows/staticanalysis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index c5688367c27..aa74eab2a7b 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -26,6 +26,8 @@ jobs: - name: Load environment file id: dotenv uses: falti/dotenv-action@v1.0.2 + with: + log-variables: true - name: Use ocaml uses: avsm/setup-ocaml@v2 From 4c0720c9b21b7045802d1730d7a0bc29f30787d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:20:45 +0000 Subject: [PATCH 60/75] opam-repositories for action v2 --- .github/workflows/staticanalysis.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index aa74eab2a7b..fb5c545cea1 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -33,7 +33,8 @@ jobs: uses: avsm/setup-ocaml@v2 with: ocaml-compiler: ${{ steps.dotenv.outputs.ocaml_version_full }} - opam-repositories: ${{ steps.dotenv.outputs.repository }} + opam-repositories: | + default: ${{ steps.dotenv.outputs.repository }} dune-cache: true - name: Install dependencies for static analyzer From 2247ee724911f30e8c692eee56336bf490ce9c81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:33:08 +0000 Subject: [PATCH 61/75] tag and configure first --- .github/workflows/staticanalysis.yml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index fb5c545cea1..23ca96df300 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -43,6 +43,18 @@ jobs: opam pin add xapi-lintcstubs . --no-action opam install --deps-only ${{ env.package }} + # The checkout action performs a shallow, this triggers dune to set the + # version to -dirty. Work around this dune behaviour and tag the + # commit so a proper version is always picked up + - name: Tag current commit + run: | + git config user.name "Dune workaround" + git config user.email "<>" + git tag -am "workaround for dune" "$XAPI_VERSION" + + - name: Configure + run: opam exec -- ./configure --xapi_version="$XAPI_VERSION" + - name: Run static analyzer run: opam exec -- make analyze From 86984ae1926b64fe2c73217db8a49c1df14d5d32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:36:26 +0000 Subject: [PATCH 62/75] only have 1 package here, faster pinning --- .github/workflows/staticanalysis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index 23ca96df300..abffefd685c 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -36,11 +36,11 @@ jobs: opam-repositories: | default: ${{ steps.dotenv.outputs.repository }} dune-cache: true + opam-local-packages: ${{ env.package }}.opam - name: Install dependencies for static analyzer run: | opam update - opam pin add xapi-lintcstubs . --no-action opam install --deps-only ${{ env.package }} # The checkout action performs a shallow, this triggers dune to set the From dcb04a9d9b885f96a1579d74e2fabdf436d47f08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:40:12 +0000 Subject: [PATCH 63/75] xapi version --- .github/workflows/staticanalysis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index abffefd685c..ce2ad4aeaa3 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -14,6 +14,7 @@ jobs: runs-on: ubuntu-22.04 env: package: "xapi-lintcstubs" + XAPI_VERSION: "v0.0.0-${{ github.sha }}" steps: - name: Checkout code From a00afbf6d08b7bf9b639841d8f9697940547d0d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:42:20 +0000 Subject: [PATCH 64/75] rename workflow --- .github/workflows/staticanalysis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index ce2ad4aeaa3..7880fb84ff1 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -9,7 +9,7 @@ on: - '*-lcm' jobs: - ocaml-format: + staticanalyzer: name: Ocaml files runs-on: ubuntu-22.04 env: From e1e8b6c3fa3c9d9fbb92edfe0b81e7a22008fbc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:43:37 +0000 Subject: [PATCH 65/75] try to enable dune caching for opam --- .github/workflows/staticanalysis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index 7880fb84ff1..ec6c4105aa1 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -15,6 +15,9 @@ jobs: env: package: "xapi-lintcstubs" XAPI_VERSION: "v0.0.0-${{ github.sha }}" + # required for dune cache to work inside opam for now, otherwise it + # gets EXDEV and considers it a cache miss + DUNE_CACHE_STORAGE_MODE: copy steps: - name: Checkout code From 3efce4c464566ab45747aa6025cb855364aec35a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:49:33 +0000 Subject: [PATCH 66/75] update deps --- xapi-lintcstubs.opam | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam index 556c1a37486..19fb1f3d925 100644 --- a/xapi-lintcstubs.opam +++ b/xapi-lintcstubs.opam @@ -9,5 +9,11 @@ build: [ depends: [ "ocaml" {>= "4.08"} "goblint" {>= "2.1.0"} + # for building the .cmt files, TODO: restructure libs such that C stubs + # have less deps + "xapi-stdext-pervasives" + "xentoollog" + "lwt_ssl" + "xenctrl" ] synopsis: "OCaml C stub static analyzer" From 32662d7facd982628c4f0343fcde35aac2f1305a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:50:33 +0000 Subject: [PATCH 67/75] update deps --- xapi-lintcstubs.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam index 19fb1f3d925..3c9a59c688f 100644 --- a/xapi-lintcstubs.opam +++ b/xapi-lintcstubs.opam @@ -15,5 +15,6 @@ depends: [ "xentoollog" "lwt_ssl" "xenctrl" + "io-page" ] synopsis: "OCaml C stub static analyzer" From 034601b877f8544280f976b6a16599ccf5e98211 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:55:35 +0000 Subject: [PATCH 68/75] show error --- dune | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/dune b/dune index 31f44165982..6d0397f2610 100644 --- a/dune +++ b/dune @@ -83,7 +83,6 @@ (progn (run rm -f goblint.sarif) (run ln -s %{read-lines:ctypesdir} ctypes) - (with-stderr-to lintcstubs.stderr (with-stdout-to lintcstubs.stdout (run ocaml/staticanalyzer/lintcstubs.exe -o xapi.sarif --disable warn.info --disable warn.unsound --disable warn.imprecise @@ -94,7 +93,7 @@ -I ocaml/auth -I ctypes -I unixpwd/c %{runtime_model} %{primitives_model} %{cstubs} - ))))) + )))) ) ; --enable dbg.debug --enable dbg.verbose ; TODO: show stderr too From 779da7f6103ceb28ea52ff0619ce754671a053d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 17:56:30 +0000 Subject: [PATCH 69/75] cache one run --- .github/workflows/staticanalysis.yml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index ec6c4105aa1..9b63a6f7975 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -59,10 +59,10 @@ jobs: - name: Configure run: opam exec -- ./configure --xapi_version="$XAPI_VERSION" - - name: Run static analyzer - run: opam exec -- make analyze - - - name: Upload SARIF report - uses: github/codeql-action/upload-sarif@v2 - with: - sarif_file: _build/default/xapi.sarif +# - name: Run static analyzer +# run: opam exec -- make analyze +# +# - name: Upload SARIF report +# uses: github/codeql-action/upload-sarif@v2 +# with: +# sarif_file: _build/default/xapi.sarif From c6fcc9f216858e2a90817f243108d7208f10ba8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 18:01:43 +0000 Subject: [PATCH 70/75] reenable --- .github/workflows/staticanalysis.yml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index 9b63a6f7975..8f9d08279e2 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -23,6 +23,8 @@ jobs: - name: Checkout code uses: actions/checkout@v3 + # we could just use the upstream repo here, but I want to ensure + # that we're able to run the static analyzer locally too - name: Pull configuration from xs-opam run: | curl --fail --silent https://raw.githubusercontent.com/edwintorok/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env @@ -59,10 +61,10 @@ jobs: - name: Configure run: opam exec -- ./configure --xapi_version="$XAPI_VERSION" -# - name: Run static analyzer -# run: opam exec -- make analyze -# -# - name: Upload SARIF report -# uses: github/codeql-action/upload-sarif@v2 -# with: -# sarif_file: _build/default/xapi.sarif + - name: Run static analyzer + run: opam exec -- make analyze + + - name: Upload SARIF report + uses: github/codeql-action/upload-sarif@v2 + with: + sarif_file: _build/default/xapi.sarif From 251ff0caafa86e06a604f5b8264c6d7bea58fb22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 10 Jan 2023 18:06:01 +0000 Subject: [PATCH 71/75] depexts --- xapi-lintcstubs.opam | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam index 3c9a59c688f..9c9361fb644 100644 --- a/xapi-lintcstubs.opam +++ b/xapi-lintcstubs.opam @@ -16,5 +16,13 @@ depends: [ "lwt_ssl" "xenctrl" "io-page" + "conf-pam" +] +depexts: [ + ["hwdata" "libxxhash-dev" "libxxhash0"] {os-distribution = "debian"} + ["hwdata" "libxxhash-dev" "libxxhash0"] {os-distribution = "ubuntu"} + ["hwdata" "xxhash-devel" "xxhash-libs"] {os-distribution = "centos"} + ["hwdata" "xxhash-devel" "xxhash-libs"] {os-distribution = "fedora"} + ["hwdata" "xxhash-dev" "xxhash"] {os-distribution = "alpine"} ] synopsis: "OCaml C stub static analyzer" From ed0052b0f395b82d559b776d9e00d33d1adc4b27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 12 Jan 2023 11:14:07 +0000 Subject: [PATCH 72/75] autoload runtime.model.c --- dune | 5 +++-- dune-project | 1 + ocaml/staticanalyzer/lintcstubs.ml | 20 ++++++++++++++++++- ocaml/staticanalyzer/model/dune | 8 +++++++- ...{runtime.model.c => ocaml_runtime.model.c} | 0 5 files changed, 30 insertions(+), 4 deletions(-) rename ocaml/staticanalyzer/model/{runtime.model.c => ocaml_runtime.model.c} (100%) diff --git a/dune b/dune index 6d0397f2610..000e5ba616d 100644 --- a/dune +++ b/dune @@ -66,8 +66,9 @@ (rule (targets xapi.sarif lintcstubs.stdout) (deps + (package xapi-lintcstubs) (:headers (glob_files ocaml/auth/*.h) (glob_files unixpwd/c/*.h) primitives.h) - (:runtime_model ocaml/staticanalyzer/model/runtime.model.c) + (:runtime_model ocaml/staticanalyzer/model/ocaml_runtime.model.c) (:primitives_model primitives.model.c) (:cstubs (glob_files ocaml/auth/*.c) @@ -91,7 +92,7 @@ --set ana.activated "[\"ocamlcstubs\",\"escape\"]" --sarif -I %{ocaml_where} -I ocaml/auth -I ctypes -I unixpwd/c - %{runtime_model} %{primitives_model} + %{primitives_model} %{cstubs} )))) ) diff --git a/dune-project b/dune-project index 2bb8483a939..da9f60d5310 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,5 @@ (lang dune 2.8) (cram enable) +(using dune_site 0.1) (formatting (enabled_for ocaml)) diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml index c4f76bb477c..2b2f19429f7 100644 --- a/ocaml/staticanalyzer/lintcstubs.ml +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -6,6 +6,10 @@ let rec activate name = List.iter activate deps ; GobConfig.set_auto "ana.activated[+]" name +let find_stub_source ~stubdirs name = + stubdirs |> List.map (fun dir -> Fpath.append dir name) + |> List.find_all (fun path -> path |> Fpath.to_string |> Sys.file_exists) + (** [set_default_flags ()] initializes goblint with flags suitable for parsing OCaml C stubs *) let set_default_flags () = (* all the flag names are documented in the JSON schema at: @@ -34,7 +38,21 @@ let set_default_flags () = [ana.autotune.activated]: List of activated tuning options. By default all are activated. *) - set_auto "ana.autotune.activated[-]" "singleThreaded" + set_auto "ana.autotune.activated[-]" "singleThreaded"; + + (* OCaml runtime model - needed so we know what locks/unlocks the runtime + lock + *) + let stubdirs = List.map Fpath.v Goblint_sites.lib_stub_src in + match find_stub_source ~stubdirs Fpath.(v "ocaml_runtime.model.c") with + | [] -> + Fmt.failwith "OCaml runtime model not found in %a" + Fmt.Dump.(list Fpath.pp) stubdirs + | [one] -> + set_auto "files[+]" @@ Fpath.to_string one + | (_ :: _) as l -> + Fmt.failwith "Multiple runtime models found: %a" + Fmt.Dump.(list Fpath.pp) l (** [enable_tracing_if_needed ()] enables tracing messages in our analyses if enabled on the CLI with [dbg.trace]. diff --git a/ocaml/staticanalyzer/model/dune b/ocaml/staticanalyzer/model/dune index 836eb3e7f4d..db6cfef99b5 100644 --- a/ocaml/staticanalyzer/model/dune +++ b/ocaml/staticanalyzer/model/dune @@ -5,7 +5,13 @@ (language c) (include_dirs include) (flags (:standard -Wno-attributes)) - (names runtime.model) + (names ocaml_runtime.model) ) (package xapi-lintcstubs) ) + +(install + (section (site (goblint lib_stub_src))) + (files ocaml_runtime.model.c) + (package xapi-lintcstubs) +) diff --git a/ocaml/staticanalyzer/model/runtime.model.c b/ocaml/staticanalyzer/model/ocaml_runtime.model.c similarity index 100% rename from ocaml/staticanalyzer/model/runtime.model.c rename to ocaml/staticanalyzer/model/ocaml_runtime.model.c From d9b6d9178213c6615dbed113e3078a9eab07304e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 12 Jan 2023 13:37:26 +0000 Subject: [PATCH 73/75] refactor .h generator to be smaller MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- .../staticanalyzer/arity/lintcstubs_arity.ml | 122 ++++-------------- 1 file changed, 24 insertions(+), 98 deletions(-) diff --git a/ocaml/staticanalyzer/arity/lintcstubs_arity.ml b/ocaml/staticanalyzer/arity/lintcstubs_arity.ml index 3ac16677d17..cbee68c5f31 100644 --- a/ocaml/staticanalyzer/arity/lintcstubs_arity.ml +++ b/ocaml/staticanalyzer/arity/lintcstubs_arity.ml @@ -1,8 +1,5 @@ (** Parse a .ml file, extract all 'external ...' primitives, - and print prototypes of C functions based on their number of arguments. - - If --verifier is specified then output attributes for [lintcstubs] to - recognize the C stubs as entry points. + and print prototypes of bytecode C functions based on their number of arguments. Uses compiler-libs, which has an unstable API that can change between compiler versions, so extract only the minimal information needed here. @@ -14,17 +11,8 @@ [ocamlc -dparsetree foo.ml] can be used to see how the parsetree looks like. *) -let verifier = ref false - -(** [spec] defines command line arguments parsed by [Arg.parse] *) -let spec = - [("--verifier", Arg.Set verifier, "output attributes for static analyzer")] - -let tool_name = Sys.executable_name - -let usage_msg = Printf.sprintf "%s [FILE.ml...]" tool_name -(** [argity_of_type typ] returns the number of arguments for the function type [typ]. +(** [arity_of_type typ] returns the number of arguments for the function type [typ]. Type aliases are not expanded, and we only recurse on right hand side of the type arrow. @@ -35,45 +23,6 @@ let rec arity_of_type = function | {ptyp_desc= Ptyp_arrow (_, _t1, t2); _} -> 1 + arity_of_type t2 | _ -> 0 -(** [print_c_prototype ~arity bytename nativename] prints C prototypes for - calls to user defined primitives implemented by [bytename] - (in bytecode mode) and [nativename] (in native code mode). - [arity] is the number of arguments, when <= 5 [bytename] and [nativename] - are the same. - - Does not support unboxed or untagged calls (filtered out by caller). -*) -let print_c_prototype ~arity bytename nativename = - let args = List.init arity @@ fun _ -> "value" in - let str_of_args args = String.concat ", " @@ List.rev args in - Printf.printf "CAMLprim value %s(%s);\n" nativename @@ str_of_args args ; - if arity <= 5 then - assert (bytename = nativename) - else - Printf.printf "CAMLprim value %s(value *argv, int argn);\n" bytename - -(** [warning loc fmt] prints a warning at source location [loc], - with message format defined by [fmt]. - *) -let warning loc = - Printf.ksprintf @@ fun msg -> - Location.prerr_warning loc (Preprocessor msg) - -(** [no_attrs typ] returns true if there are no attributes on the type - (components). - - @see -*) -let rec no_attrs = - let open Parsetree in - function - | {ptyp_attributes= _ :: _; _} -> - false - | {ptyp_desc= Ptyp_arrow (_, t1, t2); _} -> - no_attrs t1 && no_attrs t2 - | _ -> - true - (** [value_description _ vd] is invoked by the AST iterator for value descriptions, including primitives ('external ...'). @@ -82,48 +31,34 @@ let rec no_attrs = let value_description _ vd = let open Parsetree in let arity = arity_of_type vd.pval_type in - match vd.pval_prim, vd.pval_attributes with - | [], _ -> () (* not a primitive *) - | _, ([] | [{attr_name= {txt= "noalloc"; _}; _}]) when no_attrs vd.pval_type -> ( - (* only process descriptions with no attributes, or with the [@@noalloc] - attribute: in these cases the C stub is always called with [value] - arguments. - *) - match vd.pval_prim with - | [] -> - () (* not a primitive *) - | builtin :: _ when builtin.[0] = '%' -> - () (* call to builtin primitive, no prototypes to print *) - | [cfunction] -> - print_c_prototype ~arity cfunction cfunction - | [bytecode_c_function; native_c_function] -> - print_c_prototype ~arity bytecode_c_function native_c_function - | _ -> - (* According to https://v2.ocaml.org/manual/intfc.html#ss:c-prim-decl - extra flags names are reserved for the standard library's use - *) - warning vd.pval_loc - "Ignored primitive declaration %S: flag names are not supported" - vd.pval_name.txt - ) - | _ -> - (* Would need a Typedtree to correctly interpret these, see - lintcstubs_cmt. - It is in theory possible to redefine builtin types like - 'type int = string', - thus we need the final, resolved type name to be sure. - In this tool just ignore them. + match vd.pval_prim with + | [] -> + () (* not a primitive *) + | builtin :: _ when builtin = "" || builtin.[0] = '%' -> + () (* call to builtin primitive, no prototypes to print *) + | bytecode_c_function :: _ -> + (* print prototype only for bytecode function. + To correctly print the prototype for the native function we'd need + to process the typedtree, which the full static analyzer will do. + Processing just the AST has fewer dependencies on the compiler + version. *) - warning vd.pval_loc "Ignored primitive declaration %S: has attributes" - vd.pval_name.txt - -let verifier_section = "goblint-ocaml-cstub" + let args = + if arity <= 5 then + List.init arity @@ fun _ -> "value" + else + ["value *argv"; "int argn"] + in + Printf.printf "CAMLprim value %s(%s);" bytecode_c_function + (String.concat ", " args) let () = + let tool_name = Sys.executable_name in let files = (* use Arg for parsing to minimize dependencies *) let lst = ref [] in - Arg.parse spec (fun file -> lst := file :: !lst) usage_msg ; + let usage_msg = Printf.sprintf "%s [FILE.ml...]" tool_name in + Arg.parse [] (fun file -> lst := file :: !lst) usage_msg ; !lst in (* [CAML_NAME_SPACE] is recommended by the manual *) @@ -131,15 +66,6 @@ let () = (* get the definition of [value] *) print_endline "#include " ; - if !verifier then ( - print_endline "#undef CAMLprim" ; - (* The section name here must match the one used by the static analyzer, - TODO export as a variable - *) - Printf.printf {|#define CAMLprim __attribute__((section("%s")))|} - verifier_section ; - print_endline "" - ) ; try files |> List.iter @@ fun path -> From 18ac1eec175589168fc9403c5bb71a1fba932b23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 12 Jan 2023 13:37:30 +0000 Subject: [PATCH 74/75] reformat --- ocaml/staticanalyzer/analyses/ocamlcstubs.ml | 35 ++++----- .../staticanalyzer/arity/lintcstubs_arity.ml | 3 +- .../genmain/lintcstubs_genmain.ml | 76 ++++++++++--------- ocaml/staticanalyzer/lintcstubs.ml | 18 +++-- 4 files changed, 73 insertions(+), 59 deletions(-) diff --git a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml index 9c93667a064..3c4116ee81f 100644 --- a/ocaml/staticanalyzer/analyses/ocamlcstubs.ml +++ b/ocaml/staticanalyzer/analyses/ocamlcstubs.ml @@ -23,18 +23,20 @@ module DomainLock = struct let runtime_lock_var = let g = ref None in fun () -> - match !g with - | Some v -> v - | None -> - let k = "__VERIFIER_ocaml_runtime_lock" in - match VarQuery.varqueries_from_names !Cilfacade.current_file [k] with - | [VarQuery.Global v], _ -> - g := Some v; - v - | _ -> - let v = Goblintutil.create_var @@ makeGlobalVar k intType in - g := Some v; - v + match !g with + | Some v -> + v + | None -> ( + let k = "__VERIFIER_ocaml_runtime_lock" in + match VarQuery.varqueries_from_names !Cilfacade.current_file [k] with + | [VarQuery.Global v], _ -> + g := Some v ; + v + | _ -> + let v = Goblintutil.create_var @@ makeGlobalVar k intType in + g := Some v ; + v + ) let runtime_lock_event () = LockDomain.Addr.from_var @@ runtime_lock_var () @@ -118,12 +120,11 @@ module Cstub = struct let is_cstub_entry _ctx f = is_cstub_entry_svar f.svar - let enter_cstub ctx _ = - ctx.local + let enter_cstub ctx _ = ctx.local let leave_cstub ctx f = (* runtime lock must be held when exiting the C stub, because it'll return - to OCaml code *) + to OCaml code *) DomainLock.must_be_held ctx "exiting C stub" f.vname ; ctx.local @@ -313,8 +314,8 @@ let dep = ThreadEscape.Spec.name () (* without everything that gets its address taken is considered global *) ; AccessAnalysis.Spec.name () (* for Events.Access *) - ; MutexAnalysis.Spec.name - () (* for Queries.{MustLockset, MustBeProtectedBy} *) + ; MutexAnalysis.Spec.name () + (* for Queries.{MustLockset, MustBeProtectedBy} *) ; MutexEventsAnalysis.Spec.name () (* for Events.Lock *) ; (let module M = (val Base.get_main ()) in M.name () diff --git a/ocaml/staticanalyzer/arity/lintcstubs_arity.ml b/ocaml/staticanalyzer/arity/lintcstubs_arity.ml index cbee68c5f31..8766bbbeae1 100644 --- a/ocaml/staticanalyzer/arity/lintcstubs_arity.ml +++ b/ocaml/staticanalyzer/arity/lintcstubs_arity.ml @@ -45,7 +45,8 @@ let value_description _ vd = *) let args = if arity <= 5 then - List.init arity @@ fun _ -> "value" + (* List.init would require OCaml 4.06 *) + Array.make arity "value" |> Array.to_list else ["value *argv"; "int argn"] in diff --git a/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml b/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml index 1fda872aceb..a6b8daae99c 100644 --- a/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml +++ b/ocaml/staticanalyzer/genmain/lintcstubs_genmain.ml @@ -44,17 +44,20 @@ let gen_of_native_arg args = | Bytecode_argn -> List.length args |> string_of_int -module StringSet = Set.Make(String) +module StringSet = Set.Make (String) + let calls = ref StringSet.empty let print_call ~noalloc res name args = let open Printf in - if not @@ StringSet.mem name !calls then begin - calls := StringSet.add name !calls; + if not @@ StringSet.mem name !calls then ( + calls := StringSet.add name !calls ; printf "static void __call_%s(void) {\n" name ; if noalloc then printf "\tCAMLnoalloc;\n" ; - printf "\t%s res = %s(%s);\n" (Primitives_of_cmt.ctype_of_native_arg res) name + printf "\t%s res = %s(%s);\n" + (Primitives_of_cmt.ctype_of_native_arg res) + name @@ String.concat ", " @@ List.map (gen_of_native_arg args) args ; if res = Value then @@ -65,7 +68,7 @@ let print_call ~noalloc res name args = printf "\t(void)res;\n" ; (* suppress unused value warning *) print_endline "}" - end + ) let print_c_prototype ~noalloc res name args = let open Primitives_of_cmt in @@ -95,38 +98,41 @@ let primitive_description desc = (* according to https://v2.ocaml.org/manual/intfc.html#ss:c-prim-impl if the primitive takes more than 5 arguments then bytecode and native mode implementations must be different *) - assert (desc.arity <= 5); + assert (desc.arity <= 5) ; print_endline "" let print_call_all () = (* TODO: could use Format module *) print_endline "static void* __call__all(void* arg) {" ; - print_endline "\t(void)arg;"; - print_endline "\tcaml_leave_blocking_section();"; + print_endline "\t(void)arg;" ; + print_endline "\tcaml_leave_blocking_section();" ; (* some of these may raise exceptions, so use a nondet to choose which one to call, to ensure they are all seen as called *) print_endline "\tswitch(__VERIFIER_nondet_int()) {" ; let () = !calls - |> StringSet.elements |> List.iteri @@ fun i name -> + |> StringSet.elements + |> List.iteri @@ fun i name -> Printf.printf "\tcase %d: __call_%s(); break;\n" i name in print_endline "\tdefault: __caml_maybe_run_gc(); break;" ; print_endline "\t}" ; - print_endline "\tcaml_enter_blocking_section();"; - print_endline "}"; - - print_endline ""; - print_endline "#include "; - print_endline "int main(void)"; - print_endline "{"; - print_endline "\tpthread_t thread;"; - print_endline "\tint rc = pthread_create(&thread, NULL, __call__all, NULL);"; - print_endline "\t__goblint_assume(!rc);"; (* don't model thread creation failure *) - print_endline "\t(void)__call__all(NULL);"; - print_endline "\trc = pthread_join(thread, NULL);"; - print_endline "\t__goblint_assume(!rc);"; (* don't model thread creation failure *) - print_endline "\treturn 0;"; + print_endline "\tcaml_enter_blocking_section();" ; + print_endline "}" ; + + print_endline "" ; + print_endline "#include " ; + print_endline "int main(void)" ; + print_endline "{" ; + print_endline "\tpthread_t thread;" ; + print_endline "\tint rc = pthread_create(&thread, NULL, __call__all, NULL);" ; + print_endline "\t__goblint_assume(!rc);" ; + (* don't model thread creation failure *) + print_endline "\t(void)__call__all(NULL);" ; + print_endline "\trc = pthread_join(thread, NULL);" ; + print_endline "\t__goblint_assume(!rc);" ; + (* don't model thread creation failure *) + print_endline "\treturn 0;" ; print_endline "}" let () = @@ -138,9 +144,10 @@ let () = in print_endline {|#include "primitives.h"|} ; - print_endline {|#include |}; - print_endline {|#include "caml/threads.h"|}; - Printf.printf {| + print_endline {|#include |} ; + print_endline {|#include "caml/threads.h"|} ; + Printf.printf + {| #ifndef CAMLnoalloc /* GC status assertions. @@ -160,19 +167,20 @@ void caml_alloc_point_here(void); #define CAMLalloc_point_here ((void)0) #endif #endif - |}; + |} ; let () = (* TODO: put in a header *) - Printf.printf "int __VERIFIER_nondet_int(void);\n"; - Printf.printf "void __access_Val(value);\n"; + Printf.printf "int __VERIFIER_nondet_int(void);\n" ; + Printf.printf "void __access_Val(value);\n" ; Primitives_of_cmt.[Value; Double; Int32; Int64; Intnat] |> List.iter @@ fun t -> print_nondet_prototype t in - print_endline "void __caml_maybe_run_gc(void);"; + print_endline "void __caml_maybe_run_gc(void);" ; Primitives_of_cmt.with_report_exceptions @@ fun () -> - let () = files - |> List.iter @@ fun path -> - Primitives_of_cmt.iter_primitives_exn ~path primitive_description; + let () = + files + |> List.iter @@ fun path -> + Primitives_of_cmt.iter_primitives_exn ~path primitive_description in - print_call_all (); + print_call_all () diff --git a/ocaml/staticanalyzer/lintcstubs.ml b/ocaml/staticanalyzer/lintcstubs.ml index 2b2f19429f7..e29fd8c92d8 100644 --- a/ocaml/staticanalyzer/lintcstubs.ml +++ b/ocaml/staticanalyzer/lintcstubs.ml @@ -7,7 +7,8 @@ let rec activate name = GobConfig.set_auto "ana.activated[+]" name let find_stub_source ~stubdirs name = - stubdirs |> List.map (fun dir -> Fpath.append dir name) + stubdirs + |> List.map (fun dir -> Fpath.append dir name) |> List.find_all (fun path -> path |> Fpath.to_string |> Sys.file_exists) (** [set_default_flags ()] initializes goblint with flags suitable for parsing OCaml C stubs *) @@ -38,7 +39,7 @@ let set_default_flags () = [ana.autotune.activated]: List of activated tuning options. By default all are activated. *) - set_auto "ana.autotune.activated[-]" "singleThreaded"; + set_auto "ana.autotune.activated[-]" "singleThreaded" ; (* OCaml runtime model - needed so we know what locks/unlocks the runtime lock @@ -47,12 +48,14 @@ let set_default_flags () = match find_stub_source ~stubdirs Fpath.(v "ocaml_runtime.model.c") with | [] -> Fmt.failwith "OCaml runtime model not found in %a" - Fmt.Dump.(list Fpath.pp) stubdirs + Fmt.Dump.(list Fpath.pp) + stubdirs | [one] -> - set_auto "files[+]" @@ Fpath.to_string one - | (_ :: _) as l -> + set_auto "files[+]" @@ Fpath.to_string one + | _ :: _ as l -> Fmt.failwith "Multiple runtime models found: %a" - Fmt.Dump.(list Fpath.pp) l + Fmt.Dump.(list Fpath.pp) + l (** [enable_tracing_if_needed ()] enables tracing messages in our analyses if enabled on the CLI with [dbg.trace]. @@ -98,7 +101,8 @@ let report_results () = (* if [--enable gobview --set save_run DIR] is used output extra information for [gobview] into [DIR]. *) Maingoblint.do_gobview () ; - if !Goblintutil.verified = Some false then exit 3 (* verifier failed! *) + if !Goblintutil.verified = Some false then exit 3 +(* verifier failed! *) (** [main ()] entrypoint for our C stub static analyzer. From 03e808a271c40fbd53e9d566ba623f93934a0ded Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 12 Jan 2023 19:56:58 +0000 Subject: [PATCH 75/75] reduce tool deps to allow independent install --- .github/workflows/staticanalysis.yml | 3 +++ xapi-lintcstubs.opam | 15 --------------- 2 files changed, 3 insertions(+), 15 deletions(-) diff --git a/.github/workflows/staticanalysis.yml b/.github/workflows/staticanalysis.yml index 8f9d08279e2..776b75f1a2f 100644 --- a/.github/workflows/staticanalysis.yml +++ b/.github/workflows/staticanalysis.yml @@ -14,6 +14,8 @@ jobs: runs-on: ubuntu-22.04 env: package: "xapi-lintcstubs" + # for building .cmt, TODO: restructure so the C stubs don't need these + xapideps: "xentoollog xapi-stdext-pervasives lwt_ssl xenctrl io-page conf-pam conf-xxhash" XAPI_VERSION: "v0.0.0-${{ github.sha }}" # required for dune cache to work inside opam for now, otherwise it # gets EXDEV and considers it a cache miss @@ -48,6 +50,7 @@ jobs: run: | opam update opam install --deps-only ${{ env.package }} + opam install ${{ env.xapideps }} # The checkout action performs a shallow, this triggers dune to set the # version to -dirty. Work around this dune behaviour and tag the diff --git a/xapi-lintcstubs.opam b/xapi-lintcstubs.opam index 9c9361fb644..556c1a37486 100644 --- a/xapi-lintcstubs.opam +++ b/xapi-lintcstubs.opam @@ -9,20 +9,5 @@ build: [ depends: [ "ocaml" {>= "4.08"} "goblint" {>= "2.1.0"} - # for building the .cmt files, TODO: restructure libs such that C stubs - # have less deps - "xapi-stdext-pervasives" - "xentoollog" - "lwt_ssl" - "xenctrl" - "io-page" - "conf-pam" -] -depexts: [ - ["hwdata" "libxxhash-dev" "libxxhash0"] {os-distribution = "debian"} - ["hwdata" "libxxhash-dev" "libxxhash0"] {os-distribution = "ubuntu"} - ["hwdata" "xxhash-devel" "xxhash-libs"] {os-distribution = "centos"} - ["hwdata" "xxhash-devel" "xxhash-libs"] {os-distribution = "fedora"} - ["hwdata" "xxhash-dev" "xxhash"] {os-distribution = "alpine"} ] synopsis: "OCaml C stub static analyzer"