Fugu
view release on metacpan or search on metacpan
lib/Fugu/Log.pod view on Meta::CPAN
The destination for messages. The value is one of:
=over 4
=item C<syslog>
Messages go through syslog(3). The logger pins the transport to the
C<native> mechanism with C<setlogsock> from L<Sys::Syslog>, and then
calls openlog(3) immediately with the C<ndelay> and C<pid> options.
The pin keeps a pledged daemon alive. On OpenBSD the C<native>
mechanism delivers with sendsyslog(2), which sits inside the C<stdio>
promise. Every other mechanism opens a socket, and a daemon that
pledges C<stdio> dies at that call.
=item C<stderr>
Messages go to standard error, with one line for each message. Each
line starts with a local-time stamp and the level in upper case.
=item C<quiet>
lib/Fugu/Mdnsd.pod view on Meta::CPAN
$mdns->withdraw;
=head1 DESCRIPTION
Fugu::Mdnsd publishes services with mdnsd(8). The module uses the
mdnsd control protocol directly over F</var/run/mdnsd.sock>, and it
starts no mdnsctl(8) child process. It implements no mDNS of its own:
every method here is a control operation, and no mDNS packet ever
leaves the module. mdnsd(8) sends those. The connection is the
lifetime of the advertisement. mdnsd withdraws the service when the
socket closes. Thus a daemon keeps the object alive for as long as the
daemon must be discoverable. To withdraw the advertisement, the daemon
only closes the socket.
The document F<spec/protocol/MDNS-Control.md> in this repository specifies the
wire protocol. This specification has the message types, the payload
layouts, the group state machine, and its timing. The module never
logs. Every method returns an outcome and records the most recent
failure for C<error()>.
=head2 new
lib/Fugu/Pidfile.pm view on Meta::CPAN
return 1 unless -e $self->{path};
unless ( unlink $self->{path} ) {
$self->{error} = "unlink $self->{path}: $!";
return;
}
return 1;
}
# $self->is_running:
# Return the PID from the file when that process is alive.
# Otherwise return undef.
sub is_running ($self)
{
my $pid = $self->read_pid;
return unless defined $pid;
return unless Fugu::Process->is_alive($pid);
return $pid;
}
# $self->is_stale:
# Report if the file names a process that is not alive now. An
# absent PID file is not stale.
sub is_stale ($self)
{
my $pid = $self->read_pid;
return 0 unless defined $pid;
return !Fugu::Process->is_alive($pid);
}
# $self->_open_locked($nonblocking):
# Open the file for read and write, create it when it is absent,
# and take the exclusive lock. The open must not truncate. A
# truncate before the lock lets a concurrent reader see an empty
# file.
sub _open_locked ( $self, $nonblocking )
{
sysopen my $fh, $self->{path}, O_CREAT | O_RDWR, 0644 or do {
lib/Fugu/Pidfile.pod view on Meta::CPAN
line must be a sequence of decimal digits. If the contents are
different, or if the file is absent, the method returns no PID.
=head2 remove
C<remove()> removes the PID file.
=head2 is_running
C<is_running()> returns the process ID from the file if that process
is alive. The method uses L<Fugu::Process> for the liveness check.
=head2 is_stale
C<is_stale()> reports if the PID file names a process that is not
alive now. In this condition, a daemon can take the file and does not
refuse to start.
=head2 error
C<error()> returns the most recent failure as a message that a log can
carry.
=head1 RETURN VALUES
C<new()> returns an object.
lib/Fugu/Process.pm view on Meta::CPAN
# A caller that passes the raw status on to exit() turns a remote
# exit code of 1 into exit(256), which the kernel truncates to 0.
# That silently reports a failed command as a success.
sub exit_code ( $class, $status )
{
return EXIT_ERROR if $status == -1;
return 128 + ( $status & 0x7f ) if $status & 0x7f;
return $status >> 8;
}
# $class->is_alive($pid):
# Check if the process is alive (not dead, not a zombie).
# The method returns 1 if the process is alive. It returns 0 if
# the process is dead, a zombie, or does not exist.
#
# The check reaps: a zombie child of the caller is collected
# here, and the answer is 0. A caller that needs the exit status
# uses run, or waits itself.
sub is_alive ( $class, $pid )
{
return 0 unless defined $pid;
return 0 unless $pid =~ /^\d+$/;
# First check if the process exists
return 0 unless kill( 0, $pid );
# Do not try to wait on the current process
return 1 if $pid == $$;
# Try to reap zombies without blocking
my $result = waitpid( $pid, WNOHANG );
# If waitpid returns the PID, the process was a zombie.
# waitpid has now reaped it.
return 0 if $result == $pid;
# If waitpid returns -1, the process is not a child of the
# caller. kill(0) already proved that it exists, so it is alive.
return 1;
}
# $class->terminate($pid, %args):
# Stop a process gracefully. Use force if necessary.
# The method returns 1 if the process is killed or dead. It
# returns 0 on failure.
#
# %args:
# grace_period => $seconds # Time to wait after TERM before KILL (default: 5)
lib/Fugu/Process.pm view on Meta::CPAN
# $pid must be the pid of a process-group leader. The liveness
# test is then kill 0 on the group, because a group can outlive
# its leader, so the group form must not return early on a dead
# leader. The method cannot wait for a member that is not its
# child. A member that init has yet to reap can therefore still
# answer for a moment.
sub terminate ( $class, $pid, %args )
{
return $class->_terminate_group( $pid, %args ) if $args{group};
return 1 unless $class->is_alive($pid);
my $grace_period = $args{grace_period} // 5;
my $on_kill = $args{on_kill};
# Send SIGTERM
my $killed = kill 'TERM', $pid;
unless ($killed) {
# The process is already dead, or there is no
# permission
return $class->is_alive($pid) ? 0 : 1;
}
$class->wait_exit( $pid, $grace_period );
# If the process is still alive, kill it with force
if ( $class->is_alive($pid) ) {
kill 'KILL', $pid;
$class->wait_exit( $pid, 1 );
# Final check
return 0 if $class->is_alive($pid);
}
$on_kill->() if $on_kill;
return 1;
}
# $class->_terminate_group($pid, %args):
# The group form of terminate. Each signal goes to the process
# group of $pid, with a negative pid on kill. The method returns
# 1 when no member answers kill 0 on the group. It returns 0
# when a member still answers after the KILL.
#
# The guard on $pid is a safety boundary. kill with the group id
# 0 signals the group of the caller, and kill with the group id
# 1 can reach far outside the caller. A bad $pid must therefore
# signal nothing.
sub _terminate_group ( $class, $pid, %args )
{
return 1 unless defined $pid && $pid =~ /^\d+$/ && $pid > 1;
return 1 unless _group_alive($pid);
my $grace_period = $args{grace_period} // 5;
my $on_kill = $args{on_kill};
# Send SIGTERM to the whole group
my $killed = kill 'TERM', -$pid;
unless ($killed) {
# Every member is already dead, or there is no
# permission
return _group_alive($pid) ? 0 : 1;
}
_wait_group_exit( $pid, $grace_period );
# If a member is still alive, kill the group with force
if ( _group_alive($pid) ) {
kill 'KILL', -$pid;
_wait_group_exit( $pid, 1 );
# Final check
return 0 if _group_alive($pid);
}
$on_kill->() if $on_kill;
return 1;
}
# _group_alive($pid):
# Report if a member of the process group of $pid still answers
# kill 0. The check reaps each child member first, so a zombie
# child of the caller does not count as a live member.
sub _group_alive ($pid)
{
_reap_group($pid);
return 1 if kill 0, -$pid;
# A member can turn into a zombie between the reap above and
# the check. Reap once more, so a zombie child never outlives
# the answer "gone".
_reap_group($pid);
lib/Fugu/Process.pm view on Meta::CPAN
}
# _wait_group_exit($pid, $timeout):
# Wait until no member of the process group of $pid answers, or
# until the timeout ends. The method returns 1 when the group is
# gone. It returns 0 on timeout.
sub _wait_group_exit ( $pid, $timeout )
{
my $deadline = time + $timeout;
while ( time < $deadline ) {
return 1 unless _group_alive($pid);
select undef, undef, undef, POLL_INTERVAL;
}
# Final check
return _group_alive($pid) ? 0 : 1;
}
# $class->wait_exit($pid, $timeout):
# Wait for the process to exit.
# The method returns 1 if the process exits. It returns 0 on
# timeout.
sub wait_exit ( $class, $pid, $timeout = 30 )
{
my $deadline = time + $timeout;
while ( time < $deadline ) {
return 1 unless $class->is_alive($pid);
select undef, undef, undef, POLL_INTERVAL;
}
# Final check
return $class->is_alive($pid) ? 0 : 1;
}
# $class->spawn_perl(%args):
# Spawn a Perl subprocess that inherits the parent's @INC paths.
# This is a convenience wrapper around spawn_command() to run
# Perl code.
#
# %args:
# code => $string # Required: the Perl code to execute
# args => \@args # Optional: arguments for the code
lib/Fugu/Process.pod view on Meta::CPAN
C<exit_code($status)> maps a raw waitpid(2) status, or the return
value of C<system>, to an exit code between 0 and 255. The low byte
holds the terminating signal. The high byte holds the exit code. A
value of -1 means the child never started.
A caller that gives a raw status to C<exit> turns a remote exit code
of 1 into C<exit(256)>, which the kernel truncates to 0. That silently
reports a failed command as a success.
=head2 is_alive
C<is_alive($pid)> reports if a process exists and is not a zombie. The
check reaps a zombie child as a side effect and then reports it as not
alive. A caller that needs the exit status uses C<run()>, or waits
itself.
=head2 terminate
C<terminate($pid, %args)> sends C<SIGTERM>, waits, and sends
C<SIGKILL> if the process continues to run.
These are the arguments:
=over 4
lib/Fugu/Process.pod view on Meta::CPAN
=item C<group>
If this argument is true, each signal goes to the process group of
C<$pid>. The default is false.
C<$pid> must be the pid of a process-group leader. C<run()> with
C<new_session> and C<spawn_command()> with C<daemonize> each make
one. The method sends C<SIGTERM> to the group, waits for the grace
period, and sends C<SIGKILL> to the group when a member is still
alive.
The liveness test differs between the two forms. The default form
asks C<is_alive($pid)>, which reaps a zombie child. The group form
asks kill(2) with signal 0 on the group, and it reaps each child
member first. A group can outlive its leader, so the group form does
not return early on a dead leader.
=back
The wait polls with sub-second granularity. Thus a child that stops at
once does not cost a whole second.
=head2 wait_exit
lib/Fugu/Process.pod view on Meta::CPAN
success, the hash holds C<success> set to 1 and C<pid>. On failure,
C<success> is 0 and C<error> gives the cause.
C<run()> returns a hash reference that holds C<success>, C<stdout>,
C<stderr>, C<exit_code> and C<timed_out>. On a failure to start the
child, it also holds C<error>. C<success> is 1 only when the child
exited with code 0 and did not time out.
C<exit_code()> returns a number between 0 and 255.
C<is_alive()> returns 1 or 0.
C<terminate()> returns 1 if the process is gone. It returns 0 if the
process continues after C<SIGKILL>. In the group form, it returns 1
when no member of the group answers kill(2) with signal 0. It returns
0 when a member answers after C<SIGKILL>.
C<wait_exit()> returns 1 if the process exits in the timeout period.
If not, it returns 0.
=head1 EXAMPLES
lib/Fugu/Process.pod view on Meta::CPAN
=head1 AUTHORS
Dick Olsson E<lt>hi@senzilla.ioE<gt>
=head1 CAVEATS
C<run()> holds the whole output of the child in memory. Do not use it
for a command that writes without a bound.
C<is_alive()> calls waitpid(2). That call reaps only the children of
the caller. For all other processes, it uses kill(2) with signal 0.
This signal cannot show the difference between a live process and a
zombie.
The group form of C<terminate()> cannot wait for a member that is not
a child of the caller. A member that init(8) has yet to reap can
therefore still answer for a moment after the method returns.
The operating system uses process IDs again for new processes. The
module cannot show the difference between the initial process and a
lib/Fugu/Proxy.pm view on Meta::CPAN
}
# $self->port:
# Return the port the running proxy listens on, or undef.
sub port ($self)
{
return $self->{store}->get('proxy_port');
}
# $self->is_running:
# Report if the proxy child is alive. The check reaps, so a
# child that became a zombie reads as stopped.
sub is_running ($self)
{
return $self->{pidfile}->is_running ? 1 : 0;
}
# $self->start:
# Start the proxy child and wait until it takes connections. The
# method returns the port, or undef with the reason in ->error.
# A proxy that already runs returns its port and starts nothing.
lib/Fugu/Proxy.pod view on Meta::CPAN
returns its port and starts nothing.
=head2 stop
C<stop()> stops the child and forgets its port. The stop is a
C<SIGTERM> with a grace period, then a C<SIGKILL>, through
L<Fugu::Process>.
=head2 is_running
C<is_running()> reports if the child is alive. The check reaps, so a
child that became a zombie reads as stopped.
=head2 port
C<port()> returns the port the running proxy listens on.
=head2 wait_ready
C<wait_ready($timeout)> polls until the proxy takes a connection. The
default timeout is 30 seconds.
lib/Fugu/Signal.pm view on Meta::CPAN
use Scalar::Util qw(refaddr weaken);
# Fugu::Signal - signal handlers that set an interrupt flag.
#
# Each manager owns its handlers and its interrupt flag. Two managers
# in one process do not see each other's state. The installed handlers
# close over the object, so a handler always finds the manager that
# installed it.
# Every live manager, keyed by address. The values are weak, so the
# registry never keeps an object alive. check_interrupted reads the
# whole registry for code that has no object at hand.
my %live;
# Fugu::Signal->new:
sub new ($class)
{
my $self = bless {
handlers => {},
original => {},
interrupted => 0,
t/fugu/daemon.t view on Meta::CPAN
my $lock = Fugu::Pidfile->new( path => $pidfile );
my $pid = $lock->read_pid;
ok( defined $pid, 'the PID file holds a PID' );
my $state = slurp($report);
like( $state, qr{^cwd=/$}m, 'the daemon changed to /' );
like( $state, qr/^umask=0022$/m, 'the daemon applied the umask' );
like( $state, qr/^pid=\Q$pid\E$/m,
'the PID file names the daemon itself' );
is( $lock->is_running, $pid, 'the daemon is alive' );
stop($pid);
$lock->remove;
}
# Test 2: the lock is exclusive. A second daemon on the same PID file
# must not start.
{
my $pidfile = "$dir/exclusive.pid";
my $marker = "$dir/second-started";
t/fugu/process.t view on Meta::CPAN
# Test 2: Basic spawn and terminate
{
my $result = Fugu::Process->spawn_command(
cmd => [ 'sleep', '300' ],
);
ok( $result->{success}, 'Spawned sleep process' );
ok( defined $result->{pid}, 'Got PID' );
my $pid = $result->{pid};
ok( Fugu::Process->is_alive($pid), 'Process is alive' );
my $killed = Fugu::Process->terminate( $pid, grace_period => 2 );
ok( $killed, 'Terminated process' );
ok( !Fugu::Process->is_alive($pid), 'Process is dead' );
}
# Test 3: a process that exits at once still spawned successfully.
# The exec resolved, so the spawn is a success; the caller that needs
# the outcome uses run.
{
my $result = Fugu::Process->spawn_command(
cmd => [ 'sh', '-c', 'exit 1' ],
);
t/fugu/process.t view on Meta::CPAN
{
my $result = Fugu::Process->spawn_command( cmd => [] );
ok( !$result->{success}, 'Rejected empty command' );
like( $result->{error}, qr/non-empty arrayref/, 'and says why' );
my $scalar = Fugu::Process->spawn_command( cmd => 'sleep 1' );
ok( !$scalar->{success}, 'Rejected a non-arrayref command' );
}
# Test 8: is_alive edge cases
{
ok( !Fugu::Process->is_alive(undef), 'undef PID is not alive' );
ok( !Fugu::Process->is_alive(''), 'Empty PID is not alive' );
ok( !Fugu::Process->is_alive('abc'), 'Non-numeric PID is not alive' );
ok( !Fugu::Process->is_alive(999999), 'Non-existent PID is not alive' );
ok( Fugu::Process->is_alive($$), 'Own PID is alive' );
}
# Test 9: wait_exit
{
my $result = Fugu::Process->spawn_command(
cmd => [ 'sleep', '1' ],
);
my $exited = Fugu::Process->wait_exit( $result->{pid}, 5 );
ok( $exited, 'Process exited within timeout' );
t/fugu/process.t view on Meta::CPAN
cmd => [ $^X, '-e', '1' ],
env => 'not-a-hashref',
);
is( $r->{exit_code}, EXIT_ERROR, 'the run shape: EXIT_ERROR' );
is( $r->{stdout}, '', 'stdout is empty' );
is( $r->{stderr}, '', 'stderr is empty' );
};
# _gone_soon($pid):
# Poll until the process is dead, for up to five seconds. The
# is_alive call reaps a zombie child of the test. A group member
# that is not a child of the test waits for init to reap it, so
# it can answer for a moment.
sub _gone_soon ($pid)
{
for ( 1 .. 100 ) {
return 1 unless Fugu::Process->is_alive($pid);
select undef, undef, undef, 0.05;
}
return 0;
}
# _read_pids($file):
# Poll until the file holds two pids, then return them. The
# child writes the file directly after its fork, so the wait is
# short.
t/fugu/repl.t view on Meta::CPAN
pipe my $watch_r, my $watch_w or die "pipe: $!";
my ( $repl, $in_w, $out_r ) = repl( watch => [$watch_r] );
close $watch_w;
is( guarded( sub { $repl->read_line } ),
undef, 'the closed peer ends the read' );
is( $repl->event, 'watch', 'with the event watch' );
ok( $repl->ready_handle == $watch_r,
'and ready_handle names the handle' );
syswrite $in_w, "still alive\n";
is( guarded( sub { $repl->read_line } ),
undef, 'a closed handle stays readable' );
is( $repl->event, 'watch', 'so watch outranks the input' );
};
subtest 'ready_handle answers only after a watch event' => sub {
my ( $repl, $in_w, $out_r ) = repl();
syswrite $in_w, "a line\n";
guarded( sub { $repl->read_line } );
( run in 1.171 second using v1.01-cache-2.11-cpan-14f38c9f855 )