This file is indexed.

/usr/share/perl5/Munin/Common/Timeout.pm is in munin-common 2.0.25-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
use warnings;
use strict;

# $Id$

package Munin::Common::Timeout;
use base qw(Exporter);

use Carp;
use English qw(-no_match_vars);


BEGIN {
    our @EXPORT = qw(
        &do_with_timeout
    );
}

# This represents the current ALRM signal setting
my $current_timeout_epoch;

# This sub always uses absolute epoch time reference.
# This is in order to cope with eventual stealed time... 
# ... and to avoid complex timing computations
#
# $timeout is relative seconds, $timeout_epoch is absolute.
sub do_with_timeout {
    my ($timeout, $block) = @_;

    croak 'Argument exception: $timeout' 
        unless $timeout && $timeout =~ /^\d+$/;
    croak 'Argument exception: $block' 
        unless ref $block eq 'CODE';

    my $new_timeout_epoch = time + $timeout;

    # Nested timeouts cannot extend the global timeout, 
    # and we always leave 5s for outer loop to finish itself
    if ($current_timeout_epoch && $new_timeout_epoch > $current_timeout_epoch - 5) {
	    $new_timeout_epoch = $current_timeout_epoch - 5;
    }

    if ($new_timeout_epoch <= time) {
    	# Yey ! Time's up already, don't do anything, just : "farewell !"
        return undef;
    }

    # Ok, going under new timeout setting
    my $old_current_timeout_epoch = $current_timeout_epoch;
    $current_timeout_epoch = $new_timeout_epoch;

    my $ret_value;
    eval {
        local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required 
        alarm ($new_timeout_epoch - time);
        $ret_value = $block->();
    };
    my $err = $EVAL_ERROR;

    # Restore the old $current_timeout_epoch...
    $current_timeout_epoch = $old_current_timeout_epoch;

    # ... and restart the old alarm if needed
    if ($current_timeout_epoch) {
       my $timeleft = $current_timeout_epoch - time;
       if ($timeleft <= 0) {
	       # no timeleft : directly raise alarm
	       die "alarm\n";
       }

       alarm ($timeleft);
    } else {
       # Remove the alarm
       alarm (0);
    }

    # And handle the return code
    if ($err) {
        return undef if $err eq "alarm\n";
        die $err; # Propagate any other exceptions
    }

    return $ret_value;
}

1;
__END__


=head1 NAME

Munin::Common::Timeout - Run code with a timeout. May nest.


=head1 SYNOPSIS

 use Munin::Common::Timeout;

 do_with_timeout(50, sub {
     # ...
 	do_with_timeout(5, sub {
		# ...
		# ...
	});
     # ...
 });


=head1 DESCRIPTION

See also L<Time::Out>, L<Sys::AlarmCall>

=head1 SUBROUTINES

=over

=item B<do_with_timeout>

 my $finished_with_no_timeout = do_with_timeout($seconds, $code_ref)
     or die "Timed out!";

Executes $block with a timeout of $seconds.  Returns the return value of the $block 
if it completed within the timeout.  If the timeout is reached and the code is still
running, it halts it and returns undef.

NB: every $code_ref should return something defined, otherwise the caller doesn't know
if a timeout occurred.

Calls to do_with_timeout() can be nested.  Any exceptions raised 
by $block are propagated.

=back

=cut
# vim: ts=4 : sw=4 : et