summaryrefslogtreecommitdiff
path: root/src/hvinfo.adb
blob: 342a53e4dbc507aa3bf86361f5dd85ce87ab349a (plain)
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
------------------------------------------------------------------------
-- 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/>.
------------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO;
with Ada.Command_Line;
with GNAT.Command_Line;
with GNAT.Strings;

with Hypervisor_Check; use Hypervisor_Check;
with HVInfo_Util; use HVInfo_Util;
with Config;

procedure HVInfo is
    package US renames Ada.Strings.Unbounded;
    package CL renames Ada.Command_Line;
    package IO renames Ada.Text_IO;
    package GCL renames GNAT.Command_Line;

    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 -debug") is
                when '-' =>
                    if GCL.Full_Switch = "-version" then
                        Print_Version;
                        return;
                    elsif GCL.Full_Switch = "-help" then
                        Print_Help;
                        return;
                    elsif GCL.Full_Switch = "-debug" then
                        Debug := True;
                    end if;
                when others =>
                    exit;
            end case;
        end loop;
     exception
         when GCL.Invalid_Switch =>
             IO.Put_Line ("Invalid option");
             Print_Help;
             return;
     end;

    -- 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
            Hypervisor_Name := US.To_Unbounded_String (Xen_HVM);
        else
            -- Xen present and no CPUID leaf means 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 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;

            Hypervisor_Name := Get_Vendor_Name;

            -- VirtualBox may use KVM or Hyper-V as its backend,
            -- but still exposes its own graphics card so that setup can be detected
            if VirtualBox_PCI_Present then
                Hypervisor_Name := "VirtualBox (using " & Hypervisor_Name & ")";
            end if
        end;
    elsif DMI_Available then
        -- VirtualBox, Parallels, and possible others only
        -- mark their presence by setting SMBIOS vendor string

        -- 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
                if Debug then
                    UIO.Put_Line (IO.Standard_Error, "DMI vendor name is: """ & SMBIOS_Vendor & """");
                end if;
            end if;
         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;