path: root/lib/Iurt/Queue.pm

package Iurt::Queue;

use base qw(Exporter);
use File::Copy 'move';
use File::Path 'make_path';
use File::stat 'stat';
use Iurt::Config qw(get_mandatory_arch get_target_arch);
use Iurt::File qw(read_line create_file);
use Iurt::Util qw(plog);
use MDK::Common qw(cat_ find member partition);
use strict;

our @EXPORT = qw(
    get_upload_tree_state
    cleanup_failed_build
    check_if_all_archs_processed
    check_if_mandatory_arch_failed
    load_lock_file_data
    record_bot_complete
    remove_bot_from_package
    schedule_next_retry
);

sub apply_to_upload_tree {
    my ($tree_root, $func) = @_;

    # Squash double slashes for cosmetics
    $tree_root =~ s!/+!/!g;

    opendir(my $dir, $tree_root);
    plog('INFO', "check dir: $tree_root");

    foreach my $f (readdir $dir) {
	$f =~ /^\.{1,2}$/ and next;
	if (-d "$tree_root/$f") {
	    plog('DEBUG', "checking target $tree_root/$f");
	    opendir my $target_dir, "$tree_root/$f";

	    foreach my $m (readdir $target_dir) {
		$m =~ /^\.{1,2}$/ and next;
		if (-d "$tree_root/$f/$m") {
		    plog('DEBUG', "checking media $tree_root/$f/$m");
		    opendir my $media_dir, "$tree_root/$f/$m";

		    foreach my $s (readdir $media_dir) {
			$s =~ /^\.{1,2}$/ and next;
			if (-d "$tree_root/$f/$m/$s") {
			    if ($func) {
				opendir my $submedia_dir, "$tree_root/$f/$m/$s";
				foreach my $r (readdir $submedia_dir) {
				    $r =~ /^\.{1,2}$/ and next;
				    $func->($tree_root, $f, $m, $s, $r);
				}
			    }
			}
		    }
		}
	    }
	}
    }
}

sub check_if_mandatory_arch_failed {
    my ($media, $ent, $config) = @_;
    my $mandatory_arch = get_mandatory_arch($config, $ent->{target});
    foreach my $arch (@$mandatory_arch) {
	return 1 if $ent->{media}{$media}{failed_arch}{$arch};
    }
}

sub check_if_all_archs_processed {
    my ($media, $ent, $config) = @_;
    return 1 if $ent->{media}{$media}{done_arch}{noarch};
    return 1 if $ent->{media}{$media}{failed_arch}{noarch};
    my $arch_list = get_target_arch($config, $ent->{target});
    foreach my $arch (@$arch_list) {
	next if $ent->{media}{$media}{done_arch}{$arch};
	next if $ent->{media}{$media}{excluded_arch}{$arch};
	next if $ent->{media}{$media}{failed_arch}{$arch};
	# This arch is not done yet!
	return;
    }
    return 1;
}

sub cleanup_failed_build {
    my ($todo_dir, $done_dir, $fail_dir, $prefix, $ent, $media, $arch, $config) = @_;

    my $mandatory_arch = get_mandatory_arch($config, $ent->{target});
    my $fatal_failure = member($arch, @$mandatory_arch) || $arch eq 'noarch';

    my ($failed_rpms, $kept_rpms);
    if ($fatal_failure) {
	plog('DEBUG', "failure is for mandatory arch $arch, aborting build");
	$failed_rpms = $ent->{rpms};
    } else {
	plog('DEBUG', "failure is for non-mandatory arch $arch, keeping other builds going");
	($failed_rpms, $kept_rpms) = partition { /\.$arch\.rpm$/ } @{$ent->{rpms}};
    }

    foreach my $rpm (@$failed_rpms) {
	my $file = "$done_dir/${prefix}_$rpm";
	plog('DEBUG', "moving built rpm $file to $fail_dir/");
	move($file, "$fail_dir/${prefix}_$rpm");
    }

    if ($fatal_failure) {
	foreach my $done_arch (keys %{$ent->{media}{$media}{done_arch}}) {
	    my $file = "$done_dir/${prefix}_${done_arch}.done";
	    if (-f $file) {
		plog('DEBUG', "deleting $file");
		unlink $file;
	    }
	    delete $ent->{media}{$media}{done_arch}{$done_arch};
        }
    } else {
	# keep rpms for other architectures
	$ent->{rpms} = $kept_rpms;
	# but delete src.rpm if we are now done
	if (check_if_all_archs_processed($media, $ent, $config)) {
	    foreach my $srpm (@{$ent->{srpms}}) {
		my $file = "$todo_dir/${prefix}_$srpm";
		plog('DEBUG', "moving $file to $fail_dir/");
		move($file, "$fail_dir/${prefix}_$srpm");
	    }
	}
	return;
    }

    delete $ent->{rpms};

    foreach my $srpm (@{$ent->{srpms}}) {
	my $file = "$todo_dir/${prefix}_$srpm";
	plog('DEBUG', "moving $file to $fail_dir/");
	move($file, "$fail_dir/${prefix}_$srpm");
	# If one arch has been generated, we also have a src.rpm in done
	$file = "$done_dir/${prefix}_$srpm";
	if (-f $file) {
	    plog('DEBUG', "deleting $file");
	    unlink $file;
	}
    }

    if (-d "$done_dir/$prefix") {
	make_path("$fail_dir/$prefix");
	foreach my $file (glob "$done_dir/$prefix/*") {
	    plog('DEBUG', "moving $file to $fail_dir/$prefix/");
	    move($file, "$fail_dir/$prefix/");
	}
    }
}

