Question

我创建了一个启动简单HTTP服务器以进行测试的软件包，但stop()方法似乎并不想停止fork()'ed过程。杀死进程（通过SIGHUP）在对象外部工作正常，但调用$server->stop只是不起作用。为什么呢？

package MockHub;
use Moose;
use HTTP::Server::Brick;
use JSON;
use Log::Any qw($log);
use English qw(-no_match_vars);

has 'server' => (
    'is'       => 'ro',
    'lazy'     => 1,
    'isa'      => 'HTTP::Server::Brick',
    'builder'  => '_build_server',
    'init_arg' => undef
);
has 'port'  => ( 'is' => 'ro', 'isa' => 'Int' );
has 'pid'   => ( 'is' => 'rw', 'isa' => 'Int', 'init_arg' => undef );
has 'token' => ( 'is' => 'rw', 'isa' => 'Str', 'init_arg' => undef );
has 'log'   => ( 'is' => 'ro', 'isa' => 'Log::Any::Proxy', 'default' => sub { Log::Any->get_logger() } );

sub start {
    my $self = shift;        

    my $pid = fork;

    # Spawn the server in a child process.
    if (!defined $pid) {
        die qq{Can't fork: $!};
    }
    elsif ($pid == 0) { # child 
        $self->server->start;
        exit; # exit after server exits
    }
    else { # parent 
        $self->pid($pid);
        return $pid;
    }
}

sub _build_server {
    my ($self) = @_;

    my $port   = $self->port;
    my $pid    = $self->pid || 'NO PID';
    my $server = HTTP::Server::Brick->new( port => $port );
    $server->mount(
        '/foo' => {
            'handler' => sub {
                my ( $req, $res ) = @_;
                my $token = substr( $req->{'path_info'}, 1 );    # remove leading slash
                $self->token($token);
                $res->header( 'Content-Type' => 'application/json' );
                $res->add_content( encode_json( { 'success' => 1, 'message' => 'Process Report Received' } ) );
                1;
            },
            'wildcard' => 1,
        },
    );
    $server->mount(
        '/token' => {
            'handler' => sub {
                my ( $req, $res ) = @_;
                my $token = $self->token || '';
                $res->header( 'Content-Type' => 'text/plain' );
                $res->add_content($token);
                1;
            },
        },
    );

    return $server;
}

sub stop {
    my ($self) = @_;

    my $pid = $self->pid || die q{No PID};

    if (kill 0, $pid) {
        sleep 1;
        kill 'HUP', $pid;
        if (kill 0, $pid) {
            warn q{Server will not die!};
        }
    }
    else {
        warn q{Server not running};
    }
}
__PACKAGE__->meta->make_immutable;

Answer 1

您的stop子程序似乎没有停止任何操作。它发送kill 0（仅检测进程何时运行）或HUP。您不想发送SIGTERM或类似内容吗？

另外，你想用$self->$pid做些什么？执行fork()时，父项和子项的内存空间是分开的，因此您在父项中写入$self->pid的内容将不会对子项可见。因此，您需要在子项中记录子的PID，例如

$self->pid = $$;

前

$self->server->start;

我有点不确定你在这里想要杀死哪个进程，以及哪个进程正在调用stop()。我假设这些不完全一样，或者你肯定只是从那里退出而不是用kill等捣乱。

Answer 2

虽然它没有运行，但该过程仍然存在，直到它的父节点被wait（2）收获。由于孩子从未被收获（并且因为没有许可问题），kill 0, $pid将永远成功。修正：

sub stop {
    my ($self) = @_;

    my $pid = $self->pid
        or die("No child to stop.\n");

    kill(TERM => $pid);
        or die("Can't kill child.\n");

    if (!eval {{
        local $SIG{ALRM} = sub { die "timeout\n" };
        alarm(15);
        waitpid($pid, 0) > 0
            or die("Can't reap child.\n");

        return 1;  # No exception
    }}) {
        die($@) if $@ ne "timeout\n";

        warn("Forcing child to end.\n");
        kill(KILL => $pid)
            or die("Can't kill child.\n");

        waitpid($pid, 0) > 0
            or die("Can't reap child.\n");
    }

    $self->pid(0);
}

为什么不死呢？

2 个答案: