- add concurrent-run option to run several instance and merge cache

- add support of urpmi --use-distrib to compile on other version than the system one
- add support of function in configuration for more complex default values
- create a pidfile including other hosts too
- improve dump_cache to support concurrent run (not really tested yet)
- fork to monitor log file size and limit it

1 files changed, 94 insertions, 73 deletions

diff --git a/iurt2 b/iurt2
index e701a55..95225f7 100755
--- a/iurt2
+++ b/iurt2
@@ -55,7 +55,7 @@ $run{todo} = [ ];
     sub { ($run{my_arch}) = @_; 1 }, "Setting architecture" ],
     [ "", "cache", 0, "", 
     "Use the global cache file",
-    sub { $run{cache} = 1 }, "Activating cache use" ],
+    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" ],
@@ -250,9 +250,9 @@ if ($run{chroot}) {
 my $cachefile = "$config->{cache_home}/iurt.$run{distro_tag}.$run{my_arch}.cache";
 $run{cachefile} = $cachefile;
 my $cache;
-if (-f $cachefile && $run{cache}) {
+if (-f $cachefile && $run{use_cache}) {
     print {$run{LOG}} "iurt: loading cache file $cachefile\n" if $run{verbose} > 1;
-    $cache = do $cachefile
+    $cache = do $cachefile or die "FATAL iurt: could not load cache $cachefile ($!)\n"
 } else {
     $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} }
 }
