Есть функция solve которая в 0.001% случаях может зависнуть. Ее
нужно прервать по таймауту.
Пишу:
warn "started solve\n";
my $solution;
eval {
local $SIG{ALRM} = sub { die };
alarm 5;
$solution = solve($lp);
alarm 0;
};
my $is_timeout = $@;
delete_lp($lp);
if ($is_timeout) {
warn "time out\n";
} else
{
warn "sol $solution\n";
if ($solution == $INFEASIBLE)
{
# INCONSISTENCIES DETECTED
return 0;
}
}
Пишет в stderr "started solve" и все, по таймауту не выходит,
висит в 100% CPU. В чем проблема? как решить?
solve вызывает библиотеку. Очень вероятно что там внутри устанавливается свой аларм -- у этой библиотеки (lp_solve) есть свои функции set_timeout, но к сожалению она не экспортируется в перл в моей версии Math::LP::Solve
Есть способ сделать непробиваемый аларм, аларм броню?
А что, Перл настолько умен, что умеет die из обработчика сигналов? Думаю, тебе стоит сделать в стиле Си - в обработчике устанавливать глобальный флаг, а в самом внутреннем цикле solve его проверять (и делать die).
> А что, Перл настолько умен, что умеет die из обработчика сигналов?
Конечно, чай не петон какой-нибудь ;)
По теме: а что представляет собой $solution? Можно ли его передать через IPC? Может, solve стоит отфоркнуть, сколько-то подождать на waitpid, а потом насильно прибить?
вобщем я сделал шелловский сопроцесс который раз в 10 секунд шлет USR1
И на время запуска solve устанавливаю перехватчик.
Так по моему лучше всего, без выебонов, глобально и надежно.
Еще как я понял можно syscall setitimer сделать с другим доменом. Там есть три домена ITIMER_REAL, ITIMER_VIRTUAL и ITIMER_PROF -- это три разных таймера.
хех..
рано радовался. Подход с USR1:
если вместо вызова solve сделать тупой перловый цикл, то срабатывает:
--- SIGUSR1 (User defined signal 1) @ 0 (0) ---
sigreturn() = ? (mask now [])
rt_sigprocmask(SIG_BLOCK, [USR1], NULL, 8) = 0
rt_sigprocmask(SIG_UNBLOCK, [USR1], NULL, 8) = 0
rt_sigprocmask(SIG_BLOCK, [USR1], [], 8) = 0
rt_sigaction(SIGUSR1, {SIG_IGN}, {0x80b1cb4, [], 0}, 8) = 0
rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0
write(2, "time out\n", 9) = 9
exit_group(0) = ?
Если же стоит вызов solve, то strace такой:
--- SIGUSR1 (User defined signal 1) @ 0 (0) ---
sigreturn() = ? (mask now [])
--- SIGUSR1 (User defined signal 1) @ 0 (0) ---
sigreturn() = ? (mask now [])
--- SIGUSR1 (User defined signal 1) @ 0 (0) ---
sigreturn() = ? (mask now [])
--- SIGUSR1 (User defined signal 1) @ 0 (0) ---
sigreturn() = ? (mask now [])
то есть он получает сигнал но нифига не реагирует..
Не знаю точно на счет твоего случая, но крайне полезно будет прочитать вот это:
http://search.cpan.org/~lbaxter/Sys-SigAction-0.10/lib/Sys/SigAction.pm
Особенно ту часть, где говорится об этом:
Thus the 'deferred signal' approach (as implemented by default in perl 5.8 and later) results in some system calls being retried prior to the signal handler being called by perl. This breaks timeout logic for DBD-Oracle which works with earlier versions of perl. This can be particularly vexing, the host on which a database resides is not available: DBI->connect() hangs for minutes before returning an error (and cannot even be interupted with control-C, even when the intended timeout is only seconds). This is because SIGINT appears to be deferred as well. The result is that it is impossible to implement open timeouts with code that looks like this in perl 5.8.0 and later:
eval {
local $SIG{ALRM} = sub { die "timeout" };
alarm 2;
$sth = DBI->connect(...);
alarm 0;
};
alarm 0;
die if $@;
The solution, if your system has the POSIX sigaction() function, is to use perl's POSIX::sigaction() to install the signal handler. With sigaction(), one gets control over both the signal mask, and the sa_flags that are used to install the handler. Further, with perl 5.8.2 and later, a 'safe' switch is provided which can be used to ask for safe(r) signal handling.