#!/usr/bin/perl

# Yuri Myasoedov <omerta13@yandex.ru>, 2012-2013 (https://bazaar.launchpad.net/~ymyasoedov/aum/trunk/view/head:/genchroot-tarball)
# AdmSasha <dik@inbox.ru>, 2019
# Licence: GPLv3+

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

use strict;
use warnings;

use Cwd qw(getcwd);
use File::chdir;
use File::Copy;
use File::Temp qw(tempdir);
use Getopt::Long;
use Log::Message::Simple qw(:STD :CARP);
use POSIX;
use Locale::gettext;

bindtextdomain("genchroot-tarball", "/usr/share/locale");
textdomain("aum++");

our $APP_NAME    = 'genchroot-tarball';

# Supported formats
our %formats = (gz  => 'czf', bz2 => 'cjf', xz  => 'cJf');

# Options used by default
our %options = (
    'archiver'        => 'tar',
    'format'          => 'gz',
    'name'            => 'chroot',
    'rpm_list_format' => '%{NAME}:%{VERSION}:%{RELEASE}:%{SOURCERPM}\n',
    'verbose'         => 0
);

# Parsing options
Getopt::Long::Configure("bundling"); # Enable bundling options like: -abc
GetOptions(
    "help|h"            => sub { show_usage(); exit 0 },
    "distrib|d=s"       => \$options{distrib},
    "archiver=s"        => \$options{archiver},
    "format=s"          => \$options{format},
    "name|n=s"          => \$options{name},
    "rpm-list-format=s" => \$options{rpm_list_format},
    "urpmi-options=s"   => \$options{urpmi_options},
    "upload-dir=s"      => \$options{upload_dir},
    "log-file=s"        => \$options{log_file},
    "verbose|v"         => sub { $options{verbose}++ },
    "add-rpmmacros=s"   => \$options{rpmmacros}
) or die gettext("Can't parse command line options\n");

# Show help and exit if user didn't provide any arguments
unless (@ARGV) {
    show_usage();
    exit 0;
}

# redirection to file
if ($options{log_file}){
    open(STDOUT,"| tee ".$options{log_file});
    open(STDERR,">&STDOUT");
}


# only root
if (getuid()!=0){
    die gettext("You must be root")."\n";
}

# set upload directory
if ($options{upload_dir}) {
    # Create upload dir
    system("mkdir -p $options{upload_dir}");
    die gettext("Can't create upload dir")." \"$options{upload_dir}\"\n" if ($?);
    
    # Set ownership and permissions
    my ($uid, $gid) = get_user_info();
    msg(sprintf(gettext("Setting ownership (%s:%s) and permissions"),$uid,$gid), $options{verbose});
    system("chown -R $uid:$gid $options{upload_dir}");
    die gettext("Can't change ownership of upload directory")." \"$options{upload_dir}\"\n" if ($?);
    system("chmod -R +r $options{upload_dir}");
    die gettext("Can't change mode of upload directory")." \"$options{upload_dir}\"\n" if ($?);
    
    chdir $options{upload_dir};
}

unless ($options{archiver}=~/^(tar|zip)$/){
    printf gettext("Archiver %s is not supported")."\n",$options{archiver};
    exit 0;
}


# generate name archive
my $archiveName = "";
if ($options{archiver} eq "tar"){
    $archiveName = "$options{name}.tar.$options{format}";
}
if ($options{archiver} eq "zip"){
    $archiveName = "$options{name}.zip";
}


# If tarball is already exists
if (-f $archiveName) {
    my $line;
    do {
        printf gettext("Chroot tarball \"%s\" is already exists. Overwrite it?"),$archiveName;
        printf (" [y/n]");
        chomp($line = <STDIN>);
    } while ($line !~ /^\h*(y|n)\h*$/i);
    if ($line =~ /^\h*n\h*$/i) {
        exit 1;
    }
    # Delete existing chroot
    unlink "$archiveName" or die gettext("Can't delete file")." \"$archiveName\": $!\n";
}

# Create temporary directory for building chroot
msg(gettext("Creating temporary directory"), $options{verbose});
my $tmp_dir = tempdir("genchroot-tarball-XXXXXX", TMPDIR => 1, CLEANUP => 1) or 
    die gettext("Could't create temporary directory:")." $!\n";
mkdir "$tmp_dir/chroot" or die gettext("Could't create chroot directory")." \"$tmp_dir\": $!\n";

# Install packages in chroot directory
my @packages = @ARGV;
msg(gettext("Installing specified packages in chroot"), $options{verbose});
install_packages(\@packages, "$tmp_dir/chroot");

# Set ownership and permissions
my ($uid, $gid) = get_user_info();
msg(sprintf(gettext("Setting ownership (%s:%s) and permissions"),$uid,$gid), $options{verbose});
system("chown -R $uid:$gid $tmp_dir");
die gettext("Can't change ownership of temporary directory")." \"$tmp_dir\"\n" if ($?);
system("chmod -R +r $tmp_dir");
die gettext("Can't change mode of temporary directory")." \"$tmp_dir\"\n" if ($?);

