Add Xen detection support for FreeBSD.

3 files changed, 36 insertions, 1 deletions

diff --git a/src/config.ads b/src/config.ads
index ddc59a1..424eba4 100644
--- a/src/config.ads
+++ b/src/config.ads
@@ -2,4 +2,5 @@ package Config is
     -- In the future this should be autogenerated
     
     Linux : constant Boolean := True;
+    FreeBSD : constant Boolean := False;
 end Config;
diff --git a/src/hypervisor_check.adb b/src/hypervisor_check.adb
index 340d4a5..bbc83f1 100644
--- a/src/hypervisor_check.adb
+++ b/src/hypervisor_check.adb
@@ -61,6 +61,8 @@ package body Hypervisor_Check is
             else
                 return False;
             end if;
+        elsif Config.FreeBSD then
+            return Command_Succeeds(Interfaces.C.To_C(FreeBSD_Xen_Present_Command));
         else
             raise OS_Not_Supported;
         end if;
@@ -78,6 +80,23 @@ package body Hypervisor_Check is
         end if;
     end Hypervisor_Present;
 
+    -- Execute a system command and return true if it succeeded
+    -- (i.e. returned 0)
+    function Command_Succeeds (Command : Interfaces.C.Char_Array) return Boolean is
+        use Interfaces.C;
+        function Sys (Arg : Char_Array) return Integer;
+        pragma Import(C, Sys, "system");
+
+        Ret_Val : Integer;
+    begin
+        Ret_Val := Sys(Command);
+        if Ret_Val > 0 then
+            return False;
+        else
+            return True;
+        end if;
+    end Command_Succeeds;
+
     -- Calling CPUID instruction with hypervisor leaf in %eax
     -- puts the vendor string in %ebx, %ecx, and %edx
     function Get_Vendor_String return US.Unbounded_String is
@@ -111,16 +130,22 @@ package body Hypervisor_Check is
         return Vendor_Name;
     end Get_Vendor_Name;
 
+    -- There are two cases: 1. DMI is not available on a _system_
+    -- (paravirtualized guests are notable examples)
+    -- 2. the OS doesn't have a DMI API available to unprivileged users
     function DMI_Available return Boolean is
     begin
         if Config.Linux then
+            -- Linux provides DMI info via sysfs, but on systems
+            -- without SMBIOS it's not available
             if Ada.Directories.Exists("/sys/class/dmi") then
                 return True;
             else
                 return False;
             end if;
         else
-            raise OS_Not_Supported;
+            -- Other OSes don't have DMI API we can use
+            return False;
         end if;
     end DMI_Available;
 
diff --git a/src/hypervisor_check.ads b/src/hypervisor_check.ads
index b19bf70..ea08d90 100644
--- a/src/hypervisor_check.ads
+++ b/src/hypervisor_check.ads
@@ -1,4 +1,5 @@
 with Interfaces; use Interfaces;
+with Interfaces.C;
 with System.Machine_Code; use System.Machine_Code;
 with Ada.Strings.Unbounded;
 with Ada.Text_IO;
@@ -27,6 +28,8 @@ package Hypervisor_Check is
 
     function Known_DMI_HV_Vendor (Name : US.Unbounded_String) return Boolean;
 
+    function Command_Succeeds (Command : Interfaces.C.Char_Array) return Boolean;
+
     -- Vendor names for human consumption
     VMWare : constant String := "VMWare";
     Xen_HVM : constant String := "Xen HVM";
@@ -45,6 +48,12 @@ private
     Linux_Sys_Vendor_File : constant String := "/sys/class/dmi/id/sys_vendor";
     Linux_Sys_HV_Type_File : constant String := "/sys/hypervisor/type";
 
+    -- FreeBSD-specific file names, commands etc.
+
+    -- sysctl read commands are available to unprivileged users, but sysctl binary
+    -- may not be in the $PATH, hence the absolute path
+    FreeBSD_Xen_Present_Command : constant String := "/sbin/sysctl kern.vm_guest | grep xen";
+
     -- SMBIOS vendor strings
     VMWare_DMI_Pattern : constant String := "VMware, Inc.";
     HyperV_DMI_Pattern : constant String := "Microsoft Corporation";