BaseUtilsGentoo/prepare_system.pl

#!/usr/bin/env perl

use v5.36.0;

use strict;
use warnings;
use utf8;

use Path::Tiny;

main();

sub main {
    die 'Must be superuser.' if $< != 0;
    my $target_dir = shift @ARGV or die 'No target dir passed.';
    my $rebuild_bin = shift @ARGV // 0;

    $target_dir = path($target_dir);

    my $gentoo_conf = path('gentoo.conf');
    my $make_conf  = path('make.conf');
    my $resolv_conf = path('/etc/resolv.conf');
    my $zz_use = path('zz-use');


    my $packages = _readPackagesToInstall();
    _checkValidSystem($target_dir);

    my $make_conf_changed = _installMakeConf( $target_dir, $make_conf );
    _installGentooConf($target_dir, $gentoo_conf);
    _installResolvConf($target_dir,$resolv_conf);
    my $package_use_changed = _installPackageUse($target_dir, $zz_use);

    _mountNecessaryFilesystems($target_dir);
    _webrsync($target_dir);
    if ($rebuild_bin && $package_use_changed || $make_conf_changed) {
        _rebuildBinaries($target_dir);
    }
    _installNeededPackages($target_dir, $packages);
}

sub _rebuildBinaries($target) {
    _forkWait() or return;
    _chroot($target);
    my $return_code = system 'emerge', '-e', '@system';
    if ($return_code != 0) {
        die 'Unable to rebuild binaries for system.';
    }
    my $return_code = system 'emerge', '-e', '@world';
    if ($return_code != 0) {
        die 'Unable to rebuild binaries for world.';
    }
}

sub _installNeededPackages($target, $packages) {
    _forkWait() or return;
    _chroot($target);
    my $return_code = system 'emerge', '--noreplace', @$packages;
    if ($return_code != 0) {
        exit $return_code;
    }
    exit 0;
}

sub _readPackagesToInstall {
    my @packages;
    open my $fh, '<', 'packages';
    while (my $line = <$fh>) {
        chomp $line;
        push @packages, $line;
    }
    close $fh;
    return \@packages;
}

sub _forkWait {
    my $pid = fork;
    if ($pid) {
        wait;
        my $return_code = $?;
        if ($? != 0) {
            exit $?;
        }
        return 0;
    }
    return 1;
}

sub _webrsync($target) {
    _forkWait() or return;
    _chroot($target);
    my $return_code = system 'emerge-webrsync';
    if ($return_code != 0) {
        return $return_code;
    }
    exit 0;
}

sub _chroot($target) {
    chroot "$target";
    chdir '/';
}

sub _mountNecessaryFilesystems($target) {
    my $dest_proc = $target->child('proc');
    my $dest_dev = $target->child('dev');
    my $dest_sys = $target->child('sys');

    _mountType('proc', $dest_proc) if !_checkMounted($dest_proc);
    _mountType('sysfs', $dest_sys) if !_checkMounted($dest_sys);
    _mountRbind('/dev', $dest_dev) if !_checkMounted($dest_dev);
}

sub _checkMounted($fs) {
    $fs = $fs->realpath;
    my $return = index(_getMounts(), $fs) != -1;
    say "$fs is mounted." if $return;
    return $return;
}

sub _mountRbind($source, $fs) {
    my $return_code = system 'sudo', 'mount', '--rbind', $source, $fs;
    if ($return_code != 0) {
        die "Unable to mount $fs.";
    }
}

{
    my $mounts;
    sub _getMounts {
        if (!defined $mounts) {
            open my $fh, '-|', 'sudo', 'mount';
            $mounts = join '', <$fh>;
            close $fh;
        }
        return $mounts;
    }
}

sub _mountType($fs_type, $fs) {
    my $return_code = system 'sudo', 'mount', '-t', $fs_type, $fs_type, $fs;
    if ($return_code != 0) {
        die "Unable to mount $fs.";
    }
}

sub _checkValidSystem ($target) {
    if ( !-d $target ) {
        die 'Target system not populated yet.';
    }
}

sub _installResolvConf($target, $resolv_conf) {
    my $dest_resolv_conf = $target->child('etc/resolv.conf');
    _install($resolv_conf, $dest_resolv_conf);
}

sub _installGentooConf($target, $gentoo_conf) {
    my $dest_gentoo_conf = $target->child('etc/portage/repos.conf/gentoo.conf');
    my $repos_conf = $dest_gentoo_conf->parent;
    my $return_code = system 'sudo', 'mkdir', '-p', $repos_conf;
    if ($return_code != 0) {
        say "Unable to create $repos_conf.";
    }
    _install($gentoo_conf, $dest_gentoo_conf);
}

sub _installPackageUse($target, $zz_use) {
    my $dest_zz_use = $target->child('etc/portage/package.use/zz-use');
    my $package_use = $dest_zz_use->parent;
    my $return_code = system 'sudo', 'mkdir', '-p', $package_use;
    if ($return_code != 0) {
        say "Unable to create $package_use.";
    }
    _install($zz_use, $dest_zz_use);
}

sub _installMakeConf ( $target, $make_conf ) {
    my $dest_make_conf = $target->child('etc/portage/make.conf');
    return _install($make_conf, $dest_make_conf);
}

sub _install($source, $dest) {
    if ( -e $dest
        && _getSha512SumFile($dest) eq _getSha512SumFile($source) )
    {
        say "$source is already installed, skipping.";
        return;
    }
    say "Target $source differs, installing...";
    my $return_code = system 'sudo', 'cp', '-L', $source, $dest;
    if ( $return_code != 0 ) {
        die "Unable to install $dest";
    }
    return 1;
}

sub _getSha512SumFile ($file) {
    open my $fh, '-|', 'sha512sum', $file;
    my $text = <$fh>;
    close $fh;

    my ($sha512sum) = $text =~ /^(\S+)/;
    return $sha512sum;
}