From c92ed0485a8a71b831507385ec56e16767a7c1b3 Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Wed, 20 Dec 2017 15:03:47 +0000 Subject: [PATCH] CA-266936: Move pci lookups to string_opt to prevent some segfaults This does not fix the issue but can mitigate it Signed-off-by: Marcello Seri This is now needed in case the pointers are NULL. Cherry-picked from https://github.com/xapi-project/xen-api/commit/3f71785d6ca48474880ffcbadcd5fe2343574ba3 Signed-off-by: Pau Ruiz Safont --- bindings/ffi_bindings.ml | 6 +++--- examples/lspci.ml | 14 ++++++++------ lib/pci.mli | 12 ++++++------ lib_test/test_pci.ml | 15 ++++++++------- 4 files changed, 25 insertions(+), 22 deletions(-) diff --git a/bindings/ffi_bindings.ml b/bindings/ffi_bindings.ml index 811d850..ea9858d 100644 --- a/bindings/ffi_bindings.ml +++ b/bindings/ffi_bindings.ml @@ -264,15 +264,15 @@ module Bindings (F : Cstubs.FOREIGN) = struct let pci_lookup_name_1_ary = foreign "pci_lookup_name" - (Pci_access.t @-> ptr char @-> int @-> int @-> int @-> returning string) + (Pci_access.t @-> ptr char @-> int @-> int @-> int @-> returning string_opt) let pci_lookup_name_2_ary = foreign "pci_lookup_name" - (Pci_access.t @-> ptr char @-> int @-> int @-> int @-> int @-> returning string) + (Pci_access.t @-> ptr char @-> int @-> int @-> int @-> int @-> returning string_opt) let pci_lookup_name_4_ary = foreign "pci_lookup_name" - (Pci_access.t @-> ptr char @-> int @-> int @-> int @-> int @-> int @-> int @-> returning string) + (Pci_access.t @-> ptr char @-> int @-> int @-> int @-> int @-> int @-> int @-> returning string_opt) let pci_load_name_list = foreign "pci_load_name_list" (Pci_access.t @-> returning int) diff --git a/examples/lspci.ml b/examples/lspci.ml index 5f262d2..61ba348 100644 --- a/examples/lspci.ml +++ b/examples/lspci.ml @@ -2,23 +2,24 @@ open Pci (* This should be equivalent to `lspci -nnnDv` *) let lspci_nnnDv pci_access = + let default v = match v with Some v -> v | None -> "" in let devs = get_devices pci_access in List.iter (fun d -> let open Pci_dev in Printf.printf "Device: %04x:%02x:%02x.%d\n" d.domain d.bus d.dev d.func; Printf.printf "Class: %s [%04x]\n" - (lookup_class_name pci_access d.device_class) d.device_class; + (lookup_class_name pci_access d.device_class |> default) d.device_class; Printf.printf "Vendor: %s [%04x]\n" - (lookup_vendor_name pci_access d.vendor_id) d.vendor_id; + (lookup_vendor_name pci_access d.vendor_id |> default) d.vendor_id; Printf.printf "Device: %s [%04x]\n" - (lookup_device_name pci_access d.vendor_id d.device_id) d.device_id; + (lookup_device_name pci_access d.vendor_id d.device_id |> default) d.device_id; begin match d.subsystem_id with | Some (sv_id, sd_id) -> Printf.printf "SVendor:\t%s [%04x]\n" - (lookup_subsystem_vendor_name pci_access sv_id) sv_id; + (lookup_subsystem_vendor_name pci_access sv_id |> default) sv_id; Printf.printf "SDevice:\t%s [%04x]\n" - (lookup_subsystem_device_name pci_access d.vendor_id d.device_id sv_id sd_id) sd_id + (lookup_subsystem_device_name pci_access d.vendor_id d.device_id sv_id sd_id |> default) sd_id | None -> () end; begin match d.phy_slot with @@ -43,7 +44,8 @@ let lspci_nnnDv pci_access = let nv_vid = 0x10de and k1_did = 0x0ff7 and id_160 = 0x113b in - let n = lookup_subsystem_device_name pci_access nv_vid k1_did nv_vid id_160 in + let n = lookup_subsystem_device_name pci_access nv_vid k1_did nv_vid id_160 + |> default in Printf.printf "\"%s\"\n" n let () = with_access lspci_nnnDv diff --git a/lib/pci.mli b/lib/pci.mli index 5b895a1..89eff84 100644 --- a/lib/pci.mli +++ b/lib/pci.mli @@ -32,29 +32,29 @@ module Pci_access : sig type t end -val lookup_class_name : Pci_access.t -> int -> string +val lookup_class_name : Pci_access.t -> int -> string option (** [lookup_class_name a id] wraps pci_lookup_name with the right flags to lookup the name for the class whose identifier is [id] using the access value [a]. If [libpci] cannot find a match it returns "Class [id]". *) -val lookup_progif_name : Pci_access.t -> int -> int -> string +val lookup_progif_name : Pci_access.t -> int -> int -> string option (** [lookup_progif_name a c_id id] is like {!lookup_class_name} but returns the name of the programming interface with ID [id] within the class with ID [c_id]. *) -val lookup_vendor_name : Pci_access.t -> int -> string +val lookup_vendor_name : Pci_access.t -> int -> string option (** [lookup_vendor_name a id] is like {!lookup_class_name} but returns the name of the PCI vendor with ID [id]. *) -val lookup_device_name : Pci_access.t -> int -> int -> string +val lookup_device_name : Pci_access.t -> int -> int -> string option (** [lookup_device_name a v_id id] is like {!lookup_class_name} but returns the name of the device with ID [id] by the vendor with ID [v_id]. *) -val lookup_subsystem_vendor_name : Pci_access.t -> int -> string +val lookup_subsystem_vendor_name : Pci_access.t -> int -> string option (** [lookup_subsystem_vendor_name a id] is like {!lookup_class_name} but returns the name of the PCI vendor with ID [id]. *) -val lookup_subsystem_device_name : Pci_access.t -> int -> int -> int -> int -> string +val lookup_subsystem_device_name : Pci_access.t -> int -> int -> int -> int -> string option (** [lookup_subsystem_device_name a v_id d_id sv_id sd_id] is like {!lookup_class_name} but returns the name of the PCI subsystem of a device with ID [d_id] made by vendor with ID [v_id] whose subvendor and subdevice diff --git a/lib_test/test_pci.ml b/lib_test/test_pci.ml index 0ed3e59..0b6b512 100644 --- a/lib_test/test_pci.ml +++ b/lib_test/test_pci.ml @@ -49,14 +49,15 @@ let test_lookup_functions () = SVendor: Red Hat, Inc [1af4] SDevice: Qemu virtual machine [1100] *) let test_lookup = assert_equal ~printer:(fun x -> x) in + let default v = match v with Some v -> v | None -> "" in with_dump (fun acc -> - test_lookup "Bridge" @@ lookup_class_name acc 0x0680; - test_lookup "Intel Corporation" @@ lookup_vendor_name acc 0x8086; - test_lookup "82371AB/EB/MB PIIX4 ACPI" @@ lookup_device_name acc 0x8086 0x7113; - test_lookup "Red Hat, Inc." @@ lookup_subsystem_vendor_name acc 0x1af4; - test_lookup "Qemu virtual machine" @@ lookup_subsystem_device_name acc 0x8086 0x7113 0x1af4 0x1100; - test_lookup "VGA compatible controller" @@ lookup_class_name acc 0x0300; - test_lookup "VGA controller" @@ lookup_progif_name acc 0x0300 0x00; + test_lookup "Bridge" @@ (lookup_class_name acc 0x0680 |> default); + test_lookup "Intel Corporation" @@ (lookup_vendor_name acc 0x8086 |> default); + test_lookup "82371AB/EB/MB PIIX4 ACPI" @@ (lookup_device_name acc 0x8086 0x7113 |> default); + test_lookup "Red Hat, Inc." @@ (lookup_subsystem_vendor_name acc 0x1af4 |> default); + test_lookup "Qemu virtual machine" @@ (lookup_subsystem_device_name acc 0x8086 0x7113 0x1af4 0x1100 |> default); + test_lookup "VGA compatible controller" @@ (lookup_class_name acc 0x0300 |> default); + test_lookup "VGA controller" @@ (lookup_progif_name acc 0x0300 0x00 |> default); ) let _ =