#!/usr/bin/perl # # Copyright (C) 2005 Mandrakesoft # Copyright (C) 2005,2006 Mandriva # # Author: Florent Villard # # 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. # # compare and rebuild packages on different architecture # # TODO # # - use a cache (rpmctl cache for example) to find maintainer # - add icecream compilation support # - add a --group option to compile a set of packages (in progress) # - add a function to update a packages when it obviously need to be recompile # - Maybe call the function from the initial todo list (thus making the # argument ordering important) # - Change the packager tag in the chroot to have the one who submit the package use strict; use RPM4::Header; use Iurt::Config qw(config_usage get_date get_prefix config_init dump_cache_par get_maint get_date check_arch %arch_comp get_package_prefix); use Data::Dumper; use URPM; use Iurt::DKMS; use Iurt::Urpmi; use Iurt::Chroot qw(add_local_user create_temp_chroot remove_chroot clean_all_chroot_tmp clean_unionfs check_build_chroot clean_chroot); use Iurt::Process qw(perform_command clean kill_for_good); use Iurt::Mail qw(sendmail); use Iurt::Util qw(plog_init plog); use File::NCopy qw(copy); # I did not manage to make locks work over the network #use File::lockf; use Mkcd::Commandline qw(parseCommandLine usage); use MDK::Common; use Filesys::Df qw(df); my $program_name = 'iurt2'; my $VERSION = '0.5.21'; # sessing parameters my $sudo = '/usr/bin/sudo'; my $arg = @ARGV; my (@params, %run); $run{program_name} = $program_name; $run{todo} = [ ]; @params = ( # [ "one letter option", "long name option", "number of args (-X means ´at least X´)", "help text", "function to call", "log info"] # # no_rsync, config_help and copy_srpm kept for compatibility reasons # [ "", "$program_name", 0, "[--cache] [--chrooted-urpmi ] [--concurrent-run] [--config foo value] [--warn] [--verbose integer] [--copy-srpm] [--debug] [--distro] [--no-rsync] [--clean user1 user2 user3] [--clean-all] [--shell] [--stop {p|c|i|l|b|a|s}] [--use-system-distrib] [--dir] [--help foo?] [--log filename] [--group] [--unionfs] [--upload [--markrelease] [--source]] [--dir] [--help foo?] [--log filename] [--unionfs] [--status] [--ignore-failure] {--config_help | --dkms {--media } --chroot --arch {i586|x86_64|ppc} --distro {cooker|2006.0|community/2006.0|...} } | --rebuild {cooker|2006.0|community/2006.0|...} {i586|x86_64|ppc|...} {filename1.src.rpm} {filename2.src.rpm} ... {filenamen.src.rpm} }", "$program_name is a perl script to rebuild automatically several rpm in chroot, given a sourcerpm repository, and mail authors or rebuilder when problems occurs.", sub { $arg or usage($program_name, \@params) }, "" ], [ "", "distro", 1, "", "Set the distribution", sub { ($run{distro}) = @_; 1 }, "Setting the distribution" ], [ "", "dkms", [ ["", "dkms", 0, "", "Set the DKMS rebuild mode", sub { my ($tmp, @arg) = @_; $tmp->[0] ||= {}; push @$tmp, @arg; 1 }, "Setting auto mode arguments"], ["k", "kmedia", 1, "", "Media Regexp to limit the kernel search to", sub { my ($tmp, $kmedia) = @_; $tmp->[0]{kmedia} = $kmedia; 1 }, "Limiting rebuild to the kernel in the given media regexp"], ["m", "media", 1, "", "Media Regexp to limit rebuild to", sub { my ($tmp, $media) = @_; $tmp->[0]{media} = $media; 1 }, "Limiting rebuild to the given media regexp"], ], "[options]", "Set the DKMS rebuild mode", sub { my ($opt) = @_; $run{dkms} = $opt; 1 }, "Running a DKMS rebuild run" ], [ "a", "arch", 1, "", "Set the architecture", sub { ($run{my_arch}) = @_; 1 }, "Setting architecture" ], [ "", "cache", 0, "", "Use the global cache file", sub { $run{use_cache} = 1 }, "Activating cache use" ], [ "", "copy-srpm", 0, "", "Copy also the regenerated SRPM", sub { $run{copy_srpm} = 1 }, "Activating the copy_srpm mode" ], [ "", "copy_srpm", 0, "", "Copy also the regenerated SRPM", sub { $run{copy_srpm} = 1 }, "Activating the copy_srpm mode" ], [ "c", "chroot", 0, "", "Check chroot and update it if needed", sub { $run{chroot} = 1 }, "Activating chroot updating" ], [ "", "chrooted-urpmi", 1, "", "Create urpmi media inside the chroot instead of using --root (media prefix is like http:///server.mandriva.com/dis/)", sub { $run{chrooted_urpmi} = shift }, "Activating chroot updating" ], [ "", "clean-all", 0, "", "Clean all remaining chroots for all the users", sub { $run{clean_all} = 1 }, "Activating clean chroot flag" ], [ "", "clean", -1, " ... ", "Clean remaining chroot before runing", sub { $run{clean} = \@_ }, "Activating clean chroot flag" ], [ "", "concurrent-run", 0, "", "Allow several iurt to run on different machines (slower)", sub { $run{concurrent_run} = 1 }, "Activating concurrent run checks" ], [ "d", "dir", -1, "", "Directory where to find packages to rebuild", sub { $run{extra_dir} = \@_; 1 }, "Adding extra source packages directories" ], [ "", "config", 2, " ", "Override a configuration file variable", sub { my ($key, $value) = @_; $run{config}{$key} = $value }, "Overriding configuration variable" ], [ "", "config-help", 0, "", "Explain configuration files keywords", sub { $run{config_usage} = 1 }, "Activating debug mode" ], [ "", "config_help", 0, "", "Explain configuration files keywords", sub { $run{config_usage} = 1 }, "Activating debug mode" ], [ "", "debug", 0, "", "Activate debug mode", sub { $run{debug} = 1 }, "Activating debug mode" ], [ "g", "group", 0, "", "Activate group mode, packages will be compiled as a global set, not as individual packages", sub { $run{group} = 1 }, "Activating the group mode" ], [ "", "ignore-failure", 0, "", "Do not take into account the failure cache, try to recompile all the packages not synchronized", sub { $run{ignore_failure} = 1 }, "Activating the mode ignoring previous failure" ], [ "u", "unionfs", 0, "", "Activate unionfs mode", sub { $run{unionfs} = 1 }, "Activating unionfs mode" ], [ "l", "log", 1, "", "Log file.", sub { $run{log} = pop @_; open $run{LOG}, ">$run{log}" or die "unable to open $run{log}\n"; print *{$run{LOG}}, "command line: @ARGV\n"; 1 }, "Log file" ], [ "m", "media", -1, " ... ", "Media to rebuild", sub { ($run{media}) = @_; 1 }, "Adding a media to rebuild" ], [ "n", "no", 0, "", "Perform all the check but do not compile anything", sub { ($run{no_compile}) = 1 }, "Setting the no compilation flag" ], [ "r", "rebuild", -2, " ... ", "Rebuild the packages, e.g. $program_name -r cooker x86_64 /home/foo/rpm/SRPMS/foo-2.3-12mdv2007.0.src.rpm", sub { $run{rebuild} = 1; $run{distro} = shift @_; $run{my_arch} = shift @_; foreach (@_) { my ($path, $srpm); if (m,(.*/)([^/]*.src.rpm)$, && -f $_) { ($path, $srpm) = ( $1, $2 ) } elsif (m,([^/]*.src.rpm)$, && -f $_) { ($path, $srpm) = ( './', $1 ) } else { die "FATAL $program_name: $_ does not seems to be a SRPM\n" } if (check_arch($_, $run{my_arch})) { plog("force build for $2 (from $1)"); push @{$run{todo}}, [ $path, $srpm, 1 ] } else { print {$run{LOG}} "ERROR $program_name: $_ could not be build on $run{my_arch}, ignored.\n" } } 1 }, "Activating rebuild mode" ], [ "", "upload", [ ["", "upload", 0, "[options]", "Upload the rebuild packages", sub { my ($tmp) = @_; $tmp->[0] ||= {}; 1 }, "Setting upload options"], [ "m", "markrelease", 0, "", "Mark SVN directory when uploading the packages", sub { $run{markrelease} = 1 }, "Adding markrelease repsys option" ], [ "s", "source", 0, "", "Upload the source package as wells", sub { $run{source_upload} = 1 }, "Setting source flag for upload" ], ], "[options]", "Upload the rebuild packages", sub { $run{upload} = 1 }, "Setting the upload flag" ], [ "", "no_rsync", 0, "", "Do not send build log to the distant rsync server", sub { $run{no_rsync} = 1 }, "Setting the no rsync warn flag" ], [ "", "no-rsync", 0, "", "Do not send build log to the distant rsync server", sub { $run{no_rsync} = 1 }, "Setting the no rsync warn flag" ], [ "", "use-system-distrib", 1, "", "Use the current system urpmi configuration", sub { $run{use_system_distrib} = shift; 1 }, "Setting system distrib for urpmi configuration" ], [ "v", "verbose", 1, "", "Give more info messages about what is going on (level from 1 to 10)", sub { $run{verbose} = $_[0]; 1 }, "Setting verbose level" ], [ "w", "warn", 0, "", "Warn maintainer of the packages about problem in the rebuild", sub { $run{warn} = 1 ; 1 }, "Setting warn flag to warn maintainers" ], [ "", "shell", 0, "", "Dump to a shell into the newly created chroot with sudo on rpm, urpmi, urpme and urpmi.addmedia", sub { ($run{shell}) = 1; 1 }, "Setting option to dump to a shell" ], [ "", "stop", 1, "", "Perform rpm -b (p c i l b a s) instead of rpm -ba and then open a shell in the chroot", sub { ($run{stop}) = @_; 1 }, "Setting rpm build option" ], [ "", "status", 1, "", "Send a status mail to the provided mail address", sub { ($run{status_mail}) = @_; 1 }, "Setting status mail option" ], ); open(my $LOG, ">&STDERR"); $run{LOG} = $LOG; print "$program_name version $VERSION\n"; my $todo = parseCommandLine($program_name, \@ARGV, \@params); @ARGV and usage($program_name, \@params, "@ARGV, too many arguments"); plog_init($program_name, $LOG, $run{verbose}); foreach my $t (@$todo) { plog(6, "$t->[2]"); &{$t->[0]}(@{$t->[1]}) or plog("ERROR: $t->[2]"); } $run{distro_tag} = $run{distro}; $run{distro_tag} =~ s,/,-,g; chomp(my $real_arch = `uname -m`); my $HOME = $ENV{HOME}; my $configfile = "$HOME/.iurt.$run{distro_tag}.conf"; plog(2, "loading config file $configfile"); my $config; if (-f $configfile) { $config = do $configfile or die "FATAL $program_name: syntax error in $configfile"; } else { $config = {} } my $urpmi = Iurt::Urpmi->new( run => \%run, config => $config, urpmi_options => "-v --no-verify-rpm --nolock --auto --ignoresize" ); $run{urpmi} = $urpmi; if (!$run{chrooted_urpmi} && $run{group}) { die "FATAL $program_name: option --chrooted-urpmi is mandatory if --group is selected" } my %config_usage = ( admin => { desc => 'Mail of the administrator of packages builds', default => '' }, all_media => { desc => 'List of known media', default => { 'main' => [ '' ], 'contrib' => [ '' ] } }, basesystem_media_root => { desc => 'Name of the media holding basesystem packages', default => sub { my ($config, $run) = @_; "$config->{repository}/$run{distro}/$run{my_arch}/" } }, basesystem_media => { desc => 'Where to find basesystem packages', default => 'main/release' }, basesystem_packages => { desc => 'List of packages needed for the chroot creation', default => [ 'basesystem', 'rpm-build', 'rpm-mandriva-setup-build', 'sudo', 'urpmi' ] }, cache_home => { desc => 'Where to store the cache files', default => "$HOME/.bugs" }, cache_min_size => { desc => 'Minimal size to consider a cache file valid', default => 1000000 }, check_binary_file => { desc => 'Packages rebuild should be checked, however sometime rpm is segfaulting and the test is not correct', default => 0 }, iurt_root_command => { desc => 'Program to run sudo command', default => '/usr/local/bin/iurt_root_command' }, distribution => { desc => 'Name of the packages distribution', default => 'Mandriva Linux' }, home => { desc => 'Home dir', default => $HOME }, install_chroot_binary => { desc => 'Tool used to create initial chroot', default => 'install-chroot-tar.sh' }, local_home => { desc => 'Where to build packages', default => $HOME }, local_upload => { desc => 'Where to store build packages and log', default => '' }, local_spool => { desc => 'To override the directory where all the results are stored', default => '' }, log_size_limit => { desc => 'Maximum authorized size for a log file', default => '100M' }, log_size_date => { desc => 'Number of days log should be kept', default => '30' }, log_url => { desc => 'Where the log can be seen', default => '' }, minimum_package_number => { "Minimum number of packages in a synthesis file to consider it valid", default => 1000 }, max_command_retry => { "Maximum number of retry Iurt will perform for a given command", fault => 20 }, no_mail => { desc => 'Hash table with people mail address where we should not send any mails', default => {} }, packager => { desc => 'Name of the build bot', default => 'Iurt' }, repository => { desc => 'Prefix of the repositories', default => '/mnt/BIG/dis/' }, rsync_to => { desc => 'Server where the result of the builds should be rsynced (name@server:path format)', default => '' }, sendmail => { desc => 'If the bot will send mail reports regarding build', default => 0 }, supported_arch => { desc => 'Table of supported architecture', default => ['i586', 'x86_64'] }, upload => { desc => 'Where to copy build packages', default => "$HOME/uploads/" }, vendor => { desc => 'Name of the packages vendor', default => 'Mandriva' }, ); config_usage() if $run{config_usage}; $run{my_arch} or usage($program_name, \@params, "no architecture given (media $run{media}, run{my_arch} $run{my_arch}, todo @{$run{todo}})"); if (!$arch_comp{$real_arch}{$run{my_arch}}) { die "FATAL $program_name: could not compile $run{my_arch} binaries on a $real_arch" } config_init(\%config_usage, $config, \%run); $config->{upload} .= $run{distro}; $config->{upload} =~ s/community//g; if ($run{distro} ne 'cooker') { if ($run{media} ne 'main') { $config->{upload} .= "/$run{media}" } } elsif ($run{media} eq 'contrib') { $config->{upload} =~ s/cooker/contrib/g; } my $lock = $run{media}; my $local; if (!$lock && $run{chroot}) { $lock = 'chroot'; $local = 1 } if (!$lock && $run{dkms}) { $lock = 'dkms'; $local = 0 } $run{lock} = $lock; # cache file name is needed early to remove the manual lock file if the lock mechanism does not work my $cachefile = "$config->{cache_home}/iurt.$run{distro_tag}.$run{my_arch}.$lock.cache"; $run{cachefile} = $cachefile; if (!$run{debug} && $run{media} || $run{chroot}) { $run{pidfile_home} = "$config->{cache_home}/"; $run{pidfile} = "iurt.$run{distro_tag}.$run{my_arch}.$lock"; check_pid(\%run) } $config->{local_upload} ||= $config->{local_home}; my $local_spool; if ($config->{local_spool}) { $local_spool = $config->{local_spool} } else { $local_spool = "$config->{local_upload}/iurt/$run{distro_tag}/$run{my_arch}/$run{media}/" } plog(5, "using $local_spool as local spooler"); if (!-d "$local_spool/log") { plog(5, "creating local spool $local_spool"); mkdir_p("$local_spool/log") or die "FATAL $program_name: could not create local spool dir $local_spool ($!)" } $run{local_spool} = $local_spool; my $cache; my $clear_cache = 1; if (-f $cachefile && $run{use_cache}) { plog(2, "loading cache file $cachefile"); $cache = do $cachefile or print "FATAL $program_name: could not load cache $cachefile ($!)\n"; if (!$cache) { opendir my $cache_dir, $config->{cache_home}; my $to_load; foreach my $file (readdir $cache_dir) { (my $date) = $file =~ /iurt\.$run{distro_tag}\.$run{my_arch}\.$run{media}\.cache\.tmp\.(\d{8})/ or next; if ($date > $to_load && -s "$config->{cache_home}/$file" > $config->{cache_min_size}) { $to_load = $date; $cachefile = "$config->{cache_home}/$file" } } plog("loading alternate cache file $cachefile"); $cache = do $cachefile or print "FATAL $program_name: could not load cache $cachefile ($!)\n" } $clear_cache = 0 if $cache } if ($clear_cache) { $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} } } $run{cache} = $cache; my (%srpm_version, @wrong_rpm, %provides, %pack_provide, $to_compile, %maint); $to_compile = @{$run{todo}}; $to_compile += check_media(\%run, $cache, $config, \%srpm_version, \@wrong_rpm, \%provides, \%pack_provide, \%maint) if $run{media}; $to_compile += search_packages(1, $cache, \%provides, \%run, \%maint, \%srpm_version, @{$run{extra_dir}}) if $run{extra}; my $dkms; if ($run{dkms}) { $dkms = Iurt::DKMS->new(run => \%run, config => $config); $to_compile += $dkms->search_dkms() } $run{to_compile} = $to_compile; dump_cache_par(\%run); plog(2, "will try to compile $to_compile packages"); my ($fulldate, $daydate) = get_date(); if ($run{use_cache}) { $run{run} = $cache->{run}; $run{run} ||= 1; $cache->{run} = $run{run} + 1 } else { $run{run} = "0.$fulldate" } $run{daydate} = $daydate; plog(5, "using $run{run} as chroot extension"); $run{user} = $ENV{SUDO_USER} || $ENV{USER}; $run{uid} = getpwnam $run{user}; plog(3, "using local user $run{user}, id $run{uid}"); my $luser = $run{user} || 'builder'; check_sudo_access() or die "FATAL $program_name: you need to have sudo access to run $program_name"; my $debug_tag = '_debug' if $run{debug}; $run{debug_tag} = $debug_tag; if ($run{unionfs}) { plog(1, "adding unionfs module"); sudo(\%run, $config, "--modprobe", "unionfs") or $run{unionfs} = 0; if ($run{unionfs}) { $run{unionfs_dir} = "$config->{local_home}/iurt_unionfs$debug_tag/"; remove_chroot(\%run, $run{unionfs_dir}, \&clean_all_unionfs); $run{unionfs_dir} = "$run{unionfs_dir}/$run{user}/"; -d $run{unionfs_dir} or mkdir $run{unionfs_dir} } } my (%done, $wait_limit, $done); $run{done} = \%done; my $home = $config->{local_home}; my $union_id = 1; $run{unionfs_tmp} = $run{unionfs}; my $chroot_name = "chroot_$run{distro_tag}$debug_tag"; my $chroot_tmp = "$config->{local_home}/chroot_tmp"; if (!-d $chroot_tmp) { mkdir $chroot_tmp } else { remove_chroot(\%run, $chroot_tmp, \&clean_all_chroot_tmp, $chroot_name); } $chroot_tmp = "$config->{local_home}/chroot_tmp/$run{user}"; if (!-d $chroot_tmp) { mkdir $chroot_tmp } $chroot_tmp = "$config->{local_home}/chroot_tmp/$run{user}/$chroot_name.$run{run}"; $run{chroot_tmp} = $chroot_tmp; # now exit if there is nothing to do and it was just a cleaning pass if ($run{no_compile} || !@{$run{todo}} && !$run{debug} && !$run{shell} && !$run{rebuild}) { send_status_mail(\%run, $config, $cache) if ($run{status_mail}); plog("no package to compile :("); unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile}; exit } my $chroot = "$config->{local_home}/$chroot_name"; $run{chroot_path} = $chroot; my $chroot_tar = "$chroot.$run{my_arch}.tar.gz"; $run{chroot_tar} = $chroot_tar; if ($run{chroot} || !-d "$chroot/dev") { check_build_chroot($chroot, $chroot_tar, \%run, $config) or die "FATAL $program_name: could not prepare initial chroot" } plog("running with pid $$"); $run{prefix} = get_prefix($luser); my $df = df $home; if ($df->{per} >= 99) { die "FATAL $program_name: not enough space on the filesystem, only $df->{bavail} KB on $home, full at $df->{per}%" } if ($run{shell}) { ($union_id, my $chroot_tmp) = create_temp_chroot(\%run, $config, $cache, $union_id, $chroot_tmp, $chroot_tar) or die "FATAL $program_name: could not create temporary chroot"; add_local_user($chroot_tmp, \%run, $config, $luser, $run{uid}) or die "FATAL $program_name: could not add local user"; #$urpmi->set_command($chroot_tmp); $urpmi->urpmi_command($chroot_tmp, $luser); $urpmi->install_packages('chroot', $chroot_tmp, $local_spool, \%pack_provide, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run{my_arch}", { check => 1, maintainer => $config->{admin} }, 'urpmi', 'sudo') or die "FATAL $program_name: could not add urpmi and sudo in the chroot"; add_sudoers(\%run, $chroot_tmp, $luser); if ($run{shell}) { plog("dumping to a chrooted shell into $chroot_tmp"); exec "$sudo chroot $chroot_tmp /bin/su $luser -c \"PS1='[\[\033[01;33m\]iurt $run{distro} \[\033[00m\]\u@\h \W]\$ ' bash\""; die "FATAL $program_name: could not exec chroot to $chroot_tmp ($!)" } } # perform some cleaning before running to have some more space, rsync to the server too in case previous iurt crashed if ($config->{rsync_to} && !$run{no_rsync}) { # remove some old and very big log files not to saturate the server system(qq|find $local_spool/log/ -name "*.log" \\( -size +$config->{log_size_limit} -or -mtime +$config->{log_size_date} \\) -exec rm -f {} \\;|); system("rsync --delete -alHPe 'ssh -xc arcfour' $local_spool/log/ $config->{rsync_to}/$run{distro_tag}/$run{my_arch}/$run{media}/log/"); } if ($run{dkms} && $run{dkms_todo}) { $done += $dkms->dkms_compile($local_spool, $done); } # The next loop should be moved in a module someday my $s = sub { if ($run{main}) { plog("dumping cache..."); dump_cache_par(\%run); $Data::Dumper::Indent = 0; $Data::Dumper::Terse = 1; plog(6, "Running environment:\n", Data::Dumper->Dump([\%run]), "\n"); plog(0, "Configuration:\n", Data::Dumper->Dump([$config]),"\n"); } exit }; $SIG{TERM} = $s; $SIG{INT} = $s; $run{main} = 1; my $rebuild; $run{group} = 0 if @{$run{todo}} == 1; if ($run{group}) { $rebuild = 1; $urpmi->set_local_media($local_spool); $urpmi->order_packages($union_id, \%provides, $luser) or die "FATAL $program_name: could not order packages"; } # # The build loop # do { $rebuild = 0; foreach (my $i ; $i < @{$run{todo}}; $i++) { my ($dir, $srpm, $status) = @{$run{todo}[$i]}; # Set argv[0] (in the C sense) to something we can easily spot and # understand when running ps --claudio $0 = "Iurt: $run{distro_tag} $run{my_arch} $run{media} $srpm"; $status or next; $done{$srpm} and next; $done{$srpm} = 1; check_version($srpm, \%srpm_version) or next; if ($run{debug}) { $run{debug}++ == 2 and exit } $done++; plog("packages $srpm [$done/$to_compile]"); # FIXME unfortunately urpmi stalls quite often my $retry = 0; # # current rpm is sometime segfaulting, and iurt is them blocked and cannot # # $cache->{failure}{$srpm} = 1; # dump_cache(\%run); retry: $urpmi->clean_urpmi_process($chroot_tmp); my ($u_id, $chroot_tmp) = create_temp_chroot(\%run, $config, $cache, $union_id, $chroot_tmp, $chroot_tar, $srpm) or next; $union_id = $u_id; $urpmi->urpmi_command($chroot_tmp, $luser); my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next; my ($maintainer, $cc); if (!$run{warn}) { ($maintainer) = get_maint(\%run, $srpm); $cc = "$maint{$srpm}";#, maintainers\@mandriva.com"; chomp $maintainer; if (!$maintainer || $maintainer eq 'NOT_FOUND') { $maintainer = $cc; #$cc = 'maintainers@mandriva.com' } } #($maintainer, $cc) = ($config->{admin},''); plog(1, "adding local user $luser into $chroot_tmp..."); add_local_user($chroot_tmp, \%run, $config, $luser, $run{uid}) or next; my $old_srpm = $srpm; my ($ret, $srpm, $spec) = $urpmi->recreate_srpm(\%run, $config, $chroot_tmp, $dir, $srpm, $luser, $retry); if ($ret == -1) { $retry = 1; goto retry } elsif (!$ret) { next } # only create the log dir for the new srpm mkdir "$local_spool/log/$srpm"; plog(1, "installing build dependencies of $srpm..."); my $path_srpm = "$chroot_tmp/home/$luser/rpm/SRPMS/"; # # on x86_64 the rpm database is getting corrupted and sometimes rpm do not found anymore # installed packages, retrying several time to be sure something is really broken my $ok = $urpmi->install_packages($srpm, $chroot_tmp, $local_spool, \%pack_provide, 'install_deps', "[REBUILD] install of build dependencies of $srpm failed on $run{my_arch}", { maintainer => $maintainer }, "$path_srpm/$srpm"); if (!$ok) { $run{status}{$srpm} ||= 'install_deps_failure'; next; } # try to workarround the rpm -qa db4 error(2) from dbcursor->c_get: No such file or directory # system("sudo chroot $chroot_tmp rm -rf /var/lib/rpm/__db* &> /dev/null"); system("$sudo chroot $chroot_tmp rpm --rebuilddb &> /dev/null"); perform_command("$sudo chroot $chroot_tmp rpm -qa", \%run, $config, $cache, hash => "rpm_qa_$srpm", timeout => 60, debug_mail => $run{debug}, log => "$local_spool/log/$srpm/"); # or next; As this failed quite often, do not stop plog(1, "Compiling $srpm"); my $command = "rpm --rebuild /home/$luser/rpm/SRPMS/$srpm"; if ($run{stop}) { $urpmi->install_packages('chroot', $chroot_tmp, $local_spool, \%pack_provide, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run{my_arch}", { check => 1, maintainer => $config->{admin} }, 'urpmi', 'sudo'); add_sudoers(\%run, $chroot_tmp, $luser); $command = "rpm -b$run{stop} /home/$luser/rpm/SPECS/$spec" } if (!perform_command(qq{TMP=/home/$luser/tmp/ $sudo chroot $chroot_tmp /bin/su $luser -c "$command"}, \%run, $config, $cache, mail => $maintainer, error => "[REBUILD] $srpm from $run{distro_tag} does not build correctly on $run{my_arch}", hash => "build_$srpm", timeout => 18000, srpm => $srpm, debug_mail => $run{debug}, cc => $cc, log => "$local_spool/log/$srpm/", error_regexp => 'rror.*ailed|Bad exit status|RPM build error', callback => sub { my ($opt, $output) = @_; if ($run{stop}) { plog("dumping to a chrooted shell into $chroot_tmp (pid $$)"); # exec does not work because it seems stdin and out are shared between children system("$sudo chroot $chroot_tmp /bin/su $luser -c \"PS1='[\[\033[01;33m\]iurt $run{distro} \[\033[00m\]\u@\h \W]\$ ' bash\""); exit } plog(5, "calling callback for $opt->{hash}"); if ($run{unionfs_tmp} && $output =~ /no space left on device/i) { plog("ERROR: running out of space to compile $srpm in unionfs mode, will recompile it in normal mode"); $cache->{no_unionfs}{$srpm} = 1; return 1 } elsif ($run{unionfs_tmp} && $output =~ m,$home,) { plog("ERROR: seems like building $srpm needs to access /proc/self/exe, which is broken with unionfs, will try to recompile it in non unionfs mode"); $cache->{no_unionfs}{$srpm} = 1; return 1 } elsif ($output =~ /bin\/ld: cannot find -l(\S*)|configure.*error.* (?:-l([^\s]+)|([^\s]+) includes)/) { my $missing = $1; my @rpm = find_provides(\%run, \%pack_provide, $missing); plog(5, "likely @rpm ($missing-devel) needed to rebuilt $srpm is not in build_requires"); if ($maintainer ne 'NOT_FOUND') { $opt->{mail} = $maintainer; #$opt->{mail} .= ", other_maint"; } if (!$opt->{mail}) { $opt->{mail} = $config->{admin}; } if (@rpm > 1) { $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] one of @rpm ($missing-devel), needed to build $srpm, is not in buildrequires"; } elsif (@rpm == 1) { $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] @rpm ($missing-devel), needed to build $srpm, is not in buildrequires"; } else { $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] $missing-devel, needed to build $srpm, is not in buildrequires"; } $cache->{buildrequires}{$srpm}{$missing} = \@rpm; return } 1 }, freq => 1)) { # FIXME # The simple algo used here is : # try to compile it with unionfs, if it runs out of space, compile it without the next time # # This could be improved in keeping this srpm name for future version, but if we compile it # on a new machine with more ram, or if next version compiles just fine with unionfs, we will # loose the unionfs advantage. # # Maybe the right thing to do would be to first try to increase the tmpfs size (more than 50 % of the # physical RAM), but this will lead to more swap usage, and slower compilation (and lost of the unionfs # plus). Or to keep the faulty package a unionfs exception for some time, to save some more extra builds. # if (!glob "$chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm") { if ($run{unionfs_tmp} && $cache->{no_unionfs}{$srpm}) { goto retry } $cache->{failure}{$srpm} = 1; $run{status}{$srpm} = 'build_failure'; # 20060615 dump_cache_par(\%run); dump_status($local_spool, \%run); next } } # do some cleaning if the compilation is successful delete $cache->{needed}{$srpm} if defined $cache->{needed}{$srpm}; delete $cache->{buildrequires}{$srpm} if defined $cache->{buildrequires}{$srpm}; my $path_rpm = $run{chrooted_urpmi} ? "/home/$luser/rpm/RPMS/" : "$chroot_tmp/home/$luser/rpm/RPMS/"; # FIXME It seems the glob is not correctly expanded any more, so listing the directory content to do so opendir my $binfh, "$chroot_tmp/home/$luser/rpm/RPMS/"; my @packages; foreach my $bindir (readdir $binfh) { -d "$chroot_tmp/home/$luser/rpm/RPMS/$bindir" or next; opendir my $rpmfh, "$chroot_tmp/home/$luser/rpm/RPMS/$bindir"; push @packages, map { "$chroot_tmp/home/$luser/rpm/RPMS/$bindir/$_" } grep { !/src\.rpm$/ && /\.rpm$/ } readdir $rpmfh; } # 20060810 warly We should fail here, but rpm is currently segfaulting when trying to install packages if ($config->{check_binary_file}) { $urpmi->install_packages($srpm, $chroot_tmp, $local_spool, \%pack_provide, 'binary_test', "[REBUILD] binaries packages generated from $srpm do not install correctly", { maintainer => $maintainer } ,@packages) or next; } else { my $successfile = "$local_spool/log/$srpm/binary_test_$srpm-1.log"; open my $f, ">$successfile"; print $f "$srpm build ok"; close $f } $run{status}{$srpm} = 'ok'; delete $cache->{failure}{$srpm} if defined $cache->{failure}{$srpm}; if ($run{debug}) { plog("debug mode, skip other packages"); exit } elsif ($run{group}) { $rebuild = 1; plog("group mode, keep packages for local media"); $run{done}{$srpm} = $done; $urpmi->add_to_local_media($chroot_tmp, $srpm, $luser); } else { plog("build successful, copying packages to $local_spool."); system("cp $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm $local_spool &>/dev/null") and plog("ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpm/RPMS/ to $local_spool ($!)"); if ($run{copy_srpm}) { # replace the old srpm unlink "$local_spool/$old_srpm"; system("cp $chroot_tmp/home/$luser/rpm/SRPMS/$srpm $local_spool &>/dev/null") and plog("ERROR: could not copy $srpm from $chroot_tmp/home/$luser/rpm/SRPMS/ to $local_spool ($!)"); } process_queue($config, \%run, \@wrong_rpm, 1) } # dymp_cache each time so that concurrent process can get updated dump_cache_par(\%run) if $run{concurrent_run}; } if ($run{group} && $rebuild) { $urpmi->order_packages($union_id, $luser) } } while ($rebuild); clean_chroot($chroot_tmp, $chroot_tar, \%run, $config, 1) if !$run{debug}; plog(1, "reprocess generated packages queue"); process_queue($config, \%run, \@wrong_rpm); dump_cache_par(\%run); plog("ERROR: RPM with a wrong SRPM name") if @wrong_rpm; if (@wrong_rpm && open my $file, ">$local_spool/log/wrong_srpm_names.log") { foreach (@wrong_rpm) { print $file "$_->[1] -> $_->[0] (", $cache->{rpm_srpm}{$_->[1]},")\n"; } close $file } dump_status($local_spool, \%run); send_status_mail(\%run, $config, $cache) if ($run{status_mail}); if ($config->{rsync_to} && !$run{no_rsync}) { # remove some old and very big log files not to saturate the server system(qq|find $local_spool/log/ -name "*.log" \\( -size +$config->{log_size_limit} -or -mtime +$config->{log_size_date} \\) -exec rm -f {} \\;|); system("rsync --delete -alHPe 'ssh -xc arcfour' $local_spool/log/ $config->{rsync_to}/$run{distro_tag}/$run{my_arch}/$run{media}/log/"); } # one last try to clean plog(1, "try to clean remaining unionfs"); if ($run{unionfs}) { my ($dir) = $run{unionfs_dir} =~ /(.*)\/[^\/]+\/?/; remove_chroot(\%run, $dir, \&clean_all_unionfs) } unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile}; exit; # # Subroutines # sub clean_all_unionfs { my ($run, $unionfs_dir) = @_; plog(2, "Cleaning old unionfs remaining dir in $unionfs_dir"); my $dir; if (!opendir $dir, $unionfs_dir) { plog(0, "FATAL $program_name: could not open $unionfs_dir ($!)"); return; } foreach (readdir $dir) { /unionfs\.((?:0\.)?\d+)\.(\d*)$/ or next; clean_unionfs($unionfs_dir, \%run, $1, $2); } closedir $dir } sub check_needed { my ($srpm, $cache, $provides) = @_; if (!defined $cache->{needed}{$srpm} && !ref $cache->{needed}{$srpm}) { return 1 } my $ok = 1; # migrate old cache format my $ent = $cache->{needed}{$srpm}; if (ref $ent eq 'ARRAY') { my $table = $ent; $cache->{needed}{$srpm} = {}; foreach my $t (@$table) { my ($missing, $version, $maint) = @$t; $cache->{needed}{$srpm}{$missing} = { version => $version, maint => $maint } } $ent = $cache->{needed}{$srpm} } foreach my $name (keys %$ent) { my ($package, $version, $maint) = @{$ent->{$name}}{'package', 'version','maint'}; # if packages does not exist anymore, it may have been rebuild, then try to recompute the build dependencies last if $package && !$provides->{$package}; my ($p_version) = $provides->{$name}; if ($p_version) { next if $version == $p_version; next if URPM::ranges_overlap($version, $p_version) } $ok = 0; if ($version) { $ent->{$name}{version} = $version; } my $v ||= $version; if ($package) { plog("ERROR: $srpm needs package $package which requires missing $name $v to be compiled."); } else { plog("ERROR: $srpm needs $name $v to be compiled."); } # try to recompile it once in a while last if $cache->{warning}{"install_deps_$srpm"}{$maint}++ % 72; return 1 } delete $cache->{needed}{$srpm} if $ok; $ok } sub process_queue { my ($config, $run, $wrong_rpm, $quiet) = @_; return if !$run->{upload} && $quiet; my $dir = "$config->{local_upload}/iurt/$run->{distro_tag}/$run->{my_arch}/$run->{media}/"; opendir my $rpmdir, $dir or return; my $urpmi = $run->{urpmi}; foreach my $rpm (readdir $rpmdir) { my ($rarch, $srpm) = $urpmi->update_srpm($dir, $rpm, $wrong_rpm); $rarch or next; plog("$rpm"); next if !$run->{upload}; # recheck if the package has not been uploaded in the meantime my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/"; if (! -f "$rpms_dir/$rpm") { my $err = system('/usr/bin/scp',"$dir/$rpm", $config->{upload} . "/$config->{extra_subdir}/RPMS/"); # try to keep the opportunity to prevent disk full if ($err){ plog("ERROR: process_queue: cannot copy $dir/$rpm to ", $config->{upload}, "/$config->{extra_subdir}/RPMS/ ($!)"); next } } if ($run->{upload_source}) { } unlink "$dir/$rpm"; $cache->{queue}{$srpm} = 1 } closedir $rpmdir; } sub check_version { my ($srpm, $srpm_version) = @_; my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm/; if (URPM::ranges_overlap("= $srpm",">= $srpm_version->{$srpm_name}")) { $srpm_version->{$srpm_name} = $srpm; return 1 } 0 } sub check_pid { my ($run, $local) = @_; my $hostname = `hostname`; chomp $hostname; my $pidfile = $run->{pidfile}; my $lockfile = "$run->{pidfile_home}/$pidfile.$hostname.pid.lock"; plog("trying to lock $lockfile"); open my $lock, ">$lockfile"; my $lock_ok; # lockf seems not to work, try to workarround, but this start to create lock on the lock for the lock of the file. my $status = 1; #File::lockf::lock($lock); if (!$status) { $lock_ok = 1; } else { plog("ERROR: could not lock pid file (status $status $!)"); if (! -f "$lockfile.2") { plog("using $lockfile.2 as lock file"); open my $lock2, ">$lockfile.2" or die "FATAL $program_name: could not open lock file $lockfile.2"; print $lock2 $$; close $lock2; } } if (!$run->{concurrent_run} && !$local) { opendir my $dir, $run->{pidfile_home}; foreach my $f (readdir $dir) { my ($pid_host) = $f =~ /$pidfile\.pid\.(.*)\.pid$/ or next; if ($pid_host ne $hostname) { my $pf = "$run->{pidfile_home}/$f"; open my $test_PID, $pf; my $pid = <$test_PID>; my (@stat) = stat $pf; my $time = $stat[9]; my $diff = time - $time; my $msg = "$program_name: an other iurt is running for $run->{my_arch} on $pid_host, pid $pid, since $diff seconds"; if ($diff < 36000) { plog("$msg\n"); exit } else { plog("$msg, ignoring it"); } } } } $run->{pidfile} .= ".$hostname.pid"; $pidfile = "$run->{pidfile_home}/$run->{pidfile}"; if (-f $pidfile) { my (@stat) = stat $pidfile; open my $test_PID, $pidfile; my $pid = <$test_PID>; close $test_PID; if (!$pid) { plog("ERROR: invalid pidfile ($pid), should be "); unlink $pidfile } if ($pid && getpgrp $pid != -1) { my $time = $stat[9]; my $state = `ps h -o state $pid`; chomp $state; if ($time < time - 36000 || $state eq 'Z') { plog("an other iurt pid $pid is running for a very long time or is zombie, killing it"); my $i; while ($i < 5 && getpgrp $pid != -1) { kill_for_good($pid); $i++; sleep 1 } } else { plog("an other iurt is running for $run->{my_arch}, pid $pid, since ",time - $time," seconds"); exit } } else { plog("a previous iurt for $run->{my_arch} seems dead, cleaning."); unlink $pidfile } } plog("setting $pidfile pid lock"); open my $PID, ">$pidfile" or die "FATAL $program_name: could not open pidfile $pidfile for writing"; print $PID $$; close $PID; if ($lock_ok) { File::lockf::ulock($lock); } else { unlink "$lockfile.2" } close $lock; unlink $lockfile } sub check_media { my ($run, $cache, $config, $srpm_version, $wrong_rpm, $provides, $pack_provide, $maint) = @_; # We could rely on only parsing the synthesis, hoping that they are correct, however this scan is very fast, so... foreach my $subdir (@{$config->{all_media}{$run->{media}}}) { my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/$subdir/"; plog("checking current packages in $rpms_dir"); opendir my $rpmdir, $rpms_dir or die "Could not open $rpms_dir: $!"; my $urpmi = $run->{urpmi}; foreach my $rpm (readdir $rpmdir) { my ($rarch, $srpm) = $urpmi->update_srpm($rpms_dir, $rpm, $wrong_rpm); $rarch or next; $cache->{queue}{$srpm} = 1; $run{status}{$srpm} = 'ok'; check_version($srpm, $srpm_version) } closedir $rpmdir; } foreach my $m (keys %{$config->{all_media}}) { foreach my $subdir (@{$config->{all_media}{$m}}) { my $synthesis_file = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$m/$subdir/media_info/synthesis.hdlist.cz"; if (-f $synthesis_file) { plog("Parsing $synthesis_file"); if (open my $syn, "zcat $synthesis_file |") { my @prov; my $nb; while (<$syn>) { if (/^\@provides@(.*)/) { foreach my $p (split '@', $1) { $p =~ /([^[]+)(?:\[(.*)\])?/g; push @prov, $1; $provides->{$1} = $2 || 1 } } elsif (/\@info\@([^@]+)@/) { $nb++; my $p = $1; my ($name) = $p =~ /(.*)-[^-]+-[^-]+\..*$/; $provides->{$p} = 1; foreach (@prov) { $pack_provide->{$_} = $name } @prov = () } } $nb < $config->{minimum_package_number} and die "FATAL $program_name: synthesis files seems corrupted, only $nb packages found." } else { die "FATAL $program_name: Could not open $synthesis_file\n"; } } } } #" my $nb; foreach my $subdir (@{$config->{all_media}{$run->{media}}}) { $nb += search_packages(0, $cache, $provides, $run, $maint, $srpm_version, "$config->{repository}/$run->{distro}/SRPMS/$run->{media}/$subdir/") } $nb } sub search_packages { my ($clean, $cache, $provides, $run, $maint, $srpm_version, @dir) = @_; my ($to_compile, %rep, %done_rpm); plog("iurt search_package: @dir"); foreach my $dir (@dir) { plog("checking SRPMS dir $dir"); opendir my $rpmdir, $dir or next; foreach my $srpm (readdir $rpmdir) { # this is for the output of the new svn system if ($srpm =~ /^\@\d+:(.*)/) { link "$dir/$srpm", "$dir/$1"; # unlink "$dir/$srpm"; $srpm = $1 } $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next; $run->{status}{$srpm} ||= 0; if ($config->{unwanted_packages} && $srpm =~ /$config->{unwanted_packages}/) { next } my $ok = 1; if (check_version($srpm, $srpm_version)) { if (!$run->{ignore_failure} && defined $cache->{failure}{$srpm}) { $run->{status}{$srpm} = 'build_failure'; next } my $check_needed = check_needed($srpm, $cache, $provides); $run->{status}{$srpm} = 'missing_buildrequires' if !$check_needed; -f "$dir/$srpm" or next; if (!$cache->{queue}{$srpm} && $check_needed) { if (!check_arch("$dir/$srpm", $run{my_arch})) { $run->{status}{$srpm} = 'not_on_this_arch'; next } my $hdr = RPM4::Header->new("$dir/$srpm"); my $changelog = $hdr->queryformat("%{CHANGELOGNAME}"); my ($mail) = $changelog =~ /<(.*@.*)>/; $maint{$srpm} = $mail; print "$program_name: will try to compile $srpm\n"; $to_compile++; push @{$run->{todo}}, [ $dir , $srpm, 1 ] } foreach my $arch (@{$config->{supported_arch}}) { $ok &&= $cache->{queue}{$srpm} } } if ($clean && ($rep{$srpm} || $ok)) { print "$program_name: cleaning $dir/$srpm\n"; unlink "$dir/build/$srpm"; unlink "$dir/$srpm" } $rep{$srpm} = 1 } closedir $rpmdir } $to_compile } sub add_sudoers { my ($run, $chroot, $user) = @_; my $file = "$chroot/etc/sudoers"; my $f; if (!open $f, qq{| $sudo sh -c "cat > $file"}) { plog("ERROR: could not open $file ($!)"); return 0 } print $f qq{Cmnd_Alias RPM=/bin/rpm,/usr/sbin/urpmi,/usr/sbin/urpme,/usr/sbin/urpmi.addmedia,/usr/sbin/urpmi.update,/usr/sbin/urpmi.removemedia root ALL=(ALL) ALL $user ALL=(ALL) NOPASSWD:RPM }; close $f; plog("adding sudo for /bin/rpm, /usr/sbin/urpmi and /usr/sbin/urpme"); -f $file or return 0; 1 } sub dump_status { my ($local_spool, $run) = @_; my $media = $run->{media} ? "$run->{media}." : ""; if (open my $file, ">$local_spool/log/status.${media}log") { foreach my $srpm (sort keys %{$run->{status}}) { print $file "$srpm: "; if ($run{status}->{$srpm}) { print $file $run->{status}{$srpm} } else { print $file "unknown" } print $file "\n" } close $file } } sub send_status_mail { my ($run, $config, $cache) = @_; print "iurt compilation status\n"; my %output; foreach my $rpm (keys %{$run->{status}}) { next if $run->{status}{$rpm} =~ /ok|not_on_this_arch/; if ($run->{status}{$rpm} eq 'missing_buildrequires') { foreach my $missing (keys %{$cache->{needed}{$rpm}}) { my $h = $cache->{needed}{$rpm}{$missing}; my $maint = $h->{maint} || 'Other'; my $package = $h->{package}; if ($package) { push @{$output{missing}{$maint}{$package}{$missing}{$h->{version}}}, $rpm } else { $output{missing}{$maint}{$rpm}{$missing}{$h->{version}} = 1 } } } elsif ($run->{status}{$rpm} eq 'build_failure') { my ($maint) = get_maint($run, $rpm); if ($cache->{buildrequires}{$rpm}) { push @{$output{buildrequires}{$maint}}, $rpm } else { push @{$output{build}{$maint}}, $rpm } } elsif (!$run->{status}{$rpm}) { # need to find something more usefull to do at that point next } } my $text = "*** Missing buildrequires tag in specfile ***\n"; foreach my $maint (keys %{$output{buildrequires}}) { $text .= "\n$maint\n"; foreach my $pack (keys %{$output{missing}{$maint}}) { foreach my $missing (keys %{$cache->{buildrequires}{$pack}}) { my $rpms = $cache->{buildrequires}{$pack}{$missing}; if (@$rpms) { $text .= " $pack should have a buildrequires on @$rpms (for $missing-devel)\n" } else { $text .= " $pack should have a buildrequires for $missing-devel\n" } } } } my $text = "*** Missing dependencies ***\n"; foreach my $maint (keys %{$output{missing}}) { $text .= "\n$maint\n"; foreach my $pack (keys %{$output{missing}{$maint}}) { foreach my $missing (%{$output{missing}{$maint}{$pack}}) { my $h = $output{missing}{$maint}{$pack}{$missing}; foreach my $version (keys %$h) { if (ref $h->{$version}) { $text .= " $pack should be recompile because\n $missing ". ($version ? "$version " : ''). "is not provided anymore\n"; $text .= " to compile ". join("\n ", @{$h->{$version}}). "\n" } else { $text .= " $pack needs $missing ". ($version ? "$version " : ''). "\n"; } } } } } $text .= "\n*** Build failure ***\n"; foreach my $maint (keys %{$output{build}}) { $text .= "\n$maint\n"; foreach my $rpm (@{$output{build}{$maint}}) { $text .= " $rpm (see $config->{log_url}/$run{distro_tag}/$run{my_arch}/$run->{media}/log/$rpm/)\n" } } print "$text\n"; sendmail($run->{status_mail}, '' , "Iurt report for $run->{my_arch}/$run->{media}", "$text", "Iurt the rebuild bot <$config->{admin}>", 0) } sub find_provides { my ($run, $pack_provide, $p) = @_; my @rpm; foreach my $provides (keys %{pack_provide}) { if ($provides =~ /$p/ && $provides =~ /devel/) { push @rpm, $pack_provide->{$provides}; } } @rpm } sub check_sudo_access { open my $right, "$sudo -l |"; return 1 if ! $<; while(<$right>) { /\(ALL\)\s+NOPASSWD:\s+ALL/ and return 1 } 0 }