diff options
| -rw-r--r-- | src/hvinfo.adb | 48 | ||||
| -rw-r--r-- | src/hypervisor_check.adb | 25 | ||||
| -rw-r--r-- | src/hypervisor_check.ads | 24 |
3 files changed, 70 insertions, 27 deletions
diff --git a/src/hvinfo.adb b/src/hvinfo.adb index 2d97d60..d3c261c 100644 --- a/src/hvinfo.adb +++ b/src/hvinfo.adb @@ -42,28 +42,40 @@ begin return; end; - CPUID_HV_Name := US.To_Unbounded_String (""); - SMBIOS_HV_Name := US.To_Unbounded_String (""); + -- Assume success until proven otherwise + CL.Set_Exit_Status (0); - if Hypervisor_Present then - CPUID_HV_Name := Get_Vendor_Name; - end if; - - SMBIOS_HV_Name := Get_DMI_Vendor_Name; - declare - use US; - begin - if (CPUID_HV_Name = "") and (SMBIOS_HV_Name = "") then - CL.Set_Exit_Status (1); - elsif (CPUID_HV_Name /= "") then - CL.Set_Exit_Status (0); - UIO.Put_Line (CPUID_HV_Name); + -- Check for Xen first, as it has two distinct modes + if Xen_Present then + if Hypervisor_Present then + -- This is Xen HVM + IO.Put_Line(Xen_HVM); else - CL.Set_Exit_Status (0); - UIO.Put_Line (SMBIOS_HV_Name); + -- Xen present and no CPUID leaf means Xen PV + IO.Put_Line(Xen_PV); + end if; + elsif Hypervisor_Present then + -- This covers KVM, VMware, and other hypervisors + -- that use CPUID leaf as primary identification method + UIO.Put_Line (CPUID_HV_Name); + else + -- VirtualBox, Parallels, and possible others only + -- mark their presence by setting SMBIOS vendor string + if DMI_Available then + -- If the vendor name matches a known name associated + -- with a hypervisor, print it. + -- Sadly, this will give a wrong result on systems without + -- DMI reading API accessible to unprivileged users + SMBIOS_HV_Name := Get_DMI_Vendor_Name; + if Known_DMI_HV_Vendor(SMBIOS_HV_Name) then + UIO.Put_Line (SMBIOS_HV_Name); + else + IO.Put_Line(IO.Standard_Error, "No hypervisor detected"); + CL.Set_Exit_Status (1); + end if; end if; - end; + end if; end HVInfo; diff --git a/src/hypervisor_check.adb b/src/hypervisor_check.adb index 9072b06..340d4a5 100644 --- a/src/hypervisor_check.adb +++ b/src/hypervisor_check.adb @@ -50,6 +50,21 @@ package body Hypervisor_Check is exception when others => return US.To_Unbounded_String (""); end Head_Of_File; + + -- Xen support hardware and paravirtual modes, in paravirtual mode + -- it's not detectable with CPUID + function Xen_Present return Boolean is + begin + if Config.Linux then + if Contains(Head_Of_File(Linux_Sys_HV_Type_File), "xen") then + return True; + else + return False; + end if; + else + raise OS_Not_Supported; + end if; + end Xen_Present; -- Hypervisors should set the bit 31 of %ecx to 1 in CPUID leaf 1 function Hypervisor_Present return Boolean is @@ -139,4 +154,14 @@ package body Hypervisor_Check is return Vendor_Name; end Get_DMI_Vendor_Name; + function Known_DMI_HV_Vendor (Name : US.Unbounded_String) return Boolean is + use US; + begin + if Name /= US.To_Unbounded_String("") then + return True; + else + return False; + end if; + end Known_DMI_HV_Vendor; + end Hypervisor_Check; diff --git a/src/hypervisor_check.ads b/src/hypervisor_check.ads index 9571393..b19bf70 100644 --- a/src/hypervisor_check.ads +++ b/src/hypervisor_check.ads @@ -19,16 +19,31 @@ package Hypervisor_Check is function Hypervisor_Present return Boolean; + function Xen_Present return Boolean; + function DMI_Available return Boolean; function Get_DMI_Vendor_Name return US.Unbounded_String; + function Known_DMI_HV_Vendor (Name : US.Unbounded_String) return Boolean; + + -- Vendor names for human consumption + VMWare : constant String := "VMWare"; + Xen_HVM : constant String := "Xen HVM"; + Xen_PV : constant String := "Xen PV"; + KVM : constant String := "KVM"; + HyperV : constant String := "Microsoft Hyper-V"; + VirtualBox : constant String := "VirtualBox"; + Parallels : constant String := "Parallels"; + private Hypervisor_Leaf : constant := 16#40000000#; type CPUID_Registers is array (1 .. 4) of Unsigned_32; + -- Linux-specific file names etc. Linux_Sys_Vendor_File : constant String := "/sys/class/dmi/id/sys_vendor"; + Linux_Sys_HV_Type_File : constant String := "/sys/hypervisor/type"; -- SMBIOS vendor strings VMWare_DMI_Pattern : constant String := "VMware, Inc."; @@ -36,15 +51,6 @@ private VirtualBox_DMI_Pattern : constant String := "innotek GmbH"; Parallels_DMI_Pattern : constant String := "Parallels"; - -- Vendor names for human consumption - VMWare : constant String := "VMWare"; - Xen : constant String := "Xen"; - KVM : constant String := "KVM"; - HyperV : constant String := "Microsoft Hyper-V"; - VirtualBox : constant String := "VirtualBox"; - Parallels : constant String := "Parallels"; - - function CPUID (Arg : Unsigned_32) return CPUID_Registers; function String_of_U32 (Arg : Unsigned_32) return US.Unbounded_String; |