path: root/emi

#!/usr/bin/perl
#
# Copyright (C) 2005,2006 Mandriva
# 
# Author: Florent Villard <warly@mandriva.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# upload packages in queue when all the mandatory architectures are done
#
# TODO
# 
# - take the packages in done/ and upload them with youri in queue/
# - check that the mandatory architectures are present
#
# PREFIX : sprintf "$year%02d%02d%02d%02d%02d.$user.$host.${$}_", $mon, $mday, $hour, $min, $sec;

use strict;
use File::Path qw(make_path);
use Iurt::Config qw(config_usage config_init get_author_email get_mandatory_arch);
use Iurt::Process qw(check_pid);
use Iurt::Mail qw(sendmail);
use Iurt::File qw(check_upload_tree);
use Iurt::Util qw(plog_init plog);
use Data::Dumper;
use MDK::Common qw(cat_ if_ find touch);
use MDK::Common::DataStructure qw(difference2);

my %run;
my $program_name = 'emi';
$run{program_name} = $program_name;

my $LOG;
if (!$ENV{EMI_LOG_FILE} || !open($LOG, '>>', $ENV{EMI_LOG_FILE})) {
    open($LOG, ">&STDERR");
}

plog_init($program_name, $LOG, 7, 1);

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 $program_name: syntax error in $f";
        last;
    }
}

my %config_usage = ( 
    admin => {
	desc => 'mail address of the bot administrator',
	default => 'distrib-admin@mandrivalinux.org'
    },
    'arch' => {  
	desc => "List of arch",
	default => [ 'i586', 'x86_64', 'ppc' , 'sparcv9' ]
    },
    'arch_translation' => {  
	desc => "Renaming of arch",
	default => { 'sparc64' => 'sparcv9' }
    },
    http_queue => {
	desc => 'Address where log can be consulted',
	default => 'http://kenobi.mandriva.com/queue/'
    },
    mandatory_arch => {
	desc => 'List of mandatory architecture to be able to upload',
	default => [ 'i586', 'x86_64' ]
    },
    tmp => {
	desc => "Temporary directory",
	default => "$HOME/tmp"
    },
    root => {
	desc => 'Architecture root dir',
	default => "/mnt/BIG/dis/"
    },
    upload_user => {
	desc => 'User who is uploading packages',
	default => 'mandrake'
    },
    queue => {
	desc => 'root directory of the various upload queues',
	default => "$HOME/uploads"
    },
    ssh_option => {
	desc => "SSH options",
	default => "-o ConectTimeout=20"
    },
);

config_usage(\%config_usage, $config) if $run{config_usage};
config_init(\%config_usage, $config, \%run);

$run{pidfile_home} = $config->{tmp};
$run{pidfile} = "upload";
my $pidfile = check_pid(\%run);

my $todo = "$config->{queue}/todo";
my $done = "$config->{queue}/done";
my $reject = "$config->{queue}/rejected";

my %pkg_tree;
my %excluded;
my %archdone;
my %uploaded;


#
# Gather data from upload tree
#

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

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

    if ($r =~ /^(\d{14}\.\w+\.\w+\.\d+)([_.].+)$/) {
	my ($prefix, $suffix) = ($1, $2);
	if ($suffix =~ /^_(\w+)\.(\w+)$/) {
	    my ($arch, $result) = ($1, $2);
	    if ($result eq 'done') {
		plog('DEBUG', "found .done ($prefix) for $arch");
		$archdone{$prefix}{$section}{$arch} = 1;
	    } elsif ($result eq 'excluded') {
		$arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
		plog('DEBUG', "found .excluded ($prefix) for $arch");
		$excluded{$prefix}{$section}{$arch} = 1;
	    }
	} elsif ($suffix =~ /^\.(\w+)$/) {
	    my ($action) = $1;
	    if ($action eq 'upload') {
		plog('DEBUG', "found already uploaded ($prefix)");
		$uploaded{$prefix}{$section} = 1;
	    }
	}
    }
}

sub done_post {
    my ($_todo, $f, $m, $s, $r) = @_;
    my $section = "$m/$s";
    if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_(.*\.([^.]+)\.rpm)$/) {
	my ($prefix, $rpm, $arch) = ($1, $2, $3);
	$arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
	plog('DEBUG', "found rpm $rpm ($prefix) for section $section");
	$pkg_tree{$prefix}{target} = $f;
	$pkg_tree{$prefix}{section}{$section}{path} = "/$f/$m/$s";
	if ($arch eq 'src') {
	    push @{$pkg_tree{$prefix}{section}{$section}{srpms}}, $rpm;
	    $pkg_tree{$prefix}{section}{$section}{arch}{src} = 1;
	} elsif ($archdone{$prefix}{$section}{$arch}) {
	    $pkg_tree{$prefix}{section}{$section}{arch}{$arch} = 1;
	}
	push @{$pkg_tree{$prefix}{section}{$section}{rpms}} , $rpm;
    }
}

sub todo_func {
    my ($_todo, $_f, $_m, $_s, $r) = @_;

    if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_(.*\.([^.]+)\.rpm)$/) {
	my ($prefix, $rpm) = ($1, $2);
	plog('DEBUG', "found todo rpm $rpm ($prefix)");
	push @{$pkg_tree{$prefix}{todo}}, $rpm;
    }
}

check_upload_tree($done, \&done_func, \&done_post);
check_upload_tree($todo, \&todo_func);


#
# Decide what should be uploaded
#

# $targets{$target}{$section}{arch_finisher}{$arch}: prefix on which we need to actions to get this arch updated
# $targets{$target}{$section}{to_upload}: list of prefixes to upload
my %targets;

foreach my $prefix (sort keys %pkg_tree) {
    my $target = $pkg_tree{$prefix}{target};
    my $mandatory_arch = get_mandatory_arch($config, $target);

    plog('NOTIFY', "processing $prefix");

    my $ok = 1;

    foreach my $section (keys %{$pkg_tree{$prefix}{section}}) {
	my @wanted_archs = defined($pkg_tree{$prefix}{section}{$section}{arch}{noarch}) ? 'noarch' : @$mandatory_arch;
	my $path = $pkg_tree{$prefix}{section}{$section}{path};
	my %missing;

	plog('DEBUG', "... in $path");

	if ($uploaded{$prefix}{$section}) {
	    plog('INFO', "package already uploaded for mandatory arches, proceeding");
	    next;
	}

	foreach my $m (@wanted_archs, 'src') {
	    $excluded{$prefix}{$section}{$m} and next;
	    my $x = "yes";
	    if (!$pkg_tree{$prefix}{section}{$section}{arch}{$m}) {
		$missing{$m} = 1;
		$x = "no";
		$ok = 0;
	    }
	    plog('INFO', " mandatory architecture $m present: $x");
	}
	
	unless ($ok) {
	    plog('INFO', "mandatory arch", join(' ', keys %missing),
				"missing for $section, waiting");
	    next;
	}
    }
    next unless $ok;
    
    #
    # All mandatory archs found, mark for upload
    #
    foreach my $section (keys %{$pkg_tree{$prefix}{section}}) {
	$targets{$target}{$section} ||= { 'arch_finisher' => {}, 'is_finisher' => {}, 'to_upload' => [] };

	push @{$targets{$target}{$section}{to_upload}}, $prefix;

	# We already have found universal finisher in that section, we're fine
	next if exists $targets{$target}{$section}{arch_finisher}{noarch};

	if ($pkg_tree{$prefix}{section}{$section}{arch}{noarch}) {
	    # This package is noarch, genhdlist for it will touch all archs
	    $targets{$target}{$section}{arch_finisher} = { 'noarch' => $prefix };
	} else {
	    my $has_new_arch = scalar(difference2([ keys %{$pkg_tree{$prefix}{section}{$section}{arch}} ], [ keys %{$targets{$target}{$section}{arch_finisher}} ]));
	    if ($has_new_arch) {
		# We need this package to cover the new arch
		# Set it for all, it may allow getting rid of some others
		foreach (keys %{$pkg_tree{$prefix}{section}{$section}{arch}}) {
		    $targets{$target}{$section}{arch_finisher}{$_} = $prefix;
		}
	    }
	}
    }
}

