Add support for SMBIOS vendor string based detection.

3 files changed, 107 insertions, 5 deletions

diff --git a/src/hvinfo.adb b/src/hvinfo.adb
index cfde51b..aa456a4 100644
--- a/src/hvinfo.adb
+++ b/src/hvinfo.adb
@@ -1,16 +1,35 @@
+with Ada.Strings.Unbounded;
 with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
 with Ada.Command_Line; use Ada.Command_Line;
 
 with Hypervisor_Check; use Hypervisor_Check;
+
 procedure HVInfo is
+    package US renames Ada.Strings.Unbounded;
+    CPUID_HV_Name, SMBIOS_HV_Name, Hypervisor_Name : US.Unbounded_String;
 begin
+    CPUID_HV_Name := US.To_Unbounded_String ("");
+    SMBIOS_HV_Name := US.To_Unbounded_String ("");
 
-    -- Try CPUID checks first
     if Hypervisor_Present then
-        Put_Line (Get_Vendor_Name);
-        Set_Exit_Status (0);
-    else
-        Set_Exit_Status (1);
+        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
+            Set_Exit_Status (1);
+        elsif (CPUID_HV_Name /= "") then
+            Set_Exit_Status (0);
+            UIO.Put_Line (CPUID_HV_Name);
+        else
+            Set_Exit_Status (0);
+            UIO.Put_Line (SMBIOS_HV_Name); 
+        end if;
+    end;
+
 end HVInfo;
 
diff --git a/src/hypervisor_check.adb b/src/hypervisor_check.adb
index 998070b..83bb107 100644
--- a/src/hypervisor_check.adb
+++ b/src/hypervisor_check.adb
@@ -12,6 +12,7 @@ package body Hypervisor_Check is
         return (eax, ebx, ecx, edx);
     end CPUID;
 
+    -- Convert an unsigned 32-bit integer to a string of 4 characters
     function String_of_U32 (Arg : Unsigned_32) return US.Unbounded_String is
         Word : Unsigned_32;
         Result : US.Unbounded_String;
@@ -24,6 +25,32 @@ package body Hypervisor_Check is
         return Result;
     end String_of_U32;
 
+    function Contains (Haystack : US.Unbounded_String; Needle : String)
+    return Boolean is
+        Position : Natural;
+    begin
+        Position := US.Index (Source => Haystack, Pattern => Needle);
+        if Position > 0 then
+            return True;
+        else
+            return False;
+        end if;
+    end Contains;
+
+    -- Read the first line of file, return empty string in case of errors
+    -- Pretty much what we need for reading /proc files etc.
+    function Head_Of_File (Path : String) return US.Unbounded_String is
+        File : IO.File_Type;
+        Result : US.Unbounded_String;
+    begin
+        IO.Open(File => File, Name => Path, Mode => IO.In_File);
+        UIO.Get_Line (File, Result);
+        IO.Close(File);
+        return Result;
+    exception
+        when others => return US.To_Unbounded_String ("");
+    end Head_Of_File;
+ 
     -- Hypervisors should set the bit 31 of %ecx to 1 in CPUID leaf 1
     function Hypervisor_Present return Boolean is
         Registers : CPUID_Registers;
@@ -69,4 +96,31 @@ package body Hypervisor_Check is
         return Vendor_Name;
     end Get_Vendor_Name;
 
+    function Get_DMI_Vendor_String return US.Unbounded_String is
+        Name : US.Unbounded_String;
+    begin
+        -- Linux
+        Name := Head_Of_File (Linux_Sys_Vendor_File);
+        return Name;
+
+    end Get_DMI_Vendor_String;
+
+    function Get_DMI_Vendor_Name return US.Unbounded_String is
+        Vendor_String, Vendor_Name : US.Unbounded_String;
+    begin
+        Vendor_String := Get_DMI_Vendor_String;
+        if Contains(Vendor_String, VMWare_DMI_Pattern) then
+            Vendor_Name := US.To_Unbounded_String (VMWare);
+        elsif Contains(Vendor_String, HyperV_DMI_Pattern) then
+            Vendor_Name := US.To_Unbounded_String (HyperV);
+        elsif Contains(Vendor_String, VirtualBox_DMI_Pattern) then
+            Vendor_Name := US.To_Unbounded_String (VirtualBox);
+        elsif Contains(Vendor_String, Parallels_DMI_Pattern) then
+            Vendor_Name := US.To_Unbounded_String (Parallels);
+        else
+            Vendor_Name := US.To_Unbounded_String ("");
+        end if;
+        return Vendor_Name;
+    end Get_DMI_Vendor_Name;
+
 end Hypervisor_Check;
diff --git a/src/hypervisor_check.ads b/src/hypervisor_check.ads
index 0b5f154..1468695 100644
--- a/src/hypervisor_check.ads
+++ b/src/hypervisor_check.ads
@@ -1,24 +1,53 @@
 with Interfaces; use Interfaces;
 with System.Machine_Code; use System.Machine_Code;
 with Ada.Strings.Unbounded;
+with Ada.Text_IO;
+with Ada.Text_IO.Unbounded_IO;
 
 package Hypervisor_Check is
 
+    package IO renames Ada.Text_IO;
     package US renames Ada.Strings.Unbounded;
+    package UIO renames Ada.Text_IO.Unbounded_IO;
 
     function Get_Vendor_Name return US.Unbounded_String;
 
     function Hypervisor_Present return Boolean;
 
+    function Get_DMI_Vendor_Name return US.Unbounded_String;
+
 private
 
     Hypervisor_Leaf : constant := 16#40000000#;
     type CPUID_Registers is array (1 .. 4) of Unsigned_32;
 
+    Linux_Sys_Vendor_File : constant String := "/sys/class/dmi/id/sys_vendor";
+
+    -- SMBIOS vendor strings
+    VMWare_DMI_Pattern : constant String := "VMware, Inc.";
+    HyperV_DMI_Pattern : constant String := "Microsoft Corporation";
+    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;
 
     function Get_Vendor_String return US.Unbounded_String;
 
+    function Head_Of_File (Path : String) return US.Unbounded_String;
+
+    function Contains (Haystack : US.Unbounded_String; Needle : String) return Boolean;
+
+    function Get_DMI_Vendor_String return US.Unbounded_String;
+
 end Hypervisor_Check;