# Add rpmmacros in chroot
if ($options{rpmmacros}) {
    if (-f $options{rpmmacros}) {
        msg(gettext("Adding rpm macros"), $options{verbose});
        copy($options{rpmmacros}, "$tmp_dir/chroot/etc/skel/.rpmmacros") or 
            die gettext("Can't copy rpmmacros:")." $!\n";
    }
    else {
        error(gettext("Specified rpm macros file")." \"$options{rpmmacros}\" ".gettext("doesn't exist"));
    }
}

# Saving list of installed rpm files
msg(gettext("Creating list of installed packages"), $options{verbose});
my $rpm_list = `rpm -r $tmp_dir/chroot -qa --queryformat '$options{rpm_list_format}' | sort`;
open(FH, ">$options{name}-rpms.lst") or die gettext("Couldn't open file:")." $!\n";
print FH $rpm_list;
close(FH);
msg(sprintf(gettext("Setting ownership (%s:%s) and permissions of %s-rpms.lst"),$uid,$gid,$options{name}), $options{verbose});
system("chown $uid:$gid $options{name}-rpms.lst");

# Creating tarball
my $cwd = $options{upload_dir} || getcwd();
{
    
    # Change directory to $tmp_dir
    local $CWD = $tmp_dir;
    msg(gettext("Creating chroot tarball"), $options{verbose});
    
    
    if ($options{archiver} eq "tar"){
	system("tar $formats{$options{format}} \"$cwd/".$archiveName."\" chroot");
    }
    if ($options{archiver} eq "zip"){
	system("zip -r \"$cwd/".$archiveName."\" chroot");
    }
    
    if ($?) {
        die gettext("Can't create chroot tarball archive\n");
    }
    
    
    msg(sprintf(gettext("Setting ownership (%s:%s) and permissions"),$uid,$gid), $options{verbose});
    system("chown $uid:$gid \"$cwd/".$archiveName."\"");
}

#
# Installs packages in chroot directory
#
sub install_packages {
    my ($pkgs_ref, $chroot_dir) = @_;

    # Default urpmi options
    my @urpmi_options = qw(--no-verify-rpm --nolock --auto --ignoresize --no-recommends);

    # Set verbosity level
    if ($options{verbose})     { push @urpmi_options, '-v'; }
    if ($options{verbose} > 1) { push @urpmi_options, '--debug'; }

    # Add additional urpmi options
    if ($options{urpmi_options}) {
        my @extra_urpmi_options = split /,/, $options{urpmi_options};
        push @urpmi_options, @extra_urpmi_options;
    }

    # Prepare urpmi command
    my $cmd = "LC_ALL=C urpmi ";
    if ($options{distrib}) {
        $cmd .= "--use-distrib $options{distrib} ";
    }
    $cmd .= join(' ', @urpmi_options);
    $cmd .= " --root $chroot_dir ";
    $cmd .= join(' ', @$pkgs_ref);

    system("$cmd 2>&1");
    die gettext("Can't install packages in chroot directory!\n") if $?;
}

#
# Shows general help message
#
sub show_usage {
printf gettext("

%s - a tool for generating chroot tarball

  Options:

    --help or -h      Show this help and exit
    --archiver        Choose archiver (tar,zip; tar - by default)
    --format          Choose archive format (gz, bz2 or xz; gz - by default)
    --distrib         Use specified distrib
    --name or -n      Set chroot tarball name (\"chroot\" - by default)
    --urpmi-options   Use specified urpmi options while installing packages in chroot
    --add-macros      Add specified rpm macros in chroot (in /etc/skel directory)
    --upload-dir      Folder for uploading the chroot archive
    --log-file        Path to log file

  Examples:

  * Generate chroot archive for Mageia Linux 3 (i586):

     genchroot-tarball --distrib=http://distrib-coffee.ipsl.jussieu.fr/pub/linux/Mageia/distrib/3/i586/ basesystem-minimal rpm-build sudo urpmi curl

  * Generate chroot archive for Mageia Linux 3 (i586) with local distrib:

     genchroot-tarball --distrib=file:///home/user/distrib/3/i586/ basesystem-minimal rpm-build sudo urpmi curl

"),$APP_NAME;
}

#
# Gets effective UID and GID
#
sub get_user_info {
    my $username = getlogin() ||  getpwuid($<) || die gettext("Undefined username\n");
    my ($name, $pass, $uid, $gid, $quota, $comment, $gcos, $dir, $shell, $expire) = getpwnam($username);
    unless (defined($uid) and defined($gid)) {
        die gettext("Can't define UID/GID\n");
    }
    ($uid, $gid);
}
