diff --git a/dune-project b/dune-project index f47e2b8ff83..3d0d29be904 100644 --- a/dune-project +++ b/dune-project @@ -39,7 +39,7 @@ (package (name tgroup) - (depends + (depends xapi-log xapi-stdext-unix) ) @@ -502,6 +502,21 @@ This package provides an Lwt compatible interface to the library.") (package (name stunnel) + (synopsis "Library used by xapi to herd stunnel processes") + (description "This library allows xapi to configure, launch and terminate stunnel processes that act as clients and servers.") + (depends + astring + (forkexec (= :version)) + (safe-resources (= :version)) + (uuid (= :version)) + (xapi-consts (= :version)) + xapi-inventory + (xapi-log (= :version)) + (xapi-stdext-pervasives (= :version)) + (xapi-stdext-threads (= :version)) + (xapi-stdext-unix (= :version)) + (odoc :with-doc) + ) ) (package diff --git a/ocaml/database/block_device_io.ml b/ocaml/database/block_device_io.ml index 3081ae3ffde..b330e42284f 100644 --- a/ocaml/database/block_device_io.ml +++ b/ocaml/database/block_device_io.ml @@ -184,7 +184,7 @@ let get_pointer half = (* Lay out a blank double-buffered redo log on the given block device. *) (* May raise Unixext.Timeout exception *) let initialise_redo_log block_dev_fd target_response_time = - ignore_int (Unixext.seek_to block_dev_fd 0) ; + ignore (Unixext.seek_to block_dev_fd 0 : int) ; Unixext.time_limited_write_substring block_dev_fd magic_size magic target_response_time ; Unixext.time_limited_write_substring block_dev_fd 2 "\0000" @@ -221,7 +221,7 @@ let open_block_device block_dev target_response_time = (* Within the given block device, seek to the position of the validity byte. *) let seek_to_validity_byte block_dev_fd = - ignore_int (Unixext.seek_to block_dev_fd pos_validity_byte) + ignore (Unixext.seek_to block_dev_fd pos_validity_byte : int) (* Read the validity byte from the given block device. *) let read_validity_byte block_dev_fd target_response_time = @@ -279,14 +279,15 @@ let read_database block_dev_fd target_response_time = let db_fn f = let prev_pos = Unixext.current_cursor_pos block_dev_fd in (* Seek to the position of the database *) - ignore_int (Unixext.seek_to block_dev_fd cur_pos) ; + ignore (Unixext.seek_to block_dev_fd cur_pos : int) ; (* Read 'len' bytes from the block device and send them to the function we were given *) - ignore_int (Unixext.read_data_in_string_chunks f ~max_bytes:len block_dev_fd) ; + ignore + (Unixext.read_data_in_string_chunks f ~max_bytes:len block_dev_fd : int) ; (* Seek back to where we were before *) - ignore_int (Unixext.seek_to block_dev_fd prev_pos) + ignore (Unixext.seek_to block_dev_fd prev_pos : int) in (* For now, skip over where the database is *) - ignore_int (Unixext.seek_rel block_dev_fd len) ; + ignore (Unixext.seek_rel block_dev_fd len : int) ; (* Read the generation count and marker *) let generation_count = Int64.of_string (read generation_size) in let marker_end = read marker_size in @@ -471,7 +472,7 @@ let action_writedb block_dev_fd client datasock target_response_time = (* if neither half is valid, use the first half *) in (* Seek to the start of the chosen half *) - ignore_int (Unixext.seek_to block_dev_fd (start_of_half half_to_use)) ; + ignore (Unixext.seek_to block_dev_fd (start_of_half half_to_use) : int) ; (* Check that we've got enough space for two markers, a length and a generation count. This is the smallest possible size for a db record. *) let min_space_needed = (marker_size * 2) + size_size + generation_size in let available_space = Db_globs.redo_log_length_of_half in @@ -487,7 +488,7 @@ let action_writedb block_dev_fd client datasock target_response_time = R.debug "Cursor position to which the length will be written is %d" pos_to_write_length ; (* Seek forwards to the position to write the data *) - ignore_int (Unixext.seek_rel block_dev_fd size_size) ; + ignore (Unixext.seek_rel block_dev_fd size_size : int) ; (* Read the data from the data channel and write this directly into block_dev_fd *) let remaining_space = Db_globs.redo_log_length_of_half - marker_size - size_size @@ -523,7 +524,7 @@ let action_writedb block_dev_fd client datasock target_response_time = (Bytes.make trample_size '\000') target_response_time ; (* Seek backwards in the block device to where the length is supposed to go and write it *) - ignore_int (Unixext.seek_to block_dev_fd pos_to_write_length) ; + ignore (Unixext.seek_to block_dev_fd pos_to_write_length : int) ; let total_length_str = Printf.sprintf "%016d" total_length in Unixext.time_limited_write_substring block_dev_fd size_size total_length_str target_response_time ; @@ -680,7 +681,7 @@ let action_read block_dev_fd client datasock target_response_time = (* the log is empty *) (* Seek to the start of the chosen half *) - ignore_int (Unixext.seek_to block_dev_fd (start_of_half half_to_use)) ; + ignore (Unixext.seek_to block_dev_fd (start_of_half half_to_use) : int) ; (* Attempt to read a database record *) let length, db_fn, generation_count, marker = read_database block_dev_fd target_response_time @@ -783,7 +784,7 @@ let _ = (fun half -> Printf.printf "*** [Half %s] Entering half.\n" (half_to_string half) ; (* Seek to the start of the chosen half *) - ignore_int (Unixext.seek_to block_dev_fd (start_of_half half)) ; + ignore (Unixext.seek_to block_dev_fd (start_of_half half) : int) ; (* Attempt to read a database record *) try let length, db_fn, generation_count, marker = diff --git a/ocaml/libs/stunnel/stunnel.ml b/ocaml/libs/stunnel/stunnel.ml index 8f76d486e6c..93b990d8449 100644 --- a/ocaml/libs/stunnel/stunnel.ml +++ b/ocaml/libs/stunnel/stunnel.ml @@ -16,7 +16,6 @@ module D = Debug.Make (struct let name = "stunnel" end) open Printf -open Xapi_stdext_pervasives.Pervasiveext open Xapi_stdext_unix open Safe_resources @@ -87,8 +86,8 @@ module Unsafe = struct try pre_exec () ; (* CA-18955: xapi now runs with priority -3. We then set his sons priority to 0. *) - ignore_int (Unix.nice (-Unix.nice 0)) ; - ignore_int (Unix.setsid ()) ; + ignore (Unix.nice (-Unix.nice 0) : int) ; + ignore (Unix.setsid () : int) ; match env with | None -> Unix.execv argv0 args diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml index 7d8e16c4346..8264c944b3d 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml @@ -42,28 +42,3 @@ let finally fct clean_f = (** execute fct ignoring exceptions *) let ignore_exn fct = try fct () with _ -> () - -(* non polymorphic ignore function *) -let ignore_int v = - let (_ : int) = v in - () - -let ignore_int64 v = - let (_ : int64) = v in - () - -let ignore_int32 v = - let (_ : int32) = v in - () - -let ignore_string v = - let (_ : string) = v in - () - -let ignore_float v = - let (_ : float) = v in - () - -let ignore_bool v = - let (_ : bool) = v in - () diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli index 4190071de07..027a665d420 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli @@ -17,15 +17,3 @@ val finally : (unit -> 'a) -> (unit -> unit) -> 'a [g ()] even if [f ()] throws an exception. *) val ignore_exn : (unit -> unit) -> unit - -val ignore_int : int -> unit - -val ignore_int32 : int32 -> unit - -val ignore_int64 : int64 -> unit - -val ignore_string : string -> unit - -val ignore_float : float -> unit - -val ignore_bool : bool -> unit diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml index 111599f89d5..32a9f5119ab 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml @@ -219,7 +219,7 @@ let copy_file_internal ?limit reader writer = let num = reader buffer 0 (Int64.to_int requested) in let num64 = Int64.of_int num in limit := Option.map (fun x -> Int64.sub x num64) !limit ; - ignore_int (writer buffer 0 num) ; + ignore (writer buffer 0 num : int) ; total_bytes := Int64.add !total_bytes num64 ; finished := num = 0 || !limit = Some 0L done ; diff --git a/ocaml/rrd2csv/src/rrd2csv.ml b/ocaml/rrd2csv/src/rrd2csv.ml index 9c19a6a321f..a6866874ee2 100644 --- a/ocaml/rrd2csv/src/rrd2csv.ml +++ b/ocaml/rrd2csv/src/rrd2csv.ml @@ -655,7 +655,6 @@ let _ = R2.2. Ability to specify period of sampling on the command-line (in seconds) *) let user_filters, sampling_period, show_name, show_uuid = - let open Xapi_stdext_pervasives.Pervasiveext in (* R2.1.1. If none are specified, assume that all enabled data-sources are of interest *) let ds = ref [] and s = ref None and n = ref false and u = ref false in @@ -690,7 +689,7 @@ let _ = ; ( "-help" , Arg.Unit (fun () -> - ignore_int (Sys.command "man -M /opt/xensource/man rrd2csv") ; + ignore (Sys.command "man -M /opt/xensource/man rrd2csv" : int) ; exit 0 ) , " display help" @@ -698,7 +697,7 @@ let _ = ; ( "--help" , Arg.Unit (fun () -> - ignore_int (Sys.command "man -M /opt/xensource/man rrd2csv") ; + ignore (Sys.command "man -M /opt/xensource/man rrd2csv" : int) ; exit 0 ) , " display help" diff --git a/ocaml/xapi/repository_helpers.ml b/ocaml/xapi/repository_helpers.ml index 8ca948606be..62df609c53a 100644 --- a/ocaml/xapi/repository_helpers.ml +++ b/ocaml/xapi/repository_helpers.ml @@ -242,8 +242,7 @@ let get_remote_pool_coordinator_ip url = raise Api_errors.(Server_error (invalid_base_url, [url])) let assert_remote_pool_url_is_valid ~url = - get_remote_pool_coordinator_ip url - |> Xapi_stdext_pervasives.Pervasiveext.ignore_string + ignore (get_remote_pool_coordinator_ip url : string) let with_pool_repositories f = Xapi_stdext_pervasives.Pervasiveext.finally diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 243f9bf6162..e9cdbb13830 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -1970,8 +1970,7 @@ let attach_static_vdis ~__context ~host:_ ~vdi_reason_map = && v.Static_vdis_list.currently_attached in if not (List.exists check static_vdis) then - Pervasiveext.ignore_string - (Static_vdis.permanent_vdi_attach ~__context ~vdi ~reason) + ignore (Static_vdis.permanent_vdi_attach ~__context ~vdi ~reason : string) in List.iter attach vdi_reason_map diff --git a/ocaml/xapi/xapi_vdi_helpers.ml b/ocaml/xapi/xapi_vdi_helpers.ml index 15b00211d73..3cc2d4a7f5f 100644 --- a/ocaml/xapi/xapi_vdi_helpers.ml +++ b/ocaml/xapi/xapi_vdi_helpers.ml @@ -261,27 +261,27 @@ module VDI_CStruct = struct end let write_raw ~__context ~vdi ~text = - if String.length text >= VDI_CStruct.(vdi_size - vdi_format_length) then ( - let error_msg = - Printf.sprintf "Cannot write %d bytes to raw VDI. Capacity = %d bytes" - (String.length text) - VDI_CStruct.(vdi_size - vdi_format_length) - in - ignore (failwith error_msg) ; - Helpers.call_api_functions ~__context (fun rpc session_id -> - Sm_fs_ops.with_open_block_attached_device __context rpc session_id vdi - `RW (fun fd -> - let contents = Unixext.really_read_string fd VDI_CStruct.vdi_size in - let cstruct = Cstruct.of_string contents in - if VDI_CStruct.get_magic_number cstruct <> VDI_CStruct.magic_number - then - VDI_CStruct.format cstruct ; - VDI_CStruct.write cstruct text (String.length text) ; - Unix.ftruncate fd 0 ; - Unixext.seek_to fd 0 |> ignore ; - Unixext.really_write_string fd (VDI_CStruct.read cstruct) - ) - ) + ( if String.length text >= VDI_CStruct.(vdi_size - vdi_format_length) then + let error_msg = + Printf.sprintf "Cannot write %d bytes to raw VDI. Capacity = %d bytes" + (String.length text) + VDI_CStruct.(vdi_size - vdi_format_length) + in + failwith error_msg + ) ; + Helpers.call_api_functions ~__context (fun rpc session_id -> + Sm_fs_ops.with_open_block_attached_device __context rpc session_id vdi `RW + (fun fd -> + let contents = Unixext.really_read_string fd VDI_CStruct.vdi_size in + let cstruct = Cstruct.of_string contents in + if VDI_CStruct.get_magic_number cstruct <> VDI_CStruct.magic_number + then + VDI_CStruct.format cstruct ; + VDI_CStruct.write cstruct text (String.length text) ; + Unix.ftruncate fd 0 ; + ignore (Unixext.seek_to fd 0 : int) ; + Unixext.really_write_string fd (VDI_CStruct.read cstruct) + ) ) let read_raw ~__context ~vdi = diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index afca11c3ced..e2b6f741fc0 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -109,7 +109,7 @@ let start (xmlrpc_path, http_fwd_path) process = |> Http.Request.t_of_rpc in req.Http.Request.close <- true ; - ignore_bool (Http_svr.handle_one server received_fd () req) + ignore (Http_svr.handle_one server received_fd () req : bool) ) (fun _ -> Unix.close received_fd) ) ; diff --git a/stunnel.opam b/stunnel.opam index d28894c4d8c..a65c7f8810c 100644 --- a/stunnel.opam +++ b/stunnel.opam @@ -1,33 +1,39 @@ # This file is generated by dune, edit dune-project instead -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" opam-version: "2.0" -maintainer: "xen-api@lists.xen.org" -authors: "xen-api@lists.xen.org" +synopsis: "Library used by xapi to herd stunnel processes" +description: + "This library allows xapi to configure, launch and terminate stunnel processes that act as clients and servers." +maintainer: ["Xapi project maintainers"] +authors: ["xen-api@lists.xen.org"] +license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api.git" -dev-repo: "git+https://github.com/xapi-project/xen-api.git" -build: [[ "dune" "build" "-p" name "-j" jobs ]] - -available: [ os = "linux" ] +bug-reports: "https://github.com/xapi-project/xen-api/issues" depends: [ - "ocaml" "dune" {>= "3.15"} "astring" - "forkexec" - "safe-resources" - "uuid" - "xapi-consts" - "xapi-log" + "forkexec" {= version} + "safe-resources" {= version} + "uuid" {= version} + "xapi-consts" {= version} "xapi-inventory" - "xapi-stdext-pervasives" - "xapi-stdext-threads" - "xapi-stdext-unix" + "xapi-log" {= version} + "xapi-stdext-pervasives" {= version} + "xapi-stdext-threads" {= version} + "xapi-stdext-unix" {= version} + "odoc" {with-doc} ] -synopsis: "Library required by xapi" -description: """ -These libraries are provided for backwards compatibility only. -No new code should use these libraries.""" -url { - src: - "https://github.com/xapi-project/xen-api/archive/master.tar.gz" -} +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/xapi-project/xen-api.git" diff --git a/stunnel.opam.template b/stunnel.opam.template deleted file mode 100644 index be9d1ca0764..00000000000 --- a/stunnel.opam.template +++ /dev/null @@ -1,31 +0,0 @@ -opam-version: "2.0" -maintainer: "xen-api@lists.xen.org" -authors: "xen-api@lists.xen.org" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api.git" -dev-repo: "git+https://github.com/xapi-project/xen-api.git" -build: [[ "dune" "build" "-p" name "-j" jobs ]] - -available: [ os = "linux" ] -depends: [ - "ocaml" - "dune" {>= "3.15"} - "astring" - "forkexec" - "safe-resources" - "uuid" - "xapi-consts" - "xapi-log" - "xapi-inventory" - "xapi-stdext-pervasives" - "xapi-stdext-threads" - "xapi-stdext-unix" -] -synopsis: "Library required by xapi" -description: """ -These libraries are provided for backwards compatibility only. -No new code should use these libraries.""" -url { - src: - "https://github.com/xapi-project/xen-api/archive/master.tar.gz" -}