@@ -274,14 +274,16 @@ print {$run{LOG}} "iurt: will try to compile $to_compile packages\n" if $run{ver
 
 exit if !$run{rebuild};
 
-if ($run{cache}) {
-    $run{run} = ++$cache->{run} 
+if ($run{use_cache}) {
+    $run{run} = $cache->{run};
+    $cache->{run}++
 } else {
     my ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time());
     $year += 1900;
     my $fulldate = sprintf "%4d%02d%02d%02d%02d%02d", $year, $mon+1, $mday, $hour, $min, $sec;
     $run{run} = "0.$fulldate"
 }
+print {$run{LOG}} "iurt: using $run{run} as chroot extension\n" if $run{verbose} > 4;
 
 $config->{local_upload} ||= $config->{local_home};
 my $local_spool = "$config->{local_upload}/iurt/$run{distro_tag}/$run{my_arch}";
@@ -307,16 +309,19 @@ if ($run{unionfs}) {
 }
 
 my $s = sub { 
-    print {$run{LOG}} "iurt: dumping cache...\n"; 
-    dump_cache(\%run);
-    $Data::Dumper::Indent = 0;
-    $Data::Dumper::Terse = 1;
-    print {$run{LOG}} "Running environment:\n", Data::Dumper->Dump([\%run]), "\n\n"; 
-    print {$run{LOG}} "Configuration:\n",Data::Dumper->Dump([$config]),"\n\n";
+    if ($run{main}) {
+	print {$run{LOG}} "iurt: dumping cache...\n"; 
+	dump_cache(\%run);
+	$Data::Dumper::Indent = 0;
+	$Data::Dumper::Terse = 1;
+	print {$run{LOG}} "Running environment:\n", Data::Dumper->Dump([\%run]), "\n\n"; 
+	print {$run{LOG}} "Configuration:\n",Data::Dumper->Dump([$config]),"\n\n";
+    }
     exit 
 };
 $SIG{TERM} = $s;
 $SIG{INT} = $s;
+$run{main} = 1;
 
 my %done;
 $run{done} = \%done;
@@ -748,30 +753,33 @@ sub dump_cache {
     # Right now there are no mechanism of concurrent access/write to the cache. There is 
     # on global lock for one iurt session. A finer cache access would allow several iurt running
     # but the idea is more to have a global parrallel build than several local ones.
-    return if $run->{debug} || !$run->{cache};
+    return if $run->{debug} || !$run->{use_cache};
     open my $file, ">$filename.tmp" or die "FATAL iurt dump_cache: cannot open $filename.tmp";
-    flock($file,LOCK_EX);
-    seek($file, 0, 2);
-    if ($run{concurrent_run}) {
-	print {$run{log}} "iurt: merging cache";
-	my $old_cache;
-	if (-f $filename) {
-	    print {$run{LOG}} "iurt: loading cache file $cachefile\n" if $run{verbose} > 1;
-	    $old_cache = do $cachefile;
-	    foreach my $k ('rpm_srpm', 'failure', 'no_unionfs', 'queue', 'needed', 'warning') {
-		foreach my $rpm (%{$old_cache->{$k}}) {
-		    $cache->{$k}{$rpm} ||= $old_cache->{$k}{$rpm}
+    if (flock($file,LOCK_EX)) {
+	#seek($file, 0, 2);
+	if ($run{concurrent_run}) {
+	    print {$run{log}} "iurt: merging cache";
+	    my $old_cache;
+	    if (-f $filename) {
+		print {$run{LOG}} "iurt: loading cache file $cachefile\n" if $run{verbose} > 1;
+		$old_cache = do $cachefile;
+		foreach my $k ('rpm_srpm', 'failure', 'no_unionfs', 'queue', 'needed', 'warning') {
+		    foreach my $rpm (%{$old_cache->{$k}}) {
+			$cache->{$k}{$rpm} ||= $old_cache->{$k}{$rpm}
+		    }
 		}
 	    }
+	    #  $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} }
 	}
-	#  $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} }
+	$Data::Dumper::Indent = 1;
+	$Data::Dumper::Terse = 1;
+	print $file Data::Dumper->Dump([ $cache ], [ "cache" ]);
+	unlink $filename;
+	link "$filename.tmp", $filename;
+	flock($file,LOCK_UN)
+    } else {
+	 print {$run{LOG}} "iurt: dumping_cache failed (could not lock cache file $cachefile $!)";
     }
-    $Data::Dumper::Indent = 1;
-    $Data::Dumper::Terse = 1;
-    print $file Data::Dumper->Dump([ $cache ], [ "cache" ]);
-    unlink $filename;
-    link "$filename.tmp", $filename;
-    flock($file,LOCK_UN)
 }
 
 sub sendmail {
@@ -827,11 +835,12 @@ sub perform_command {
     print {$run{LOG}} "Timeout $opt{timeout}\n" if $run{verbose} > 2;
     # from alarm perldoc
     my $output;
-    my $kill;
+    my ($kill, $pipe);
     if ($opt{debug}) {
 	print "Would have rum $command with a timeout of $opt{timeout}\n";
 	return 1
     }
+    local $SIG{PIPE} = sub { print "Broken pipe!\n"; $pipe = 1 };
     my $logfile = "$opt{log}/$opt{hash}.$run->{run}.log";
     my $pid;
     if ($opt{log}) {
@@ -839,6 +848,7 @@ sub perform_command {
 	$pid = fork;
 	my $tot_time;
 	if (!$pid) {
+	    $run->{main} = 0;
 	    local $SIG{ALRM} = sub { exit };
 	    $tot_time += sleep 60;
 	    my $size_limit = $config->{log_size_limit};
@@ -867,54 +877,60 @@ sub perform_command {
 	} else {
 	    $output = `$command 2>&1`;
 	}
-	alarm 0;
+	alarm 0
     };
-    kill 14, $pid if $pid;
+    my $err = $?;
+    # kill pid watching log file size
+    if ($pid) {
+	use POSIX ":sys_wait_h";
+	kill 14, $pid;
+	waitpid(-1, WNOHANG)
+    }
     if ($@) {
 	# timed out
-	die unless $@ eq "alarm\n";   # propagate unexpected errors
-	return 0
+	die "FATAL iurt: unexpected signal" unless $@ eq "alarm\n";   # propagate unexpected errors
+    }
+    # Keep the run first on the harddrive so that one can check the command status tailing it
+    if ($opt{log} && open my $log, $logfile) {
+	local $/;
+	$output = <$log>
+    }
+    if (ref $opt{callback}) {
+	$opt{callback}(\%opt, $output)
+    }
+    if ($kill) {
+	$output = "Command has been killed after $opt{timeout} seconds: $command\n$output"
+    } elsif ($pipe) {
+        $output = "Command receives a broken pipe: $command\n$output";
+	sendmail($config->{admin}, '' , "$opt{hash} on $run->{my_arch} for $run->{media}: broken pipe", "$output", 0, 0, $opt{debug_mail});
     } else {
-	# Keep the run first on the harddrive so that one can check the command status tailing it
-	if ($opt{log} && open my $log, $logfile) {
-	    local $/;
-	    $output = <$log>
-	}
-	my $err = $?;
-	if (ref $opt{callback}) {
-	    $opt{callback}(\%opt, $output)
-	}
-	if ($kill) {
-	    $output = "Command has been killed after $opt{timeout} seconds: $command\n$output"
-	} else {
-	    $output = "Command failed: $command\n$output"
+	$output = "Command failed: $command\n$output"
+    }
+    if ($opt{wait_regexp} && $output =~ /$opt{wait_regexp}/) {
+	$opt{wait_callback}(\%opt, $output) if ref $opt{wait_callback};
+	print {$run->{LOG}} "ERROR iurt: $opt{wait_regexp} !\n";
+	sendmail($config->{admin}, '' , "$opt{hash} on $run->{my_arch} for $run->{media}: could not proceed", "$opt{wait_regexp}\n\n$output", 0, 0, $opt{debug_mail});
+	if ($opt{die}) {
+	    dump_cache($run);
+	    die "FATAL iurt: $opt{error}."
 	}
-	if ($opt{wait_regexp} && $output =~ /$opt{wait_regexp}/) {
-	    $opt{wait_callback}(\%opt, $output) if ref $opt{wait_callback};
-	    print {$run->{LOG}} "ERROR iurt: $opt{wait_regexp} !\n";
-	    sendmail($config->{admin}, '' , "$opt{hash} on $run->{my_arch} for $run->{media}: could not proceed", "$opt{wait_regexp}\n\n$output", 0, 0, $opt{debug_mail});
-	    if ($opt{die}) {
-		dump_cache($run);
-		die "FATAL iurt: $opt{error}."
+	return 0
+    }
+    if ($err || $opt{error_regexp} && $output =~ /$opt{error_regexp}/) {
+	if ($opt{mail} && $config->{sendmail} && !$config->{no_mail}{$opt{mail}}) {
+	    if (! ($cache->{warning}{$opt{hash}}{$opt{mail}} % $opt{freq})) {
+		sendmail($opt{mail}, $opt{cc} , $opt{error} , $output, 0, 0, $opt{debug_mail});
+	    } elsif ($config->{admin}) {
+		sendmail($config->{admin}, '' , $opt{error}, $output, 0, 0, $opt{debug_mail});
 	    }
-	    return 0
 	}
-	if ($err || $opt{error_regexp} && $output =~ /$opt{error_regexp}/) {
-	    if ($opt{mail} && $config->{sendmail} && !$config->{no_mail}{$opt{mail}}) {
-		if (! ($cache->{warning}{$opt{hash}}{$opt{mail}} % $opt{freq})) {
-		    sendmail($opt{mail}, $opt{cc} , $opt{error} , $output, 0, 0, $opt{debug_mail});
-		} elsif ($config->{admin}) {
-		    sendmail($config->{admin}, '' , $opt{error}, $output, 0, 0, $opt{debug_mail});
-		}
-	    }
-	    $cache->{warning}{$opt{hash}}{$opt{mail}}++;
-	    print {$run->{LOG}} "\n$output\n";
-	    if ($opt{die}) {
-		dump_cache($run);
-		die "FATAL iurt: $opt{error}."
-	    }
-	    return 0
+	$cache->{warning}{$opt{hash}}{$opt{mail}}++;
+	print {$run->{LOG}} "\n$output\n";
+	if ($opt{die}) {
+	    dump_cache($run);
+	    die "FATAL iurt: $opt{error}."
 	}
+	return 0
     }
     1
 }
@@ -949,13 +965,18 @@ sub check_chroot {
 
 sub dump_rpmmacros {
 	my ($file) = @_;
-	open my $f, qq{| sudo sh -c "cat > $file"} or return 0;
+	my $f;
+	if (!open $f, qq{| sudo sh -c "cat > $file"}) {
+	   print {$run{LOG}} "ERROR iurt: could not open $file ($!)\n";
+	   return 0
+	}
 	print $f qq{\%_topdir                \%(echo \$HOME)/rpm
 \%_tmppath               \%(echo \$HOME)/rpm/tmp/
 \%distribution           $config->{distribution}
 \%vendor                 $config->{vendor}
 \%packager               $config->{packager}};
-	-f $file or return 0
+	-f $file or return 0;
+	1
 }
 
 sub check_pid {