sub upload_prefix_in_section {
    my ($prefix, $section, $o_finish) = @_;
    my @packages;
    my ($user) = $prefix =~ /\d{14}\.(\w+)\.\w+\.\d+$/;
    my $target = $pkg_tree{$prefix}{target};

    my $path = $pkg_tree{$prefix}{section}{$section}{path};
    
    plog('OK', "all mandatory archs done: $prefix");
    foreach my $rpm (@{$pkg_tree{$prefix}{section}{$section}{rpms}}) {
	push @packages, "$done/$path/${prefix}_$rpm";
	plog('OK', " uploading $rpm in $done/$path");
    }
    
    $user ||= $config->{upload_user};
    # FIXME we want to skip all post, we should not hardcode them here
    my $skip = $o_finish ? "" : "--skip-post genhdlist2 --skip-post mirror --skip-post clean_rpmsrate";
    my $command = "/usr/bin/perl -I/usr/share/mga-youri-submit/lib /usr/share/mga-youri-submit/bin/youri-submit --verbose --config /etc/youri/submit-upload.conf --define user=$user --define prefix=$prefix --define section=$section $skip $target @packages &> $done/$path/$prefix.youri";
    
    plog('DEBUG', "running $command");
    if (!system($command)) {
	plog('INFO', "upload succeeded");
    } else {
	# should send a mail or something
	plog('ERROR', "upload failed ($!), rejecting files in $reject/$path/");
	make_path("$reject/$path");
	foreach my $rpm (@{$pkg_tree{$prefix}{section}{$section}{rpms}}) {
	    link("$done/$path/${prefix}_$rpm", "$reject/$path/${prefix}_$rpm") or plog('ERROR', "ERROR: link of $rpm failed ($!)");
	}
	link("$done/$path/$prefix.youri", "$reject/$path/$prefix.youri");
	
	my ($user) = $prefix =~ /\d{14}\.(\w+)\.\w+\.\d+/;
	if ($user) {
	    my @pkgs = grep { !/src\.rpm$/ } @{$pkg_tree{$prefix}{section}{$section}{rpms}};
	    my $text = join("\n", qq(The upload of the following packages failed:\n), map { "- $_" } @pkgs) . "\n";
	    my $rpms = join(' ', @pkgs, undef);
	    my $to =  get_author_email($user) || "Unknown <$config->{admin}>";
	    $text .= "\nUpload log available in $config->{http_queue}/rejected/$path/$prefix.youri\n";
	    
	    sendmail($to, undef, "Upload failed for $rpms", $text, "Emi the upload bot <$config->{admin}>", 0, $config);
	}
	
	# should delete the files
    }

    # delete the files which should have heen either put in queue or rejected
    unlink(@packages);
    
    # unlink the sources rpm unless some non mandatory arch still need to be done
    my $all_done = 1;
    if (!defined($pkg_tree{$prefix}{section}{$section}{arch}{noarch})) {
	my $arch_list = find { ref($_) eq 'ARRAY' } $config->{arch}, (ref($config->{arch}) eq 'HASH' ? ($config->{arch}{$target}, $config->{arch}{default}) : ());
	my @arch_list = $arch_list ? @$arch_list : keys %{$config->{bot}};
	# If we are here, mandatory arches are done, no need to check them
	my $mandatory_arch = get_mandatory_arch($config, $target);
	foreach my $arch (difference2(@arch_list, $mandatory_arch)) {
	    next if $pkg_tree{$prefix}{section}{$section}{arch}{$arch};
	    $all_done = 0;
	}
    }
    if ($all_done) {
	foreach (@{$pkg_tree{$prefix}{todo}}) {
	    plog('DEBUG', "unlink $todo/$path/${prefix}_$_");
	    unlink("$todo/$path/${prefix}_$_");
	}
    }
}

foreach my $target (keys %targets) {
    foreach my $section (keys %{$targets{$target}}) {
    	my %is_finisher;
	
	foreach (values %{$targets{$target}{$section}{arch_finisher}}) {
	    $is_finisher{$_} = 1;
	}

	foreach my $prefix (@{$targets{$target}{$section}{to_upload}}) {
	    next if $is_finisher{$prefix};
	    upload_prefix_in_section($prefix, $section);
	}

	foreach my $prefix (keys %is_finisher) {
	    upload_prefix_in_section($prefix, $section, 1);
	}

	foreach my $prefix (@{$targets{$target}{$section}{to_upload}}) {
    	    my $path = $pkg_tree{$prefix}{section}{$section}{path};
	    touch("$done/$path/$prefix.upload") unless -f "$reject/$path/$prefix.youri";
        }
    }
}

unlink($pidfile);
exit();