Skip to content

Commit

Permalink
Merge pull request #5880 from psafont/nowarns
Browse files Browse the repository at this point in the history
  • Loading branch information
psafont authored Jul 25, 2024
2 parents bc549cd + 9fd09c8 commit adf27d5
Show file tree
Hide file tree
Showing 23 changed files with 46 additions and 104 deletions.
2 changes: 1 addition & 1 deletion ocaml/database/master_connection.ml
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,7 @@ let force_connection_reset () =
host and port are fixed values. *)
let rec purge_stunnels verify_cert =
match
Stunnel_cache.with_remove ~host ~port verify_cert @@ fun st ->
Stunnel_cache.with_remove ~host ~port @@ fun st ->
try Stunnel.disconnect ~wait:false ~force:true st with _ -> ()
with
| None ->
Expand Down
4 changes: 2 additions & 2 deletions ocaml/idl/datamodel_lifecycle.ml
Original file line number Diff line number Diff line change
Expand Up @@ -28,9 +28,9 @@ let prototyped_of_field = function
| "Repository", "gpgkey_path" ->
Some "22.12.0"
| "Certificate", "fingerprint_sha1" ->
Some "24.19.1-next"
Some "24.20.0"
| "Certificate", "fingerprint_sha256" ->
Some "24.19.1-next"
Some "24.20.0"
| "Cluster_host", "last_update_live" ->
Some "24.3.0"
| "Cluster_host", "live" ->
Expand Down
2 changes: 1 addition & 1 deletion ocaml/idl/datamodel_values.ml
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ let to_ocaml_string v =
in
aux (to_rpc v)

let rec to_db v =
let to_db v =
let open Schema.Value in
match v with
| VString s ->
Expand Down
7 changes: 1 addition & 6 deletions ocaml/libs/http-lib/buf_io.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,7 @@
*)
(* Buffered IO with timeouts *)

type t = {
fd: Unix.file_descr
; mutable buf: bytes
; mutable cur: int
; mutable max: int
}
type t = {fd: Unix.file_descr; buf: bytes; mutable cur: int; mutable max: int}

