diff options
| -rwxr-xr-x | emi | 2 | ||||
| -rw-r--r-- | lib/Iurt/File.pm | 208 | ||||
| -rwxr-xr-x | lib/Iurt/Ulri.pm | 10 | ||||
| -rwxr-xr-x | ulri | 11 |
4 files changed, 17 insertions, 214 deletions
@@ -32,7 +32,7 @@ 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(get_upload_tree_state); +use Iurt::Queue qw(get_upload_tree_state); use Iurt::Util qw(plog_init plog); use Iurt::Emi qw(find_prefixes_ready_to_upload upload_prefix_in_media); use Data::Dumper; diff --git a/lib/Iurt/File.pm b/lib/Iurt/File.pm index 33be6a1..7f28628 100644 --- a/lib/Iurt/File.pm +++ b/lib/Iurt/File.pm @@ -9,208 +9,26 @@ use MDK::Common qw(cat_ find member partition); use strict; our @EXPORT = qw( - get_upload_tree_state - cleanup_failed_build + create_file + check_file_timeout + read_line ); -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 cleanup_failed_build { - my ($todo_dir, $done_dir, $fail_dir, $prefix, $ent, $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) { - # keep rpms for other architectures - $ent->{rpms} = $kept_rpms; - return; - } - - # abort all remaining builds - 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; - } - } +sub create_file { + my $file = shift; + my @contents = @_; - 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/"); - } - } + open my $FILE, ">$file" or die "FATAL: can't open $file for writing"; + print $FILE "@contents"; } -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, $arch, $bot, $host, $date, $pid) = ($1, $2, $3, $4, $5, $6); - - # Set path here too has we may have a lock without the src.rpm - $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s"; - - $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"); - $pkg_tree{$prefix}{media}{$media}{arch}{noarch} = 1; - $arch =~ s/-.*//; - } - - $pkg_tree{$prefix}{media}{$media}{arch}{$arch} = 1; - - my $time = read_line("$todo/$f/$m/$s/$r"); - $time = (split ' ', $time)[2]; - push @{$pkg_tree{$prefix}{media}{$media}{bot}}, { - bot => $bot, - host => $host, - date => $date, - pid => $pid, - 'arch' => $arch, - 'time' => $time - }; - } - - 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; - } - } - - 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}{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}{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; - } 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; - } - } - } - } +sub check_file_timeout { + my ($file, $time) = @_; - apply_to_upload_tree($done, \&done_func); - apply_to_upload_tree($todo, \&todo_func); + my $i = 0; + while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ } - return %pkg_tree; + $i == $time; } sub read_line { diff --git a/lib/Iurt/Ulri.pm b/lib/Iurt/Ulri.pm index 4140678..0f83897 100755 --- a/lib/Iurt/Ulri.pm +++ b/lib/Iurt/Ulri.pm @@ -4,6 +4,7 @@ use base qw(Exporter); use File::Path qw(make_path); use File::Temp qw(mktemp); use Iurt::Config qw(get_author_email); +use Iurt::File qw(check_file_timeout); use Iurt::Util qw(plog ssh_setup ssh sput); use strict; @@ -122,15 +123,6 @@ sub build_package { return $pid; } -sub check_file_timeout { - my ($file, $time) = @_; - - my $i = 0; - while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ } - - $i == $time; -} - sub exclude_machine { my ($config, $host) = @_; plog('INFO', "Excluding build host $host"); @@ -34,8 +34,9 @@ use strict; use MDK::Common qw(any cat_ if_ find); use Iurt::Config qw(config_usage get_date config_init get_author_email check_arch check_noarch); +use Iurt::File qw(create_file); use Iurt::Process qw(check_pid); -use Iurt::File qw(cleanup_failed_build get_upload_tree_state); +use Iurt::Queue qw(cleanup_failed_build get_upload_tree_state); use Iurt::Mail qw(sendmail); use Iurt::Util qw(plog_init plog ssh_setup ssh sout sget sput); use Iurt::Ulri qw(build_package warn_about_failure); @@ -577,14 +578,6 @@ plog('INFO', "jobs in queue:", %to_compile ? unlink $pidfile; exec "emi" if $something_finished; -sub create_file { - my $file = shift; - my @contents = @_; - - open my $FILE, ">$file" or die "FATAL: can't open $file for writing"; - print $FILE "@contents"; -} - __END__ # ulri ends here |