229 lines
5.6 KiB
Perl
229 lines
5.6 KiB
Perl
#!/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);
|
|
}
|
|
_updateSystem($target_dir);
|
|
_depclean($target_dir);
|
|
_installNeededPackages($target_dir, $packages);
|
|
}
|
|
|
|
sub _depclean($target) {
|
|
_forkWait() or return;
|
|
_chroot($target);
|
|
my $return_code = system 'emerge', '--depclean';
|
|
if ($return_code != 0) {
|
|
die 'Unable to depclean system.';
|
|
}
|
|
exit 0;
|
|
}
|
|
|
|
sub _updateSystem($target) {
|
|
_forkWait() or return;
|
|
_chroot($target);
|
|
my $return_code = system 'emerge', '-uUDN', '@world';
|
|
if ($return_code != 0) {
|
|
die 'Unable to update the system.';
|
|
}
|
|
exit 0;
|
|
}
|
|
|
|
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.';
|
|
}
|
|
exit 0;
|
|
}
|
|
|
|
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;
|
|
}
|