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