[PATCH manager 10/21] api: host backup: include global, disk and network options for restore

[Shannon Sterz <s.sterz@proxmox.com>]

this information is useful when trying to restore a backup via the
installer.

Signed-off-by: Shannon Sterz <s.sterz@proxmox.com>
---

Notes:
    the restore could probably benefit from leveraging filters here for
    network devices.
    
    the bridge vmbr0 can be modified by users after install to depend on a
    vlan or bond. the installer currently cannot handle that and guessing
    which actual hardware device should be used in this situation is
    difficult (e.g. which interface that makes up a bond should be used if
    only one can be used for the bridge?).
    
    such users are probably better off simply restoring the entire network
    config at once or starting fresh. configuring only vmbr0 through the
    installer and recovering all other settings via the restore mechanism
    is likely to just cause confusion.

 PVE/API2/HostBackup.pm |  15 ++
 PVE/HostBackupTools.pm | 441 +++++++++++++++++++++++++++++++++++++++++
 PVE/Makefile           |   1 +
 3 files changed, 457 insertions(+)
 create mode 100644 PVE/HostBackupTools.pm

diff --git a/PVE/API2/HostBackup.pm b/PVE/API2/HostBackup.pm
index fe1263a85..8e8a87e10 100644
--- a/PVE/API2/HostBackup.pm
+++ b/PVE/API2/HostBackup.pm
@@ -12,6 +12,7 @@ use Time::HiRes qw(usleep);
 use PVE::Cluster;
 use PVE::Cmd qw(run);
 use PVE::Exception qw(raise_param_exc);
+use PVE::HostBackupTools;
 use PVE::INotify qw(nodename);
 use PVE::JSONSchema qw(get_standard_option);
 use PVE::PBSClient;
@@ -26,6 +27,19 @@ use base qw(PVE::RESTHandler);
 
 my $host_backup_lock = "/run/pve/host-backup.lock";
 
+my sub collect_installer_info() {
+    my $disk_setup = PVE::HostBackupTools::get_root_fs_setup();
+
+    warn "could not get disk setup for the installer. restoring this backup "
+        . "requires manually specifying a disk setup.\n"
+        if !defined($disk_setup);
+
+    return {
+        'global' => PVE::HostBackupTools::get_global_options(),
+        'network' => PVE::HostBackupTools::get_network_config(),
+        'disk-setup' => $disk_setup,
+    };
+}
 
 my sub prepare_backup($backup_name) {
     my $snap_cmd = undef;
@@ -123,6 +137,7 @@ my sub do_backup : prototype($$\@$$) ($pbs, $base_path, $files, $backup_name, $b
             'automatically-installed' => \@auto_packages,
             'manually-installed' => \@manual_packages,
         },
+        'installer-info' => collect_installer_info(),
     };
 
     my $os_release = undef;
