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 # Returns a hash.
  16 # {
  17 #     name => {
  18 #         size => <bytes>,
  19 #     }
  20 # }
  21 my sub query_blockdevs : prototype() {
  22     my $disks = {};
  23
  24     my $lsblk = fromjs(qx/lsblk -e 230 --bytes --json/);
  25     for my $disk ($lsblk->{blockdevices}->@*) {
  26         my ($name, $ro, $size, $type, $mountpoints) = $disk->@{qw(name ro size type mountpoints)};
  27
  28         next if $type ne 'disk' || $ro;
  29         next if grep { defined($_) } @$mountpoints;
  30
  31         $disks->{$name} = { size => $size };
  32     }
  33
  34     return $disks;
  35 }
  36
  37 # Returns a hash.
  38 #
  39 # {
  40 #     <ifname> => {
  41 #         mac => <mac address>,
  42 #         index => <index>,
  43 #         name => <ifname>,
  44 #         addresses => [
  45 #             family => <inet|inet6>,
  46 #             address => <mac address>,
  47 #             prefix => <length>,
  48 #         ],
  49 #     },
  50 # }
  51 my sub query_netdevs : prototype() {
  52     my $ifs = {};
  53     my $default;
  54
  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 query_blockdevs()>,
 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} = query_blockdevs();
 220     $output->{network} = {
 221         interfaces => query_netdevs(),
 222         routes => $routes,
 223         dns => query_dns(),
 224     };
 225
 226     my $err;
 227     my $country;
 228     if ($routes->{gateway4}) {
 229         $country = eval { detect_country_tracing_to(4 => '8.8.8.8') };
 230         $err = $@ if !$country;
 231     }
 232
 233     if (!$country && $routes->{gateway6}) {
 234         $country = eval { detect_country_tracing_to(6 => '2001:4860:4860::8888') };
 235         $err = $@ if !$country;
 236     }
 237
 238     if (defined($country)) {
 239         $output->{country} = $country;
 240     } else {
 241         warn ($err // "unable to detect country\n");
 242     }
 243
 244     return $output;
 245 }
 246
 247 1;