summaryrefslogtreecommitdiffstats
ModeNameSize
-rw-r--r--.cvsignore47logstatsplain
-rw-r--r--Makefile3613logstatsplain
-rw-r--r--Makefile.common1613logstatsplain
-rw-r--r--Makefile.config649logstatsplain
-rw-r--r--advanced.msg.xml1002logstatsplain
d---------docs1052logstatsplain
d---------globetrotter424logstatsplain
-rw-r--r--help.msg.xml1075logstatsplain
-rw-r--r--isolinux-graphic-simple.bmp481078logstatsplain
-rw-r--r--isolinux-graphic-simple.bmp.parameters141logstatsplain
-rw-r--r--isolinux-graphic.bmp481078logstatsplain
-rw-r--r--isolinux-graphic.bmp.parameters141logstatsplain
d---------kernel237logstatsplain
-rwxr-xr-xmake_boot_img25688logstatsplain
d---------mdk-stage12797logstatsplain
d---------move667logstatsplain
d---------perl-install3053logstatsplain
d---------rescue629logstatsplain
d---------tools1497logstatsplain
POSIX ":sys_wait_h"; our @EXPORT = qw( kill_for_good clean_process check_pid perform_command sudo ); my $sudo = '/usr/bin/sudo'; =head2 config_usage($program_name, $run) Check that there is no other program running and create a pidfile lock I<$run> current running options Return true. =cut # CM: this actually doesn't offer race-free locking, a better system # should be designed sub check_pid { my ($run) = @_; my $pidfile = "$run->{pidfile_home}/$run->{pidfile}"; # Squash double slashes for cosmetics $pidfile =~ s!/+!/!g; plog('DEBUG', "check pidfile: $pidfile"); if (-f $pidfile) { my (@stat) = stat $pidfile; open(my $test_PID, $pidfile); my $pid = <$test_PID>; close $test_PID; if (!$pid) { plog('ERROR', "ERROR: invalid pidfile ($pid), should be <pid>"); unlink $pidfile; } if ($pid && getpgrp $pid != -1) { my $time = $stat[9]; my $state = `ps h -o state $pid`; chomp $state; if ($time < time()-7200 || $state eq 'Z') { my $i; plog('WARN', "another instance [$pid] is too old, killing it"); while ($i < 5 && getpgrp $pid != -1) { kill_for_good($pid); $i++; sleep 1; } } else { plog('WARN', "another instance [$pid] is already running for ", time()-$time, " seconds"); exit(); } } else { plog('WARN', "cleaning stale lockfile"); unlink $pidfile; } } open my $PID, ">$pidfile" or die "FATAL: can't open pidfile $pidfile for writing"; print $PID $$; close $PID; $pidfile; } =head2 perform_command($command, $run, $config, $cache, %opt) Run a command and check various running parameters such as log size, timeout... I<$command> the command to run I<$run> current running options I<$config> the configuration I<$cache> cached values I<%opt> the options for the command run Return true. =cut sub perform_command { my ($command, $run, $config, $cache, %opt) = @_; $opt{timeout} ||= 300; $opt{freq} ||= 24; $opt{type} ||= 'shell'; plog('DEBUG', "Using timeout of $opt{timeout} seconds."); if ($opt{use_iurt_root_command}) { my ($binary, $args) = $command =~ /^(\S*)(.*)$/; $command = "$sudo $config->{iurt_root_command} --$binary$args"; } my ($output, $fulloutput, $comment); my ($kill, $pipe); if ($opt{debug}) { if ($opt{type} eq 'perl') { print "Would run perl command with timeout = $opt{timeout}\n"; } else { print "Would run $command with timeout = $opt{timeout}\n"; } return 1; } local $SIG{PIPE} = sub { print "Broken pipe!\n"; $pipe = 1 }; my $retry = $opt{retry} || 1; my $call_ret = 1; my ($err, $pid, $try); my $logfile = "$opt{log}/$opt{logname}.$run->{run}.log"; my $max_retry = $config->{max_command_retry} < $retry ? $retry : $config->{max_command_retry}; while ($retry) { $try++; if ($opt{retry} > 1) { $logfile = "$opt{log}/$opt{logname}-$try.$run->{run}.log"; } if ($opt{log}) { my $parent_pid = $$; $pid = fork(); #close STDIN; close STDERR;close STDOUT; my $tot_time; if (!$pid) { plog('DEBUG', "Forking to monitor log size"); $run->{main} = 0; local $SIG{ALRM} = sub { exit() }; $tot_time += sleep 30; my $size_limit = $config->{log_size_limit}; $size_limit =~ s/k/000/i; $size_limit =~ s/M/000000/i; $size_limit =~ s/G/000000000/i; while ($tot_time < $opt{timeout}) { my (@stat) = stat $logfile; if ($stat[7] > $size_limit) { # FIXME: we left runaway processes (eg: urpmi) plog('ERROR', "ERROR: killing current command because of log size exceeding limit ($stat[7] > $config->{log_size_limit})"); kill 14, "-$parent_pid"; exit(); } my $df = df $opt{log}; if ($df->{per} >= 99) { # FIXME: we left runaway processes (eg: urpmi) plog('ERROR', "ERROR: killing current command because running out of disk space at $opt{log} (only $df->{bavail}KB left)"); kill 14, "-$parent_pid"; exit(); } $tot_time += sleep 30; } exit(); } } eval { local $SIG{ALRM} = sub { print "Timeout!\n"; $kill = 1; die "alarm\n"; # NB: \n required }; alarm $opt{timeout}; if ($opt{type} eq 'perl') { plog('DEBUG', "perl command"); $command->[0](@{$command->[1]}); } else { plog('DEBUG', $command); if ($opt{log}) { #$output = `$command 2>&1 2>&1 | tee $opt{log}/$opt{hash}.$run.log`; system("$command &> $logfile"); } else { $output = `$command 2>&1`; } }