sub load_lock_file_data {
    my ($ent, $lock_path, $media, $config) = @_;
    if ($lock_path !~ /\/(\d{14}\.\w+\.\w+\.\d+)_([\w-]+)\.(\w+)\.([\w-]+)\.(\d{14})\.(\d+)\.lock$/) {
	plog('ERROR', "invalid lock file name: $lock_path");
	return;
    }
    my ($prefix, $arch, $bot, $host, $date, $pid) = ($1, $2, $3, $4, $5, $6);

    $arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
    plog('DEBUG', "found lock on $host/$arch for $prefix");

    if ($arch =~ /noarch/) {
	plog('DEBUG', "... and $prefix is noarch");
	$ent->{media}{$media}{arch}{noarch} = 1;
	$arch =~ s/-.*//;
    }

    $ent->{media}{$media}{arch}{$arch} = 1;

    my $time = read_line($lock_path);
    $time = (split ' ', $time)[2];
    push @{$ent->{media}{$media}{bot}}, {
	bot => $bot,
	host => $host,
	date => $date,
	pid => $pid,
	'arch' => $arch,
	'time' => $time
    };
}

sub remove_bot_from_package {
    my ($ent, $media, $host, $pid) = @_;
    @{$ent->{media}{$media}{bot}} = grep { $_->{host} ne $host || $_->{pid} != $pid} @{$ent->{media}{$media}{bot}};
}

sub record_bot_complete {
    my ($run, $bot, $arch, $lock_file, $prefix, $ent, $media, $host, $pid) = @_;
    plog('INFO', "delete lock file for $prefix on $host/$arch");
    unlink $lock_file;
    $run->{bot}{$host}{$bot} = 0;
    remove_bot_from_package($ent, $media, $host, $pid);
    $ent->{media}{$media}{arch}{$arch} = 0;
}

