Proxmox/Install/RunEnv.pm

   1 package Proxmox::Install::RunEnv;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp;
   7 use JSON qw(from_json to_json);
   8
   9 use Proxmox::Log;
  10 use Proxmox::Sys::File qw(file_read_firstline);
  11 use Proxmox::Sys::Block;
  12 use Proxmox::Sys::Net;
  13
  14 my sub fromjs : prototype($) {
  15     return from_json($_[0], { utf8 => 1 });
  16 }
  17
  18 my $mem_total = undef;
  19 sub query_total_memory : prototype() {
  20     return $mem_total if defined($mem_total);
  21
  22     open (my $MEMINFO, '<', '/proc/meminfo');
  23
  24     my $res = 512; # default to 512 if something goes wrong
  25     while (my $line = <$MEMINFO>) {
  26         if ($line =~ m/^MemTotal:\s+(\d+)\s*kB/i) {
  27             $res = int ($1 / 1024);
  28         }
  29     }
  30     close($MEMINFO);
  31
  32     $mem_total = $res;
  33     return $mem_total;
  34 }
  35
  36 # Returns a hash.
  37 #
  38 # {
  39 #     <ifname> => {
  40 #         mac => <mac address>,
  41 #         index => <index>,
  42 #         name => <ifname>,
  43 #         addresses => [
  44 #             family => <inet|inet6>,
  45 #             address => <mac address>,
  46 #             prefix => <length>,
  47 #         ],
  48 #     },
  49 # }
  50 my sub query_netdevs : prototype() {
  51     my $ifs = {};
  52     my $default;
  53
  54     # FIXME: not the same as the battle proven way we used in the installer for years?
  55     my $interfaces = fromjs(qx/ip --json address show/);
  56
  57     for my $if (@$interfaces) {
  58         my ($index, $name, $state, $mac, $addresses) =
  59             $if->@{qw(ifindex ifname operstate address addr_info)};
  60
  61         next if $state ne 'UP';
  62
  63         my @valid_addrs;
  64         for my $addr (@$addresses) {
  65             next if $addr->{scope} eq 'link';
  66
  67             my ($family, $addr, $prefix) = $addr->@{qw(family local prefixlen)};
  68
  69             push @valid_addrs, {
  70                 family => $family,
  71                 address => $addr,
  72                 prefix => $prefix,
  73             };
  74         }
  75
  76         if (@valid_addrs) {
  77             $ifs->{$name} = {
  78                 index => $index,
  79                 name => $name,
  80                 mac => $mac,
  81                 addresses => \@valid_addrs,
  82             };
  83         }
  84     }
  85
  86     return $ifs;
  87 }
  88
  89 # Returns a hash.
  90 #
  91 # {
  92 #     gateway4 => {
  93 #         dst => "default",
  94 #         gateway => <ipv4>,
  95 #         dev => <ifname>,
  96 #     },
  97 #     gateway6 => {
  98 #         dst => "default",
  99 #         gateway => <ipv6>,
 100 #         dev => <ifname>,
 101 #     },
 102 # }
 103 my sub query_routes : prototype() {
 104     my ($gateway4, $gateway6);
 105
 106     my $route4 = fromjs(qx/ip -4 --json route show/);
 107     for my $route (@$route4) {
 108         if ($route->{dst} eq 'default') {
 109             $gateway4 = {
 110                 dev => $route->{dev},
 111                 gateway => $route->{gateway},
 112             };
 113             last;
 114         }
 115     }
 116
 117     my $route6 = fromjs(qx/ip -6 --json route show/);
 118     for my $route (@$route6) {
 119         if ($route->{dst} eq 'default') {
 120             $gateway6 = {
 121                 dev => $route->{dev},
 122                 gateway => $route->{gateway},
 123             };
 124             last;
 125         }
 126     }
 127
 128     my $routes;
 129     $routes->{gateway4} = $gateway4 if $gateway4;
 130     $routes->{gateway6} = $gateway6 if $gateway6;
 131
 132     return $routes;
 133 }
 134
 135 # If `/etc/resolv.conf` fails to open this returns nothing.
 136 # Otherwise it returns a hash:
 137 # {
 138 #     dns => <first dns entry>,
 139 #
 140 my sub query_dns : prototype() {
 141     open my $fh , '<', '/etc/resolv.conf' or return;
 142
 143     my @dns;
 144     my $domain;
 145     while (defined(my $line = <$fh>)) {
 146         if ($line =~ /^nameserver\s+(\S+)/) {
 147             push @dns, $1;
 148         } elsif (!defined($domain) && $line =~ /^domain\s+(\S+)/) {
 149             $domain = $1;
 150         }
 151     }
 152
 153     my $output = {
 154         domain => $domain,
 155         @dns ? (dns => \@dns) : (),
 156     };
 157 };
 158
 159 # Uses `traceroute` and `geoiplookup`/`geoiplookup6` to figure out the current country.
 160 # Has a 10s timeout and uses the stops at the first entry found in the geoip database.
 161 my sub detect_country_tracing_to : prototype($$) {
 162     my ($ipver, $destination) = @_;
 163
 164     print "trying to detect country...\n";
 165     open(my $TRACEROUTE_FH, '-|',
 166         'traceroute', "-$ipver", '-N', '1', '-q', '1', '-n', $destination)
 167         or return undef;
 168
 169     my $geoip_bin = ($ipver == 6) ? 'geoiplookup6' : 'geoiplookup';
 170
 171     my $country;
 172
 173     my $previous_alarm = alarm (10);
 174     eval {
 175         local $SIG{ALRM} = sub { die "timed out!\n" };
 176         my $line;
 177         while (defined ($line = <$TRACEROUTE_FH>)) {
 178             log_debug("DC TRACEROUTE: $line");
 179             if ($line =~ m/^\s*\d+\s+(\S+)\s/) {
 180                 my $geoip = qx/$geoip_bin $1/;
 181                 log_debug("DC GEOIP: $geoip");
 182                 if ($geoip =~ m/GeoIP Country Edition:\s*([A-Z]+),/) {
 183                     $country = lc ($1);
 184                     log_info("DC FOUND: $country\n");
 185                     last;
 186                 }
 187             }
 188         }
 189     };
 190     my $err = $@;
 191     alarm ($previous_alarm);
 192
 193     close($TRACEROUTE_FH);
 194
 195     if ($err) {
 196         die "unable to detect country - $err\n";
 197     } elsif ($country) {
 198         print "detected country: " . uc($country) . "\n";
 199     }
 200
 201     return $country;
 202 }
 203
 204 # Returns the entire environment as a hash.
 205 # {
 206 #     country => <short country>,
 207 #     disks => <see Proxmox::Sys::Block::hd_list()>,
 208 #     network => {
 209 #         interfaces => <see query_netdevs()>,
 210 #         routes => <see query_routes()>,
 211 #         dns => <see query_dns()>,
 212 #     },
 213 # }
 214 sub query_installation_environment : prototype() {
 215     my $output = {};
 216
 217     my $routes = query_routes();
 218
 219     $output->{disks} = Proxmox::Sys::Block::get_cached_disks();
 220     $output->{network} = {
 221         interfaces => query_netdevs(),
 222         routes => $routes,
 223         dns => query_dns(),
 224     };
 225     # FIXME: move whatever makes sense over to Proxmox::Sys::Net:: and keep that as single source,
 226     # it can then use some different structure just fine (after adapting the GTK GUI to that) but
 227     # **never** to (slightly different!) things for the same stuff...
 228     $output->{ipconf} = Proxmox::Sys::Net::get_ip_config();
 229
 230     $output->{kernel_cmdline} = file_read_firstline("/proc/cmdline");
 231     $output->{total_memory} = query_total_memory();
 232     $output->{boot_type} = -d '/sys/firmware/efi' ? 'efi' : 'bios';
 233
 234     my $err;
 235     my $country;
 236     if ($routes->{gateway4}) {
 237         $country = eval { detect_country_tracing_to(4 => '8.8.8.8') };
 238         $err = $@ if !$country;
 239     }
 240
 241     if (!$country && $routes->{gateway6}) {
 242         $country = eval { detect_country_tracing_to(6 => '2001:4860:4860::8888') };
 243         $err = $@ if !$country;
 244     }
 245
 246     if (defined($country)) {
 247         $output->{country} = $country;
 248     } else {
 249         warn ($err // "unable to detect country\n");
 250     }
 251
 252     return $output;
 253 }
 254
 255 my $_env = undef;
 256 sub get {
 257     my ($k) = @_;
 258     $_env = query_installation_environment() if !defined($_env);
 259     return defined($k) ? $_env->{$k} : $_env;
 260 }
 261
 262 1;