1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
------------------------------------------------------------------------
-- Copyright (C) 2018 Daniil Baturin <daniil@baturin.org>
--
-- This file is part of hvinfo.
--
-- hvinfo is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 2 of the License, or
-- (at your option) any later version.
--
-- hvinfo is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with hvinfo. If not, see <http://www.gnu.org/licenses/>.
------------------------------------------------------------------------
package body Hypervisor_Check is
function CPUID (Arg : Unsigned_32) return CPUID_Registers is
eax, ebx, ecx, edx : Unsigned_32;
begin
#if X86 then
Asm("cpuid",
Outputs => (Unsigned_32'Asm_Output ("=a", eax),
Unsigned_32'Asm_Output ("=b", ebx),
Unsigned_32'Asm_Output ("=c", ecx),
Unsigned_32'Asm_Output ("=d", edx)),
Inputs => Unsigned_32'Asm_Input ("a", Arg));
return (eax, ebx, ecx, edx);
#else
return (0, 0, 0, 0);
#end if;
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;
begin
Word := Arg;
while Word > 0 loop
US.Append (Result, Character'Val (Word and 16#FF#));
Word := Shift_Right (Word, 8);
end loop;
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;
-- 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;
elsif Config.FreeBSD then
return Command_Succeeds (Interfaces.C.To_C (FreeBSD_Xen_Present_Command));
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
Registers : CPUID_Registers;
begin
Registers := CPUID (1);
if (((Shift_Right (Registers(3), 31)) and 1) = 1) then
return True;
else
return False;
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
use US;
Vendor_String : US.Unbounded_String;
Registers : CPUID_Registers;
begin
Registers := CPUID (Hypervisor_Leaf);
Vendor_String := String_of_U32 (Registers(2)) &
String_of_U32 (Registers(3)) &
String_of_U32 (Registers(4));
return Vendor_String;
end Get_Vendor_String;
function Get_Vendor_Name return US.Unbounded_String is
use US;
Vendor_String, Vendor_Name : Unbounded_String;
begin
Vendor_String := Get_Vendor_String;
if Vendor_String = "KVMKVMKVM" then
Vendor_Name := To_Unbounded_String (KVM);
elsif Vendor_String = "XenVMMXenVMM" then
Vendor_Name := To_Unbounded_String (Xen_HVM);
elsif Vendor_String = "VMwareVMware" then
Vendor_Name := To_Unbounded_String (VMware);
elsif Vendor_String = "Microsoft Hv" then
Vendor_Name := To_Unbounded_String (HyperV);
elsif Vendor_String = "bhyve bhyve " then
Vendor_Name := To_Unbounded_String (bhyve);
else
Vendor_Name := To_Unbounded_String ("Unknown hypervisor");
end if;
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
-- Other OSes don't have DMI API we can use
return False;
end if;
end DMI_Available;
function Get_DMI_Vendor_String return US.Unbounded_String is
Name : US.Unbounded_String;
begin
if Config.Linux then
Name := Head_Of_File (Linux_Sys_Vendor_File);
else
raise OS_Not_Supported;
end if;
return Name;
end Get_DMI_Vendor_String;
function Get_DMI_Vendor_Name (Vendor_String : US.Unbounded_String) return US.Unbounded_String is
Vendor_Name : US.Unbounded_String;
begin
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.Null_Unbounded_String;
end if;
return Vendor_Name;
end Get_DMI_Vendor_Name;
function VirtualBox_PCI_Present return Boolean is
begin
if Config.FreeBSD then
if Command_Succeeds ("/sbin/sysctl dev.vgapci | grep vendor=0x80ee > /dev/null") then
return True;
else
return False;
end if;
elsif Config.Linux then
-- Can be done, but on Linux VirtualBox is covered by DMI checks,
-- so I cut the corners here
-- XXX: maybe it's relevant on some UEFI machines
return False;
else
return False;
end if;
end;
end Hypervisor_Check;
|
