Skip to content

Commit

Permalink
CA-266936: Move pci lookups to string_opt to prevent some segfaults
Browse files Browse the repository at this point in the history 
This does not fix the issue but can mitigate it

Signed-off-by: Marcello Seri <[email protected]>

This is now needed in case the pointers are NULL.

Cherry-picked from xapi-project/xen-api@3f71785

Signed-off-by: Pau Ruiz Safont <[email protected]>
  • Loading branch information
@psafont
Marcello Seri authored and psafont committed May 13, 2020
1 parent 6c5a563 commit c92ed04
Show file tree
Hide file tree
Showing 4 changed files with 25 additions and 22 deletions.
6 changes: 3 additions & 3 deletions bindings/ffi_bindings.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
14 changes: 8 additions & 6 deletions examples/lspci.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
12 changes: 6 additions & 6 deletions lib/pci.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
15 changes: 8 additions & 7 deletions lib_test/test_pci.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 _ =
Expand Down

0 comments on commit c92ed04

Please sign in to comment.