diff --git a/PVE/HostBackupTools.pm b/PVE/HostBackupTools.pm
new file mode 100644
index 000000000..c51c78d9b
--- /dev/null
+++ b/PVE/HostBackupTools.pm
@@ -0,0 +1,441 @@
+package PVE::HostBackupTools;
+
+use v5.36;
+
+use Encode qw(decode);
+use JSON qw(decode_json);
+
+use PVE::Cluster qw (cfs_read_file);
+use PVE::DataCenterConfig; # so we can cfs-read datacenter.cfg
+use PVE::INotify;
+use PVE::Systemd;
+use PVE::Tools;
+use PVE::Cmd qw(run);
+use PVE::VZDump;
+
+my sub get_json_from_command($command) {
+
+    my $json = '';
+
+    run(
+        $command,
+        errmsg => "could not gather json information from command.",
+        outfunc => sub {
+            my ($line) = @_;
+            $json .= decode('UTF-8', $line) . "\n";
+        },
+    );
+
+    return decode_json($json);
+}
+
+my sub get_debconf_setting($package, $option) {
+    my $to_return = undef;
+
+    run(
+        ['debconf-show', $package],
+        errmsg => "error while trying to get debconf setting $package/$option",
+        outfunc => sub {
+            my ($line) = @_;
+            if ($line =~ m/^(?:\*|\s)\s$package\/$option: (.*)$/) {
+                $to_return = $1;
+            }
+        },
+    );
+
+    return $to_return;
+}
+
+my sub retrieve_zfs_config() {
+    # this only supports setups created through the pve installer.
+    # so hard coding pool names here is fine.
+    my $res = get_json_from_command(['zpool', 'list', '-v', '-j', '-o', 'name,ashift', 'rpool']);
+    my $rpool = $res->{pools}->{rpool};
+
+    my $raid_level = undef;
+    my @disks = qw();
+
+    for my $vdev_name (keys $rpool->{vdevs}->%*) {
+        my $vdev = $rpool->{vdevs}->{$vdev_name};
+
+        if ($vdev->{vdev_type} eq "disk") {
+            if (defined($raid_level) and $raid_level ne "raid0") {
+                # if we assigned a different raid type already, this layout is unsupported
+                return undef;
+            }
+
+            $raid_level = "raid0"; # single or stripped
+            push @disks, $vdev->{path};
+        } elsif ($vdev->{vdev_type} eq "mirror") {
+            if (!defined($raid_level)) {
+                $raid_level = "raid1";
+            } elsif ($raid_level eq "raid1") {
+                # raid10 has two top level mirrors
+                $raid_level = "raid10";
+            } else {
+                # more than two top level mirrors, not supported by the installer
+                return undef;
+            }
+
+            for my $disk (keys $vdev->{vdevs}->%*) {
+                my $disk = $vdev->{vdevs}->{$disk};
+                if ($disk->{vdev_type} eq "disk") {
+                    push @disks, $disk->{path};
+                }
+            }
+        } elsif ($vdev->{vdev_type} eq "raidz" and $vdev_name =~ m/^raidz([123])-0$/) {
+            $raid_level = "raidz-$1";
+
+            for my $disk (keys $vdev->{vdevs}->%*) {
+                my $disk = $vdev->{vdevs}->{$disk};
+                if ($disk->{vdev_type} eq "disk") {
+                    push @disks, $disk->{path};
+                }
+            }
+
+            # raidz only has one top level entry, so exit here
+            last;
+        }
+
+        # ignore other vdev types (draid, spares etc.), none of them can be
+        # created by the installer, so they don't matter for now. don't return
+        # either, users could have added hot-spares or similar and we don't want
+        # to report such setups as "unsupported"
+    }
+
+    # could not determine zfs layout, so it can't be re-created either
+    return undef if !defined($raid_level);
+
+    # check sufficient disks
+    if ($raid_level eq "raid0") {
+        return undef if scalar(@disks) < 1;
+    } elsif ($raid_level eq "raid1") {
+        return undef if scalar(@disks) < 2;
+    } elsif ($raid_level eq "raid10") {
+        return undef if scalar(@disks) < 4;
+    } elsif ($raid_level eq "raidz-1") {
+        return undef if scalar(@disks) < 3;
+    } elsif ($raid_level eq "raidz-2") {
+        return undef if scalar(@disks) < 4;
+    } elsif ($raid_level eq "raidz-3") {
+        return undef if scalar(@disks) < 5;
+    } else {
+        # unknown raid level
+        return undef;
+    }
+
+    # get remaining options only if we can use them with the installer
+    my $ashift = $rpool->{properties}->{ashift}->{value} + 0;
+
+    my $props = get_json_from_command([
+        'zfs', 'get', 'copies,compression,checksum', 'rpool/ROOT/pve-1', '-j',
+    ]);
+    $props = $props->{datasets}->{"rpool/ROOT/pve-1"}->{properties};
+
+    my $compression = undef;
+    $compression = $props->{compression}->{value}
+        if grep(m/^$props->{compression}->{value}$/, qw(on off lzjb lz4 zle gzip zstd));
+
+    my $checksum = undef;
+    $checksum = $props->{checksum}->{value}
+        if grep(m/^$props->{checksum}->{value}$/, qw(on fletcher4 sha256));
+
+    my $copies = undef;
+    my $num_copies = int($props->{copies}->{value});
+    $copies = $num_copies if $num_copies >= 0 && $num_copies <= 3;
+
+    my $arc_tunables = {};
+
+    run(
+        ['zarcsummary', '-s', 'tunables', '-a'],
+        errmsg => "could not get arc tunables",
+        outfunc => sub {
+            my ($line) = @_;
+            if ($line =~ m/^\s+([^=\s]+)=(.*)$/) {
+                $arc_tunables->{$1} = $2;
+            }
+        },
+    );
+
+    return {
+        raid => $raid_level,
+        disks => \@disks,
+        ashift => $ashift,
+        'arc-max' => int($arc_tunables->{zfs_arc_max} / (1024**2)), # arc-max is in MiB
+        checksum => $checksum,
+        compress => $compression,
+        copies => $copies,
+    };
+}
+
+my sub retrieve_btrfs_config() {
+    my $raid_level = undef;
+    my @disks = qw();
+
+    run(
+        ['btrfs', 'filesystem', 'usage', '/', '-T'],
+        errmsg => "could not get btrfs filesystem parameters",
+        outfunc => sub {
+            my ($line) = @_;
+            # parses a line like the below, the third column is the data raid level
+            # Id Path      RAID10  RAID10    RAID10   Unallocated Total     Slack
+            if ($line =~ m/^Id\s+Path\s+(\S+)\s+(?:\S+\s+){5}$/) {
+                $raid_level = $1;
+            }
+
+            # parses a line like the below, the second column is the device path
+            #  1 /dev/sda3 3.00GiB 768.00MiB  8.00MiB    27.74GiB  31.50GiB  3.50KiB
+            if ($line =~ m/^\s*[0-9]+\s(\S+)\s+(?:\S+\s*){6}$/) {
+                push @disks, $1;
+            }
+        },
+    );
+
+    # check that we got an appropriate amount of disks for the raid level
+    if ($raid_level eq "RAID0") {
+        return undef if scalar(@disks) < 1;
+    } elsif ($raid_level eq "RAID1") {
+        return undef if scalar(@disks) < 2;
+    } elsif ($raid_level eq "RAID10") {
+        return undef if scalar(@disks) < 4;
+    } else {
+        return undef;
+    }
+
+    my $content = PVE::Tools::file_get_contents('/etc/fstab');
+    my @lines = split(/\n/, $content);
+    my $compression = undef;
+
+    # parses the compression option for the root fs fstab line for btrfs
+    # the line looks like this:
+    # UUID=30551228-2953-4702-be88-fe045e98b15b / btrfs defaults,compress=zstd 0 1
+    for my $line (@lines) {
+        my @mnt_point = split(m/\s/, $line);
+
+        if (
+            $mnt_point[1] eq '/'
+            && $mnt_point[2] eq 'btrfs'
+            && $mnt_point[3] =~ m/^\S*compress(?:=([^\s,]+))?\S*$/
+        ) {
+            if (defined($1) && grep(m/^$1$/, qw(zlib lzo zstd))) {
+                $compression = $1;
+            } else {
+                $compression = 'on';
+            }
+
+            last;
+        }
+    }
+
+    return {
+        raid => lc($raid_level),
+        disks => \@disks,
+        compress => $compression // 'off',
+    };
+}
+
+my sub retrieve_lvm_config() {
+    my @disks = qw();
+    my $pvs = get_json_from_command(['pvs', '--reportformat', 'json_std']);
+
+    for my $pv (@{ $pvs->{report}->[0]->{pv} }) {
+        if ($pv->{vg_name} eq "pve") {
+            if ($pv->{pv_name} =~ m/(.*)/) { # untaint
+                push @disks, $1;
+            }
+        }
+    }
+
+    # for lvm setups the installer needs exactly one disk, so we couldn't find
+    # one or found too many, we can't recreate the current setup
+    return undef if scalar(@disks) != 1;
+
+    my $lvs = get_json_from_command(['lvs', 'pve', '--unit', 'G', '--reportformat', 'json_std']);
+    my $maxroot = undef;
+    my $swapsize = undef;
+    my $maxvz = undef;
+
+    for my $lv (@{ $lvs->{report}->[0]->{lv} }) {
+        if ($lv->{lv_name} eq 'root') {
+            $maxroot = substr($lv->{lv_size}, 0, -1) + 0;
+        } elsif ($lv->{lv_name} eq 'swap') {
+            $swapsize = substr($lv->{lv_size}, 0, -1) + 0;
+        } elsif ($lv->{lv_name} eq 'data') {
+            $maxvz = substr($lv->{lv_size}, 0, -1) + 0;
+        }
+    }
+
+    # could not find a root lv, not an expected pve layout
+    return undef if !defined($maxroot);
+
+    return {
+        disks => \@disks,
+        maxroot => $maxroot,
+        swapsize => $swapsize,
+        maxvz => $maxvz,
+    };
+}
+
+=head3 get_global_options()
+
+Returns options compatible with the C<global> section of the installer (country,
+fqdn, keyboard etc.).
+
+=cut
+
+sub get_global_options() {
+    my $config = {};
+
+    if (my $country = get_debconf_setting("pve-manager", "country")) {
+        $config->{country} = lc($country);
+    }
+
+    $config->{fqdn} = PVE::Tools::get_fqdn(PVE::INotify::nodename());
+
+    my $dc_conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
+
+    if (my $keyboard = $dc_conf->{keyboard}) {
+        my $kb = lc($keyboard);
+
+        # some keymaps are stored differently in the datacenter config from how
+        # the installer expects them, normalize them.
+        my $normalize_keymap = {
+            "da" => "dk", # danish
+            "ja" => "jp", # japanese
+            "sv" => "se", # swedish
+            "sl" => "si", # slovenian
+        };
+
+        $config->{keyboard} = $normalize_keymap->{$kb} // $kb;
+    }
+
+    my $usercfg = cfs_read_file("user.cfg");
+
+    if (my $mailto = $usercfg->{users}->{'root@pam'}->{email}) {
+        $config->{mailto} = $mailto;
+    }
+
+    $config->{timezone} = PVE::Systemd::get_timezone();
+
+    return $config;
+}
+
+=head get_network_config()
+
+Returns the configuration for C<vmbr0> if we can get one that is compatible with
+the installer. Otherwise, C<undef> is returned.
+
+=cut
+
+sub get_network_config() {
+    my $data = PVE::INotify::read_file('interfaces');
+    my $vmbr0_conf = $data->{ifaces}->{vmbr0};
+
+    return undef if !defined($vmbr0_conf);
+
+    if ($vmbr0_conf->{method} eq 'static') {
+        my $resolve_conf = PVE::INotify::read_file('resolvconf');
+
+        return {
+            source => "from-answer",
+            cidr => $vmbr0_conf->{cidr},
+            dns => $resolve_conf->{dns1},
+            gateway => $vmbr0_conf->{gateway},
+        };
+    } elsif ($vmbr0_conf->{method} eq 'dhcp') {
+        return {
+            source => "from-dhcp",
+        };
+    }
+
+    return undef;
+}
+
+=head3 get_root_fs_setup()
+
+Tries to guess the root disk setup by querying the system via various commands.
+Only setups created through the Proxmox Installer are supported. The returned
+format is compatible with the installer and can be used to re-create the same
+layout.
+
+Returns C<undef> if the root disk layout could not be determined.
+
+=cut
+
+sub get_root_fs_setup() {
+    my $fs = PVE::VZDump::get_mount_info("/");
+    my $fs_type = $fs->{fstype};
+    my $config_key = undef;
+    my $config = undef;
+
+    if ($fs_type eq "zfs") {
+        $config_key = "zfs";
+        $config = retrieve_zfs_config();
+    } elsif ($fs_type eq "ext4" or $fs_type eq "xfs") {
+        $config_key = "lvm";
+        $config = retrieve_lvm_config();
+    } elsif ($fs_type eq "btrfs") {
+        $config_key = "btrfs";
+        $config = retrieve_btrfs_config();
+    }
+
+    return undef if !defined($config);
+
+    # disks are partitions at this point, they will now be normalized
+    # toward their parent disk. hdsize is then calculate by finding the minimum
+    # of the sum of the first three partitions amongst all disks.
+
+    my $hdsize = undef;
+    my @normalized_disks = qw();
+
+    for my $disk (@{ $config->{disks} }) {
+        my $devices = get_json_from_command(['lsblk', $disk, '-o', 'PKNAME', '-J']);
+        my $parent = $devices->{blockdevices}->[0]->{pkname};
+
+        $devices = get_json_from_command([
+            'lsblk',
+            '-Q',
+            'NAME =~ "' . $parent . '"',
+            '-o',
+            'SIZE,PARTN,ID-LINK',
+            '-J',
+            '--bytes',
+        ]);
+
+        my $current_hdsize = 0;
+        my @devs = @{ $devices->{blockdevices} };
+
+        for my $device (@devs) {
+            # use the id link of a disk to identify it
+            if (!defined($device->{partn})) {
+                push @normalized_disks, "/dev/disk/by-id/$device->{'id-link'}";
+            }
+
+            # special case: only three partitions (+1 for the actual disk) are
+            # returned, use whole disk. otherwise, potential padding could
+            # prevent reproducing the desired layout.
+            if (!defined($device->{partn}) and scalar(@devs) == 4) {
+                $current_hdsize = $device->{size};
+                last;
+            } elsif (defined($device->{partn}) and $device->{partn} <= 3) {
+                $current_hdsize += $device->{size};
+            }
+        }
+
+        if (!defined($hdsize) || $current_hdsize < $hdsize) {
+            $hdsize = $current_hdsize;
+        }
+    }
+
+    # hdsize is a float of the size of disk space to use in GiB
+    $config->{hdsize} = $hdsize / (1024**3) if defined($hdsize);
+    delete $config->{disks};
+
+    return {
+        filesystem => $fs_type,
+        'disk-list' => \@normalized_disks,
+        $config_key => $config,
+    };
+}
+
+1;
diff --git a/PVE/Makefile b/PVE/Makefile
index efcb250d0..25c1a38f3 100644
--- a/PVE/Makefile
+++ b/PVE/Makefile
@@ -10,6 +10,7 @@ PERLSOURCE = 			\
 	CertCache.pm		\
 	CertHelpers.pm		\
 	ExtMetric.pm		\
+	HostBackupTools.pm	\
 	HTTPServer.pm		\
 	Jobs.pm			\
 	NodeConfig.pm		\
-- 
2.47.3