type err =
| (* Line input is > 1024 chars *)
Expand Down
2 changes: 1 addition & 1 deletion ocaml/libs/http-lib/xmlrpc_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -189,7 +189,7 @@ let with_reusable_stunnel ?use_fork_exec_helper ?write_to_log ?verify_cert host
(* 1. First check if there is a suitable stunnel in the cache. *)
let rec loop () =
match
Stunnel_cache.with_remove ~host ~port verify_cert @@ fun x ->
Stunnel_cache.with_remove ~host ~port @@ fun x ->
if check_reusable x.Stunnel.fd (Stunnel.getpid x.Stunnel.pid) then
Ok (f x)
else (
Expand Down
20 changes: 5 additions & 15 deletions ocaml/libs/stunnel/stunnel_cache.ml
Original file line number Diff line number Diff line change
Expand Up @@ -37,11 +37,7 @@ let ignore_log fmt = Printf.ksprintf (fun _ -> ()) fmt
(* Use and overlay the definition from D. *)
let debug = if debug_enabled then debug else ignore_log

type endpoint = {
host: string
; port: int
; verified: Stunnel.verification_config option
}
type endpoint = {host: string; port: int}

(* Need to limit the absolute number of stunnels as well as the maximum age *)
let max_stunnel = 70
Expand Down Expand Up @@ -187,13 +183,7 @@ let add (x : Stunnel.t) =
incr counter ;
Hashtbl.add !times idx now ;
Tbl.move_into !stunnels idx x ;
let ep =
{
host= x.Stunnel.host
; port= x.Stunnel.port
; verified= x.Stunnel.verified
}
in
let ep = {host= x.Stunnel.host; port= x.Stunnel.port} in
let existing = Option.value (Hashtbl.find_opt !index ep) ~default:[] in
Hashtbl.replace !index ep (idx :: existing) ;
debug "Adding stunnel id %s (idle %.2f) to the cache" (id_of_stunnel x) 0. ;
Expand All @@ -203,8 +193,8 @@ let add (x : Stunnel.t) =
(** Returns an Stunnel.t for this endpoint (oldest first), raising Not_found
if none can be found. First performs a garbage-collection, which discards
expired stunnels if needed. *)
let with_remove ~host ~port verified f =
let ep = {host; port; verified} in
let with_remove ~host ~port f =
let ep = {host; port} in
let get_id () =
with_lock m (fun () ->
unlocked_gc () ;
Expand Down Expand Up @@ -253,7 +243,7 @@ let flush () =

let with_connect ?use_fork_exec_helper ?write_to_log ~verify_cert ~host ~port f
=
match with_remove ~host ~port verify_cert f with
match with_remove ~host ~port f with
| Some r ->
r
| None ->
Expand Down
3 changes: 1 addition & 2 deletions ocaml/libs/stunnel/stunnel_cache.mli
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ val with_connect :
-> (Stunnel.t -> 'b)
-> 'b
(** Connects via stunnel (optionally via an external 'fork/exec helper') to
a host and port. If there is a suitable stunnel in the cache then this
a host and port. If there is a suitable stunnel in the cache then this
will be used, otherwise we make a fresh one. *)

val add : Stunnel.t -> unit
Expand All @@ -37,7 +37,6 @@ val add : Stunnel.t -> unit
val with_remove :
host:string (** host *)
-> port:int (** port *)
-> Stunnel.verification_config option
-> (Stunnel.t -> 'b)
-> 'b option
(** Given a host and port call a function with a cached stunnel, or return None. *)
Expand Down
4 changes: 0 additions & 4 deletions ocaml/libs/vhd/vhd_format/f.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1607,8 +1607,6 @@ module Vhd = struct
module Field = struct
(** Dynamically-typed field-level access *)

type 'a f = {name: string; get: 'a t -> string}

let _features = "features"

let _data_offset = "data-offset"
Expand Down Expand Up @@ -1770,8 +1768,6 @@ module Vhd = struct
opt (fun (t, _) -> Int32.to_string t.Batmap_header.checksum) t.batmap
else
None

type 'a t = 'a f
end
end

Expand Down
5 changes: 2 additions & 3 deletions ocaml/libs/vhd/vhd_format_lwt/block.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ let pp_write_error = Mirage_block.pp_write_error

type info = Mirage_block.info

type t = {mutable vhd: IO.fd Vhd_format.F.Vhd.t option; info: info; id: string}
type t = {mutable vhd: IO.fd Vhd_format.F.Vhd.t option; info: info}

let connect path =
Lwt_unix.LargeFile.stat path >>= fun _ ->
Expand All @@ -38,8 +38,7 @@ let connect path =
let sector_size = 512 in
let size_sectors = Int64.div vhd.Vhd.footer.Footer.current_size 512L in
let info = Mirage_block.{read_write; sector_size; size_sectors} in
let id = path in
return {vhd= Some vhd; info; id}
return {vhd= Some vhd; info}

let disconnect t =
match t.vhd with
Expand Down
4 changes: 2 additions & 2 deletions ocaml/libs/vhd/vhd_format_lwt/iO.ml
Original file line number Diff line number Diff line change
Expand Up @@ -46,13 +46,13 @@ let complete name offset op fd buffer =
module Fd = struct
open Lwt

type fd = {fd: Lwt_unix.file_descr; filename: string; lock: Lwt_mutex.t}
type fd = {fd: Lwt_unix.file_descr; lock: Lwt_mutex.t}

let openfile filename rw =
let unix_fd = File.openfile filename rw 0o644 in
let fd = Lwt_unix.of_unix_file_descr unix_fd in
let lock = Lwt_mutex.create () in
return {fd; filename; lock}
return {fd; lock}

let fsync {fd; _} =
let fd' = Lwt_unix.unix_file_descr fd in
Expand Down
8 changes: 2 additions & 6 deletions ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.ml
Original file line number Diff line number Diff line change
Expand Up @@ -49,15 +49,13 @@ module Delay = struct
(* Concrete type is the ends of a pipe *)
type t = {
(* A pipe is used to wake up a thread blocked in wait: *)
mutable pipe_out: Unix.file_descr option
; mutable pipe_in: Unix.file_descr option
mutable pipe_in: Unix.file_descr option
; (* Indicates that a signal arrived before a wait: *)
mutable signalled: bool
; m: M.t
}

let make () =
{pipe_out= None; pipe_in= None; signalled= false; m= M.create ()}
let make () = {pipe_in= None; signalled= false; m= M.create ()}

exception Pre_signalled

Expand All @@ -80,7 +78,6 @@ module Delay = struct
let pipe_out, pipe_in = Unix.pipe () in
(* these will be unconditionally closed on exit *)
to_close := [pipe_out; pipe_in] ;
x.pipe_out <- Some pipe_out ;
x.pipe_in <- Some pipe_in ;
x.signalled <- false ;
pipe_out
Expand All @@ -99,7 +96,6 @@ module Delay = struct
)
(fun () ->
Mutex.execute x.m (fun () ->
x.pipe_out <- None ;
x.pipe_in <- None ;
List.iter close' !to_close
)
Expand Down
2 changes: 1 addition & 1 deletion ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml
Original file line number Diff line number Diff line change
Expand Up @@ -303,7 +303,7 @@ let open_connection_unix_fd filename =
module CBuf = struct
(** A circular buffer constructed from a string *)
type t = {
mutable buffer: bytes
buffer: bytes
; mutable len: int (** bytes of valid data in [buffer] *)
; mutable start: int (** index of first valid byte in [buffer] *)
; mutable r_closed: bool (** true if no more data can be read due to EOF *)
Expand Down
6 changes: 3 additions & 3 deletions ocaml/libs/xml-light2/xml.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ type xml =
| Element of (string * (string * string) list * xml list)
| PCData of string

type error_pos = {eline: int; eline_start: int; emin: int; emax: int}
type error_pos = {eline: int}

type error = string * error_pos

Expand Down Expand Up @@ -69,8 +69,8 @@ let _parse i =

let parse i =
try _parse i
with Xmlm.Error ((line, col), msg) ->
let pos = {eline= line; eline_start= line; emin= col; emax= col} in
with Xmlm.Error ((line, _), msg) ->
let pos = {eline= line} in
let err = Xmlm.error_message msg in
raise (Error (err, pos))

Expand Down
9 changes: 1 addition & 8 deletions ocaml/message-switch/switch/logging.ml
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,6 @@ type logger = {
stream: string Lwt_stream.t
; push: string -> unit
; elements: int ref
; max_elements: int
; dropped_elements: int ref
}

Expand All @@ -35,13 +34,7 @@ let create max_elements =
stream_push (Some line) ; incr !elements
)
in
{
stream
; push
; elements= !elements
; max_elements
; dropped_elements= !dropped_elements
}
{stream; push; elements= !elements; dropped_elements= !dropped_elements}

let get (logger : logger) =
let return_lines all =
Expand Down
12 changes: 3 additions & 9 deletions ocaml/rrd2csv/src/rrd2csv.ml
Original file line number Diff line number Diff line change
Expand Up @@ -143,18 +143,16 @@ module Ds_selector = struct
; owner: Rrd.ds_owner option
; uuid: string
; metric: string
; enabled: bool
}

let empty = {cf= None; owner= None; uuid= ""; metric= ""; enabled= true}
let empty = {cf= None; owner= None; uuid= ""; metric= ""}

let of_string str =
let open Rrd in
let splitted = Xstringext.String.split ':' str in
match splitted with
| [cf; owner; uuid; metric] ->
{
empty with
cf= (try Some (cf_type_of_string cf) with _ -> None)
; owner=
( match owner with
Expand Down Expand Up @@ -351,9 +349,7 @@ module Xport = struct
(* Xport.t structure *)

type meta = {
time_start: int64
; time_step: int64
; time_end: int64
time_step: int64
; entries: Ds_selector.t list
(* XXX: remove when merging *)
(* entries: Ds_selector.t list; *)
Expand Down Expand Up @@ -411,9 +407,7 @@ module Xport = struct
let process_meta (elts : xml_tree list) =
let kvs = kvs elts in
{
time_start= Int64.of_string (List.assoc "start" kvs)
; time_step= Int64.of_string (List.assoc "step" kvs)
; time_end= Int64.of_string (List.assoc "end" kvs)
time_step= Int64.of_string (List.assoc "step" kvs)
; entries= process_legend (find_elt "legend" elts)
}
in
Expand Down
4 changes: 2 additions & 2 deletions ocaml/xapi-idl/lib/scheduler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ module HandleMap = Map.Make (struct
c
end)

type item = {id: int; name: string; fn: unit -> unit}
type item = {name: string; fn: unit -> unit}

type t = {
mutable schedule: item HandleMap.t
Expand Down Expand Up @@ -88,7 +88,7 @@ let one_shot_f s dt (name : string) f =
with_lock s.m (fun () ->
let id = s.next_id in
s.next_id <- s.next_id + 1 ;
let item = {id; name; fn= f} in
let item = {name; fn= f} in
let handle = (time, id) in
s.schedule <- HandleMap.add handle item s.schedule ;
PipeDelay.signal s.delay ;
Expand Down
4 changes: 1 addition & 3 deletions ocaml/xapi-idl/lib/task_server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -101,14 +101,12 @@ functor
task_map: task_handle SMap.t ref
; mutable test_cancel_trigger: (string * int) option
; m: Mutex.t
; c: Condition.t
}

let empty () =
let task_map = ref SMap.empty in
let m = Mutex.create () in
let c = Condition.create () in
{task_map; test_cancel_trigger= None; m; c}
{task_map; test_cancel_trigger= None; m}

(* [next_task_id ()] returns a fresh task id *)
let next_task_id =
Expand Down
4 changes: 0 additions & 4 deletions ocaml/xapi/vgpuops.ml
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,6 @@ open Xapi_stdext_std.Xstringext
type vgpu_t = {
vgpu_ref: API.ref_VGPU
; gpu_group_ref: API.ref_GPU_group
; devid: int
; other_config: (string * string) list
; type_ref: API.ref_VGPU_type
; requires_passthrough: [`PF | `VF] option
}
Expand All @@ -31,8 +29,6 @@ let vgpu_of_ref ~__context vgpu =
{
vgpu_ref= vgpu
; gpu_group_ref= vgpu_r.API.vGPU_GPU_group
; devid= int_of_string vgpu_r.API.vGPU_device
; other_config= vgpu_r.API.vGPU_other_config
; type_ref= vgpu_r.API.vGPU_type
; requires_passthrough= Xapi_vgpu.requires_passthrough ~__context ~self:vgpu
}
Expand Down
9 changes: 1 addition & 8 deletions ocaml/xapi/xapi_dr_task.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,12 +26,7 @@ let make_task ~__context =
ref

(* A type to represent an SR record parsed from an sr_probe result. *)
type sr_probe_sr = {
uuid: string
; name_label: string
; name_description: string
; metadata_detected: bool
}
type sr_probe_sr = {uuid: string; name_label: string; name_description: string}

(* Attempt to parse a key/value pair from XML. *)
let parse_kv = function
Expand All @@ -53,8 +48,6 @@ let parse_sr_probe xml =
uuid= List.assoc "UUID" all
; name_label= List.assoc "name_label" all
; name_description= List.assoc "name_description" all
; metadata_detected=
List.assoc "pool_metadata_detected" all = "true"
}
| _ ->
failwith "Malformed or missing <SR>"
Expand Down
Loading

0 comments on commit adf27d5

Please sign in to comment.