Add support for Xen. Revamp the detection workflow.

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;