| … | |
… | |
| 367 | |
367 | |
| 368 | $coro |
368 | $coro |
| 369 | } |
369 | } |
| 370 | |
370 | |
| 371 | sub write_runtime { |
371 | sub write_runtime { |
|
|
372 | my $runtime = "$LOCALDIR/runtime"; |
|
|
373 | |
|
|
374 | # first touch the runtime file to show we are still running: |
|
|
375 | # the fsync below can take a very very long time. |
|
|
376 | |
|
|
377 | warn "touching runtime...\n";#d# |
|
|
378 | if (my $fh = aio_open $runtime, O_WRONLY, 0) { |
|
|
379 | utime undef, undef, $fh; |
|
|
380 | } |
|
|
381 | |
| 372 | my $guard = cf::lock_acquire "write_runtime"; |
382 | my $guard = cf::lock_acquire "write_runtime"; |
| 373 | |
383 | |
| 374 | my $runtime = "$LOCALDIR/runtime"; |
384 | warn "starting to write runtime...\n";#d# |
| 375 | |
|
|
| 376 | my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 |
385 | my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 |
| 377 | or return; |
386 | or return; |
| 378 | |
387 | |
| 379 | my $value = $cf::RUNTIME + 90 + 10; |
388 | my $value = $cf::RUNTIME + 90 + 10; |
| 380 | # 10 is the runtime save interval, for a monotonic clock |
389 | # 10 is the runtime save interval, for a monotonic clock |
| … | |
… | |
| 385 | |
394 | |
| 386 | # always fsync - this file is important |
395 | # always fsync - this file is important |
| 387 | aio_fsync $fh |
396 | aio_fsync $fh |
| 388 | and return; |
397 | and return; |
| 389 | |
398 | |
|
|
399 | # touch it again to show we are up-to-date |
|
|
400 | utime undef, undef, $fh; |
|
|
401 | |
| 390 | close $fh |
402 | close $fh |
| 391 | or return; |
403 | or return; |
| 392 | |
404 | |
| 393 | aio_rename "$runtime~", $runtime |
405 | aio_rename "$runtime~", $runtime |
| 394 | and return; |
406 | and return; |
|
|
407 | |
|
|
408 | warn "... done writing runtime.\n";#d# |
| 395 | |
409 | |
| 396 | 1 |
410 | 1 |
| 397 | } |
411 | } |
| 398 | |
412 | |
| 399 | =item cf::datalog type => key => value, ... |
413 | =item cf::datalog type => key => value, ... |
| … | |
… | |
| 2435 | |
2449 | |
| 2436 | die $$res unless "ARRAY" eq ref $res; |
2450 | die $$res unless "ARRAY" eq ref $res; |
| 2437 | |
2451 | |
| 2438 | return wantarray ? @$res : $res->[-1]; |
2452 | return wantarray ? @$res : $res->[-1]; |
| 2439 | } else { |
2453 | } else { |
|
|
2454 | reset_signals; |
| 2440 | local $SIG{__WARN__}; |
2455 | local $SIG{__WARN__}; |
|
|
2456 | local $SIG{__DIE__}; |
| 2441 | eval { |
2457 | eval { |
| 2442 | local $SIG{__DIE__}; |
|
|
| 2443 | close $fh1; |
2458 | close $fh1; |
| 2444 | |
2459 | |
| 2445 | my @res = eval { $cb->(@args) }; |
2460 | my @res = eval { $cb->(@args) }; |
| 2446 | syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res); |
2461 | syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res); |
| 2447 | }; |
2462 | }; |
| … | |
… | |
| 2923 | prio => 6, |
2938 | prio => 6, |
| 2924 | cb => \&IO::AIO::poll_cb, |
2939 | cb => \&IO::AIO::poll_cb, |
| 2925 | ); |
2940 | ); |
| 2926 | } |
2941 | } |
| 2927 | |
2942 | |
|
|
2943 | my $_log_backtrace; |
|
|
2944 | |
| 2928 | sub _log_backtrace { |
2945 | sub _log_backtrace { |
| 2929 | my ($msg, @addr) = @_; |
2946 | my ($msg, @addr) = @_; |
| 2930 | |
2947 | |
|
|
2948 | $msg =~ s/\n//; |
|
|
2949 | |
|
|
2950 | # limit the # of concurrent backtraces |
|
|
2951 | if ($_log_backtrace < 2) { |
|
|
2952 | ++$_log_backtrace; |
| 2931 | async { |
2953 | async { |
| 2932 | my @bt = fork_call { |
2954 | my @bt = fork_call { |
| 2933 | @addr = map { sprintf "%x", $_ } @addr; |
2955 | @addr = map { sprintf "%x", $_ } @addr; |
|
|
2956 | my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X; |
| 2934 | open my $fh, "exec addr2line -C -f -i -e \Q$^X\E @addr 2>&1 |" |
2957 | open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |" |
| 2935 | or die "addr2line: $!"; |
2958 | or die "addr2line: $!"; |
| 2936 | |
2959 | |
| 2937 | my @funcs; |
2960 | my @funcs; |
| 2938 | my @res = <$fh>; |
2961 | my @res = <$fh>; |
| 2939 | chomp for @res; |
2962 | chomp for @res; |
| 2940 | while (@res) { |
2963 | while (@res) { |
| 2941 | my ($func, $line) = splice @res, 0, 2, (); |
2964 | my ($func, $line) = splice @res, 0, 2, (); |
| 2942 | push @funcs, "[$func] $line"; |
2965 | push @funcs, "[$func] $line"; |
|
|
2966 | } |
|
|
2967 | |
|
|
2968 | @funcs |
| 2943 | } |
2969 | }; |
| 2944 | |
2970 | |
| 2945 | @funcs |
2971 | LOG llevInfo, "[ABT] $msg\n"; |
|
|
2972 | LOG llevInfo, "[ABT] $_\n" for @bt; |
|
|
2973 | --$_log_backtrace; |
| 2946 | }; |
2974 | }; |
| 2947 | |
2975 | } else { |
| 2948 | $msg =~ s/\n//; |
|
|
| 2949 | |
|
|
| 2950 | LOG llevInfo, "[ABT] $msg\n"; |
2976 | LOG llevInfo, "[ABT] $msg\n"; |
| 2951 | LOG llevInfo, "[ABT] $_\n" for @bt; |
2977 | LOG llevInfo, "[ABT] [suppressed]\n"; |
| 2952 | }; |
2978 | } |
| 2953 | } |
2979 | } |
| 2954 | |
2980 | |
| 2955 | # load additional modules |
2981 | # load additional modules |
| 2956 | use cf::pod; |
2982 | use cf::pod; |
| 2957 | |
2983 | |
