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
|
package body Hypervisor_Check is
function CPUID (Arg : Unsigned_32) return CPUID_Registers is
eax, ebx, ecx, edx : Unsigned_32;
begin
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);
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;
-- 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;
-- 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");
elsif Vendor_String = "VMwareVMware" then
Vendor_Name := To_Unbounded_String ("VMWare");
elsif Vendor_String = "Microsoft Hv" then
Vendor_Name := To_Unbounded_String ("Microsoft Hyper-V");
else
Vendor_Name := To_Unbounded_String ("Unknown hypervisor");
end if;
return Vendor_Name;
end Get_Vendor_Name;
function DMI_Available return Boolean is
begin
if Config.Linux then
if Directories.Exists("/sys/class/dmi") then
return True;
else
return False;
end if;
else
raise OS_Not_Supported;
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 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;
|