sub get_upload_tree_state {
    our ($config) = @_;

    our %pkg_tree;
    my $todo = "$config->{queue}/todo";
    my $done = "$config->{queue}/done";

    sub todo_func {
	my ($todo, $f, $m, $s, $r) = @_;

	my $media = "$m/$s";

	if ($r =~ /(\d{14}\.(\w+)\.\w+\.\d+)_(.*\.src\.rpm)$/) {
	    my ($prefix, $user, $srpm) = ($1, $2, $3);

	    plog('DEBUG', "found srpm $srpm ($prefix)");
	    $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s";
	    $pkg_tree{$prefix}{target} = $f;
	    $pkg_tree{$prefix}{user} = $user;
	    push @{$pkg_tree{$prefix}{srpms}} , $srpm;
	    my ($name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/;

	    $pkg_tree{$prefix}{srpm_name}{$name} = $srpm;
	}

	if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_([\w-]+)\.(\w+)\.([\w-]+)\.(\d{14})\.(\d+)\.lock$/) {
	    my $prefix = $1;

	    # Set path here too has we may have a lock without the src.rpm
	    $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s";

	    load_lock_file_data(\%{$pkg_tree{$prefix}}, "$todo/$f/$m/$s/$r", $media, $config);
	}

	if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_.*\.deps$/) {
	    my $prefix = $1;
	    my @deps = map { chomp(); $_ } cat_("$todo/$f/$m/$s/$r");
	    plog('DEBUG', "Adding dependency $_ ($prefix)") foreach @deps;

	    $pkg_tree{$prefix}{deps} = \@deps;
	}

	if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_(.*)\.retry$/) {
	    my $prefix = $1;
	    my $arch = $2;
	    my $mtime = stat("$todo/$f/$m/$s/$r")->mtime;
	    my $nb_failures = cat_("$todo/$f/$m/$s/$r");
	    plog('DEBUG', "$prefix failed $nb_failures times, last one was as " . localtime($mtime));
	    if ($mtime > time) {
		plog('INFO', "Too early to retry $prefix, waiting until " . localtime($mtime));
		$pkg_tree{$prefix}{media}{$media}{later}{$arch} = 1;
	    } else {
		$pkg_tree{$prefix}{media}{$media}{retries}{arch}{nb_failures} = $nb_failures;
	    }
	}
    }

    sub done_func {
	my ($_todo, $f, $m, $s, $r) = @_;

	my $media = "$m/$s";

	if ($r =~ /^(\d{14}\.\w+\.\w+\.\d+)([_.].+)$/) {
	    my ($prefix, $suffix) = ($1, $2);
	    $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s";
	    if ($suffix =~ /^_(.*\.([^.]+)\.rpm)$/) {
		my ($rpm, $arch) = ($1, $2);
		$arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
		plog('DEBUG', "found already built rpm $rpm ($prefix) for media $media");
		$pkg_tree{$prefix}{target} = $f;
		if ($arch eq 'src') {
		    $pkg_tree{$prefix}{media}{$media}{done_arch}{src} = 1;
		}
		push @{$pkg_tree{$prefix}{media}{$media}{rpms}} , $rpm;
		push @{$pkg_tree{$prefix}{rpms}} , $rpm;
	    } elsif ($suffix =~ /^_(\w+)\.(\w+)$/) {
		my ($arch, $result) = ($1, $2);
		plog('DEBUG', "found .$result ($prefix) for $arch");
		if ($result eq 'done') {
		    $pkg_tree{$prefix}{media}{$media}{done_arch}{$arch} = 1;
		} elsif ($result eq 'excluded') {
		    $arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
		    $pkg_tree{$prefix}{media}{$media}{excluded_arch}{$arch} = 1;
		} elsif ($result eq 'fail') {
		    $pkg_tree{$prefix}{media}{$media}{failed_arch}{$arch} = 1;
		} elsif ($result eq 'cancelled') {
		    $pkg_tree{$prefix}{media}{$media}{cancelled_arch}{$arch} = 1;
		} elsif ($result eq 'uploaded') {
		    $pkg_tree{$prefix}{media}{$media}{uploaded_arch}{$arch} = 1;
		} else {
		    plog('WARNING', "unknown state $arch.$result for $prefix");
		}
	    } elsif ($suffix =~ /^\.(\w+)$/) {
		my $action = $1;
		if ($action eq 'upload') {
		    plog('DEBUG', "found already uploaded ($prefix)");
		    $pkg_tree{$prefix}{media}{$media}{uploaded} = 1;
		}
	    }
	}
    }

    apply_to_upload_tree($done, \&done_func);
    apply_to_upload_tree($todo, \&todo_func);

    return %pkg_tree;
}

sub schedule_next_retry {
	my ($config, $todo_dir, $prefix, $arch, $nb_failures) = @_;

	# If backoff_delays is not set, do nothing and retry forever
	return 1 unless defined $config->{backoff_delays};

	my $backoff_delays = $config->{backoff_delays};
	my $file = "$todo_dir/${prefix}_$arch.retry";
	create_file($file, $nb_failures+1);
	if ($nb_failures >= scalar(@$backoff_delays)) {
	    plog('INFO', "$prefix failed too many times with a retriable error ($nb_failures)");
	    return;
        }
	my $mtime = time + @$backoff_delays[$nb_failures];
	utime(time, $mtime, $file);
	return 1;
}