path: root/lib/Iurt/Ulri.pm

package Iurt::Ulri;

use base qw(Exporter);
use File::Path qw(make_path);
use File::Temp qw(mktemp);
use Iurt::Config qw(config_init config_usage get_author_email);
use Iurt::File qw(check_file_timeout);
use Iurt::Mail qw(sendmail);
use Iurt::Util qw(plog ssh_setup sget ssh sput);
use File::Slurp qw(read_file);
use MDK::Common qw(cat_);
use strict;

our @EXPORT = qw(
    build_package
    fetch_logs_and_cleanup
    load_config
    warn_about_failure
);

sub load_config {
    my ($run) = @_;
    my $HOME = $ENV{HOME};
    my $configfile = "$HOME/.upload.conf";
    my $sysconfigfile = "/etc/iurt/upload.conf";

    my $config = {};
    foreach my $f ($configfile, $sysconfigfile) {
	plog('DEBUG', "load config: $f");
	if (-f $f) {
            $config = eval(cat_($f))
              or die "FATAL $run->{program_name}: syntax error in $f";
            last;
	}
    }

    my %config_usage = (
	admin => {
	    desc => 'mail address of the bot administrator',
	    default => 'distrib-admin@mandrivalinux.org'
	},
	'arch_translation' => {
	    desc => "Renaming of arch",
	    default => { 'sparc64' => 'sparcv9' }
	},
	bot => {
	    desc => "List of bot able to compile the packages",
	    default => {
		i586 => {
	            localhost => {
			iurt => {
			    user => 'builder',
			    command => qq(iurt --copy_srpm --group --config local_spool /home/builder/iurt/__DIR__ --no_rsync --chrooted-urpmi -m __MEDIA__ -- http://localhost/distrib/ -p "__PACKAGER__" -r __TARGET__ __ARCH__),
			    packages => '/home/builder/iurt/',
			},
		    },
		},
	    },
	},
	media => {
	    desc => 'Corresponding media to add given the current media',
	    default => {
		default => {
		    "core/backports" => [ "core/backports", "core/release", "core/updates" ],
		    "core/backports_testing" => [
			"core/backports", "core/backports_testing",
			"core/release", "core/updates"
		    ],
		    "core/release" => [ "core/release" ],
		    "core/updates" => [ "core/release", "core/updates" ],
		    "core/updates_testing" => [
			"core/release", "core/updates", "core/updates_testing"
		    ],
		    "nonfree/backports" => [
			"core/backports", "core/release", "core/updates",
			"nonfree/backports", "nonfree/release", "nonfree/updates"
		    ],
		    "nonfree/backports_testing" => [
			"core/backports", "core/backports_testing",
			"core/release", "core/updates",
			"nonfree/backports", "nonfree/backports_testing",
			"nonfree/release", "nonfree/updates"
		    ],
		    "nonfree/release" => [ "core/release", "nonfree/release" ],
		    "nonfree/updates" => [
			"core/release", "core/updates",
			"nonfree/release", "nonfree/updates"
		    ],
		    "nonfree/updates_testing" => [
			"core/release", "core/updates", "core/updates_testing",
			"nonfree/release", "nonfree/updates", "nonfree/updates_testing"
		    ],
		    "tainted/backports" => [
			"core/backports", "core/release", "core/updates",
			"tainted/backports", "tainted/release", "tainted/updates"
		    ],
		    "tainted/backports_testing" => [
			"core/backports", "core/backports_testing",
			"core/release", "core/updates",
			"tainted/backports", "tainted/backports_testing",
			"tainted/release", "tainted/updates"
		    ],
		    "tainted/release" => [ "core/release", "tainted/release" ],
		    "tainted/updates" => [
			"core/release", "core/updates",
			"tainted/release", "tainted/updates"
		    ],
		    "tainted/updates_testing" => [
			"core/release", "core/updates", "core/updates_testing",
			"tainted/release", "tainted/updates", "tainted/updates_testing"
		    ],
		},
	    },
	},
	faildelay => {
	    desc => "Time after which the rebuild is considered as a failure",
	    default => 36000
	},
	http_queue => {
	    desc => 'Address where log can be consulted',
	    default => 'http://pkgsubmit.mageia.org/uploads/'
	},
	queue => {
	    desc => "Root of the tree where the packages to compile are located",
	    default => "$HOME/uploads"
	},
	tmp => {
	    desc => "Temporary directory",
	    default => "$HOME/tmp"
	},
	ssh_options => {
	    desc => "SSH options",
	    default => "-o ConnectTimeout=5 -o BatchMode=yes -o ServerAliveInterval=5"
	},
	packager => {
            desc => 'Default packager tag user by bot',
	    default => 'Mageia Team <http://www.mageia.org>'
	},
	'arch' => {
	    desc => 'Architectures list for each target',
	    default => {
		default => [ 'i586', 'x86_64' ],
	    },
	},
	'backoff_delays' => {
	    desc => 'List of delays in seconds before retrying retriable errors. Error becomes permanent after reaching the end of the list.',
	    default => [5*60, 30*60, 60*60, 120*60]
	},
    );
    config_usage(\%config_usage, $config) if $run->{config_usage};
    config_init(\%config_usage, $config, $run);
    return $config;
}

sub build_package {
    my ($config, $pkg_tree, $media, $prefix, $host, $arch, $bot) = @_;

    plog('INFO', "building on $host/$arch ($bot)");

    my $path = $pkg_tree->{$prefix}{media}{$media}{path};
    my $todo_dir = "$config->{queue}/todo/$path";
    my $target = $pkg_tree->{$prefix}{target};
    my $srpms = $pkg_tree->{$prefix}{srpms};
    my $user = get_author_email($pkg_tree->{$prefix}{user}) || $config->{packager};
    $user =~ s/([<>])/\\$1/g;

    my $bot_conf = $config->{bot}{$arch}{$host}{$bot};
    my $remote = ssh_setup($config->{ssh_options},
			   $bot_conf->{user}, $host);

    my $prefix_dir = "$bot_conf->{packages}/$path/$prefix-$arch/";
    my $status_file = "$prefix_dir/log/status.log";

    # Copy packages to build node
    #
    # create also the log dir for botcmd.log
    if (ssh($remote, "mkdir -p $prefix_dir/log")) {
	exclude_machine($config, $host);
	next;
    }
    my $pkgs;
    my $ok = 1;
    foreach my $srpm (@$srpms) {
	plog('NOTIFY', "Send to $host/$arch: $srpm");
	$ok &&= !sput($remote, "$todo_dir/${prefix}_$srpm",
		      "$prefix_dir/$srpm");
	$pkgs .= " $prefix_dir/$srpm";
    }
    if (!$ok) {
	exclude_machine($config, $host);
	return;
    }

    # spawn remote build bot and save output on local file
    # (remove status.log before building, otherwise we can have
    # a install_deps_failure and reschedule even if the package
    # is currently building)
    #
    plog('DEBUG', "remove status file");
    ssh($remote, "rm $status_file 2>/dev/null");

    plog('INFO', "Execute build command on $host/$arch");

    my $temp = mktemp("$config->{tmp}/ulri.tmp.$prefix.XXXXX");
    my $cmd = $bot_conf->{command};
    $cmd =~ s!__ARCH__!$arch!g;
    $cmd =~ s!__DIR__!$path/$prefix-$arch!g;
    $cmd =~ s!__TARGET__!$target!g;
    $cmd =~ s!__PACKAGER__!$user!g;
    my $section = $media;
    $section =~ s!/.*$!!;
    $cmd =~ s!__SECTION__!$section!g;

    my $media_to_add;
    my $medium = ref $config->{media}{$target}{$media} ? $target : 'default';
    $media_to_add = join ' ', @{$config->{media}{$medium}{$media}};
    plog('DEBUG', "Will compile only with media $media_to_add");
    $cmd =~ s!__MEDIA__!$media_to_add!g;

    #- force 32bit if needed, this allows to build 32 bits package on 64 bit hosts
    if ($arch =~ /^(i.86|armv5tl|armv7hl)/) {
	$cmd = "setarch linux32 $cmd";
    }

    plog('DEBUG', "Build $pkgs");
    ssh($remote, "'echo PID=\$\$; exec $cmd $pkgs &>$prefix_dir/log/botcmd.\$(date +%s).$arch.\$(hostname -s).log' > $temp &");

    # wait 10 seconds or until we have the log file
    # plus 20 seconds if it timeouts.
    #
    if (check_file_timeout($temp, 10)) {
	plog('WARN', "Timeout waiting for building start. Waiting more 20s.");
	if (check_file_timeout($temp, 20)) {
	    plog('WARN', "Timeout! Abandoning the build.");
	    return;
	}
    }

    # get remote PID from log file
    #
    my $pid = get_pid_from_file($temp);
    unlink $temp;
    plog('DEBUG', "remote pid $pid");
    if (!$pid) {
	plog('WARN', "pid is unknown, abandoning the build.");
	return;
    }

    # Fork to wait for the build to finish
    if (fork() == 0) {
	local $SIG{ALRM} = sub {
	    # Run ourselves to kill the build
	    exec "ulri";
        };
	alarm $config->{faildelay};
	# SSH to $host and wait up for $pid to exit
	ssh($remote, "'while /bin/true; do ps $pid >/dev/null 2>&1 || exit; sleep 1; done'");
	alarm 0;
	# Fetch build results
	exec "ulri";
    }
    return $pid;
}

sub exclude_machine {
    my ($config, $host) = @_;
    plog('INFO', "Excluding build host $host");
    foreach my $arch (keys %{$config->{bot}}) {
	delete $config->{bot}{$arch}{$host};
    }
}

sub get_pid_from_file {
    my ($file) = @_;

    my $pid;
    open my $FILE, $file || die "FATAL: can't open $file";
    local $_;
    while (<$FILE>) { last if ($pid) = /^PID=(\d+)/ }

    $pid;
}

sub fetch_logs_and_cleanup {
    my ($remote, $remote_dir, $target_dir) = @_;
    make_path($target_dir);
    sget($remote, "$remote_dir/log/*", $target_dir);
    ssh($remote, "rm -rf $remote_dir");
}

sub warn_about_failure {
    my ($config, $user, $ent, $arch, $fail_dir, $path, $prefix) = @_;
    my $text = join("\n", "Build of the following packages failed:\n", map { "- $_" } @{$ent->{srpms}}) . "\n";
    my $srpms = join(' ', @{$ent->{srpms}}, undef);

    my $to = get_author_email($user) || "Unknown <$config->{admin}>";
    my $cc;
    my $fpath = "$config->{http_queue}/failure/$path/$prefix";
    $fpath =~ tr!/!!s;             # Squash double slashes ...
    $fpath =~ s!/!//!;           # ... except for http://

    $text .= "\nFailure details available in $fpath/log\n";
    $text .= "Reason:\n";
    $text .= read_file("$fail_dir/$prefix/log/status.log");
    $text .= "\nLog files generated:\n";

    opendir my $DP1, "$fail_dir/$prefix/log/";
    foreach my $f1 (readdir($DP1)) {
        next if ! -d "$fail_dir/$prefix/log/$f1" || $f1 =~ m/^\./;

        opendir my $DP2, "$fail_dir/$prefix/log/$f1";
        foreach my $f2 (sort(readdir $DP2)) {
            next if $f2 =~ m/^\./;
            $text .= "$fpath/log/$f1/$f2\n";
        }
        closedir $DP2;
    }
    closedir $DP1;

    sendmail($to, $cc,
             "Rebuild failed on $arch for $srpms", $text,
             "Ulri the scheduler bot <$config->{admin}>", 0, $config);
}