diff options
| -rw-r--r-- | src/hvinfo.adb | 85 | ||||
| -rw-r--r-- | src/hypervisor_check.adb | 20 | ||||
| -rw-r--r-- | src/hypervisor_check.ads | 12 |
3 files changed, 72 insertions, 45 deletions
diff --git a/src/hvinfo.adb b/src/hvinfo.adb index ac65516..e545427 100644 --- a/src/hvinfo.adb +++ b/src/hvinfo.adb @@ -1,5 +1,5 @@ ------------------------------------------------------------------------ --- Copyright (C) 2015 Daniil Baturin <daniil@baturin.org> +-- Copyright (C) 2018 Daniil Baturin <daniil@baturin.org> -- -- This file is part of hvinfo. -- @@ -34,14 +34,18 @@ procedure HVInfo is package IO renames Ada.Text_IO; package GCL renames GNAT.Command_Line; - SMBIOS_HV_Name : US.Unbounded_String; + SMBIOS_Vendor : US.Unbounded_String; + + Debug : Boolean; + Hypervisor_Detected : Boolean := False; + Hypervisor_Name : US.Unbounded_String := US.Null_Unbounded_String; begin -- Handle command line options declare -- No declarations begin loop - case GCL.Getopt ("-help -version") is + case GCL.Getopt ("-help -version -debug") is when '-' => if GCL.Full_Switch = "-version" then Print_Version; @@ -49,6 +53,8 @@ begin elsif GCL.Full_Switch = "-help" then Print_Help; return; + elsif GCL.Full_Switch = "-debug" then + Debug := True; end if; when others => exit; @@ -61,41 +67,74 @@ begin return; end; - -- Assume success until proven otherwise - CL.Set_Exit_Status (0); - -- Check for Xen first, as it has two distinct modes if Xen_Present then + Hypervisor_Detected := True; + if Hypervisor_Present then -- This is Xen HVM - IO.Put_Line (Xen_HVM); + Hypervisor_Name := US.To_Unbounded_String (Xen_HVM); else -- Xen present and no CPUID leaf means Xen PV - IO.Put_Line (Xen_PV); + Hypervisor_Name := US.To_Unbounded_String (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 (Get_Vendor_Name); - else + -- that use CPUID leaf as their primary identification method + + Hypervisor_Detected := True; + + declare + use US; + begin + if Debug then + IO.Put_Line ("CPUID hypervisor bit is set"); + UIO.Put_Line ("Hypervisor identifier is """ & Get_Vendor_String & """"); + end if; + end; + + Hypervisor_Name := Get_Vendor_Name; + elsif DMI_Available then -- 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); + + -- 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 + + + declare + use US; + SMBIOS_Vendor, SMBIOS_HV_Name : US.Unbounded_String; + begin + SMBIOS_Vendor := Get_DMI_Vendor_String; + SMBIOS_HV_Name := Get_DMI_Vendor_Name (SMBIOS_Vendor); + + if SMBIOS_HV_Name /= Null_Unbounded_String then + Hypervisor_Name := SMBIOS_HV_Name; + Hypervisor_Detected := True; else - IO.Put_Line (IO.Standard_Error, "No hypervisor detected"); - CL.Set_Exit_Status (1); + if Debug then + UIO.Put_Line (IO.Standard_Error, "DMI vendor name is: """ & SMBIOS_Vendor & """"); + end if; end if; - elsif VirtualBox_PCI_Present then - IO.Put_Line (VirtualBox); + end; + elsif VirtualBox_PCI_Present then + Hypervisor_Name := US.To_Unbounded_String (VirtualBox); + else + if Debug then + IO.Put_Line (IO.Standard_Error, "DMI reading API is not available to unpriviliged users on this OS"); end if; end if; + if Hypervisor_Detected then + CL.Set_Exit_Status (0); + UIO.Put_Line (Hypervisor_Name); + else + CL.Set_Exit_Status (1); + IO.Put_Line (IO.Standard_Error, "No hypervisor detected"); + end if; + end HVInfo; diff --git a/src/hypervisor_check.adb b/src/hypervisor_check.adb index 4d87cb0..076348b 100644 --- a/src/hypervisor_check.adb +++ b/src/hypervisor_check.adb @@ -1,5 +1,5 @@ ------------------------------------------------------------------------ --- Copyright (C) 2015 Daniil Baturin <daniil@baturin.org> +-- Copyright (C) 2018 Daniil Baturin <daniil@baturin.org> -- -- This file is part of hvinfo. -- @@ -186,10 +186,9 @@ package body Hypervisor_Check is return Name; end Get_DMI_Vendor_String; - function Get_DMI_Vendor_Name return US.Unbounded_String is - Vendor_String, Vendor_Name : US.Unbounded_String; + function Get_DMI_Vendor_Name (Vendor_String : US.Unbounded_String) return US.Unbounded_String is + 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 @@ -199,21 +198,12 @@ package body Hypervisor_Check is elsif Contains (Vendor_String, Parallels_DMI_Pattern) then Vendor_Name := US.To_Unbounded_String (Parallels); else - Vendor_Name := US.To_Unbounded_String (""); + Vendor_Name := US.Null_Unbounded_String; end if; + 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; - function VirtualBox_PCI_Present return Boolean is begin if Config.FreeBSD then diff --git a/src/hypervisor_check.ads b/src/hypervisor_check.ads index 44ca16e..ced2309 100644 --- a/src/hypervisor_check.ads +++ b/src/hypervisor_check.ads @@ -1,5 +1,5 @@ ------------------------------------------------------------------------ --- Copyright (C) 2015 Daniil Baturin <daniil@baturin.org> +-- Copyright (C) 2018 Daniil Baturin <daniil@baturin.org> -- -- This file is part of hvinfo. -- @@ -37,15 +37,17 @@ package Hypervisor_Check is function Get_Vendor_Name return US.Unbounded_String; + function Get_Vendor_String return US.Unbounded_String; + 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 Get_DMI_Vendor_Name (Vendor_String : US.Unbounded_String) return US.Unbounded_String; - function Known_DMI_HV_Vendor (Name : US.Unbounded_String) return Boolean; + function Get_DMI_Vendor_String return US.Unbounded_String; function Command_Succeeds (Command : Interfaces.C.Char_Array) return Boolean; @@ -86,12 +88,8 @@ private 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; |