More on 5.8 and signals

Discussion in 'Perl Misc' started by Eric Frazier, Sep 16, 2003.

  1. Eric Frazier

    Eric Frazier Guest

    Hi,

    I am pretty desparate to get this working, and if anyone wants to earn
    some cash helping me fix things PLEASE call me at 250 655-9513.

    Thanks to a guy on comp.lang.perl.misc I know that there is a change in
    how signals are handled, they call it deferred signal handling because
    Perl now is suppose to wait until the Interpeter is in a safe state. As
    I understand it this might avoid some things like core dumps or other
    errors related to dieing while trying to do something besides dieing.

    The thing is somehow this ends up killing off my parent process, just
    like in this post:

    http://www.mail-archive.com//msg43989.html

    So this is happening to me as well, however the guy in the above example
    had his problem solved by using Errno and looking for EINTR if that
    error is raised then catch it and move on. This isn't working for me, or
    else I don't know how to use the advice I was given about it.

    I did get one maybe helpfull thing from my log:

    Erro was %! --------
    ../franken_socket.pl 8607: got - CHLD
    at Tue Sep 16 02:17:42 2003
    I got forked
    ../franken_socket.pl 8599: begat 8607 at Tue Sep 16 02:17:40 2003
    begat 8607
    ../franken_socket.pl 8599: got - CHLD
    at Tue Sep 16 02:17:54 2003
    ../franken_socket.pl 8599: main 8607 -- reaped 1 at Tue Sep 16 02:17:54
    2003
    reaped 1Erro was No child processes %! --------

    So it looks like the parent got killed on that error "No child process"
    This code works just fine on 5.6 since it is about 150% from examples :)
    The above is the result of connecting, doing a "who", and doing "dienow"
    to test the alarm.

    I also found this:

    http://archive.develooper.com//msg03022.html

    Which totaly describes my problem as well, but shows it happening with
    perl 5.8.1..


    >I'd imagine that your accept() isn't being restarted. How does it work
    >if you change the loop to look like this?


    > use Errno;


    > while (1) {
    > my $client = $server->accept or do {
    > next if $!{EINTR};
    > last;
    > };
    > spawn(\&function, "whatever");
    > }


    #!/usr/bin/perl -w

    ## new frankenstein!

    use strict;
    use POSIX ();
    use POSIX 'WNOHANG';
    use Errno;
    use IO::Socket;
    use FindBin ();
    use File::Basename ();
    use File::Spec::Functions;
    use Net::hostent;
    use Carp;


    $|=1;
    my $pid;

    open (DIED, ">>/var/log/daemon_log") or warn "$!";
    sub logmsg { print DIED "$0 $$: @_ at ", scalar localtime, "\n" }

    my $listen_socket = IO::Socket::INET->new(LocalPort => 1081,
    LocalAddr => '127.0.0.1',
    Proto => 'tcp',
    Listen => SOMAXCONN,
    Reuse => 1 )
    or die "can make a tcp server on port 1080 $!";


    # make the daemon cross-platform, so exec always calls the script
    # itself with the right path, no matter how the script was invoked.
    my $script = File::Basename::basename($0);
    my $SELF = catfile $FindBin::Bin, $script;
    # POSIX unmasks the sigprocmask properly
    my $sigset = POSIX::SigSet->new();
    my $action = POSIX::SigAction->new('sigHUP_handler',
    $sigset,
    &POSIX::SA_NODEFER);
    my $action_alrm = POSIX::SigAction->new('sigALRM_handler',
    $sigset,
    &POSIX::SA_NODEFER);


    POSIX::sigaction(&POSIX::SIGHUP, $action);
    POSIX::sigaction(&POSIX::SIGALRM, $action_alrm);

    sub sigHUP_handler {
    print "got SIGHUP\n";
    exec($SELF, @ARGV) or die "Couldn't restart: $!\n";
    }
    sub sigALRM_handler {
    print "got ALARM timeout\n";

    }

    $SIG{CHLD} = \&REAPER_NEW;

    sub REAPER {
    $SIG{CHLD} = \&REAPER; # loathe sysV
    my $waitedpid = wait;
    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
    }

    sub REAPER_NEW {
    logmsg "got - @_\n";
    my $wpid = undef;
    while ($wpid = waitpid(-1,WNOHANG)>0) {

    logmsg "main $pid -- reaped $wpid" . ($? ? " with exit
    $?" : '')
    ;
    print DIED "reaped $wpid" . ($? ? " with exit $?" : '');

    }
    }


    print "PID: $$\n";
    print "ARGV: @ARGV\n";
    print "[Server $0 accepting clients]\n";

    #while (my $connection = $listen_socket->accept()) {
    while (1) {
    my $connection = $listen_socket->accept() or do {
    next if $!{EINTR};
    last;
    };

    print DIED "Erro was $! %! --------\n";
    $connection->autoflush(1); ## missing seemed to cause client problem,
    but not telnet

    if (!defined($pid = fork)) {
    logmsg "cannot fork: $!";

    }elsif ($pid) {
    logmsg "begat $pid";
    print DIED "begat $pid\n";
    }else{
    # else i'm the child -- go spawn
    print $connection "Command?";

    while ( <$connection> ){

    my $return_value = undef;

    if (/quit|exit/i) {
    last; }
    elsif (/closeme/i )
    {$connection->close(); }
    elsif (/date|time/i) { printf $connection "%s\n",
    scalar localtime; }
    elsif (/who/i ) { print $connection `who
    2>&1`;}
    elsif (/dienow/i ) { alarm 2; }
    elsif (/dieT/i ) {
    die; }



    #REAPER_NEW($pid) if $return_value;

    print $connection "Command?";

    print DIED "I got forked\n";
    }
    exit(0);

    #STDIN->fdopen($connection,"r") || die "can't dup client to
    stdin";
    #STDOUT->fdopen($connection,"w") || die "can't dup client to
    stdout"
    ;
    #STDERR->fdopen($connection,"w") || die "can't dup stdout to
    stderr";

    ### FORKed code here..

    } ## end while <$connection>

    } ## end else

    close ($listen_socket);
    Eric Frazier, Sep 16, 2003
    #1
    1. Advertising

  2. Eric Frazier <> wrote:
    > I am pretty desparate to get this working, and if anyone wants to earn
    > some cash helping me fix things PLEASE call me at 250 655-9513.
    >
    > Erro was No child processes %! --------
    >
    > So it looks like the parent got killed on that error "No child process"


    That's because you're looping in the CHLD handler now --

    > sub REAPER_NEW {
    > logmsg "got - @_\n";
    > my $wpid = undef;
    > while ($wpid = waitpid(-1,WNOHANG)>0) {


    This calls waitpid() until it fails, and the eventual failure
    clobbers $!. It was EINTR after the SIGCHLD, but now it's ECHILD.

    You could retry accept() on either ECHILD or EINTR, I think. Or
    you could set a flag in the handler:

    my $reaped;

    $SIG{CHLD} = sub {
    $reaped = 1;
    1 while waitpid(-1, WNOHANG) > 0;
    };

    while (1) {
    my $con = $sock->accept or do {
    next if $!{EINTR} or $reaped;
    last;
    };

    # ...

    }
    continue {
    $reaped = 0;
    }

    And on many systems, you can just set $SIG{CHLD} = "IGNORE" and the
    children will be reaped automatically.

    --
    Steve
    Steve Grazzini, Sep 16, 2003
    #2
    1. Advertising

  3. Eric Frazier

    bob Guest

    Hi Steve,

    That worked for me! But using $SIG{CHLD} = 'IGNORE'; also worked.

    I seem to now be having problems with keeping my database connection,
    but the server is staying live. I tried connecting at the top globaly,
    and I also tried connecting in the subs that get run by commands. Same
    result, after the first connect and close I loose my db connection.

    But that is problem I will most likely be able to solve on my own, so
    thanks for your help...


    Eric



    Steve Grazzini wrote:
    > Eric Frazier <> wrote:
    >
    >>I am pretty desparate to get this working, and if anyone wants to earn
    >>some cash helping me fix things PLEASE call me at 250 655-9513.
    >>
    >>Erro was No child processes %! --------
    >>
    >>So it looks like the parent got killed on that error "No child process"

    >
    >
    > That's because you're looping in the CHLD handler now --
    >
    >
    >> sub REAPER_NEW {
    >> logmsg "got - @_\n";
    >> my $wpid = undef;
    >> while ($wpid = waitpid(-1,WNOHANG)>0) {

    >
    >
    > This calls waitpid() until it fails, and the eventual failure
    > clobbers $!. It was EINTR after the SIGCHLD, but now it's ECHILD.
    >
    > You could retry accept() on either ECHILD or EINTR, I think. Or
    > you could set a flag in the handler:
    >
    > my $reaped;
    >
    > $SIG{CHLD} = sub {
    > $reaped = 1;
    > 1 while waitpid(-1, WNOHANG) > 0;
    > };
    >
    > while (1) {
    > my $con = $sock->accept or do {
    > next if $!{EINTR} or $reaped;
    > last;
    > };
    >
    > # ...
    >
    > }
    > continue {
    > $reaped = 0;
    > }
    >
    > And on many systems, you can just set $SIG{CHLD} = "IGNORE" and the
    > children will be reaped automatically.
    >
    bob, Sep 16, 2003
    #3
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Taras_96
    Replies:
    5
    Views:
    2,136
    Taras_96
    Apr 14, 2005
  2. shess
    Replies:
    0
    Views:
    282
    shess
    Nov 24, 2003
  3. Michael
    Replies:
    4
    Views:
    400
    Matt Hammond
    Jun 26, 2006
  4. Murph
    Replies:
    9
    Views:
    454
    Mike Treseler
    Dec 7, 2006
  5. Robert Klemme

    With a Ruby Yell: more, more more!

    Robert Klemme, Sep 28, 2005, in forum: Ruby
    Replies:
    5
    Views:
    206
    Jeff Wood
    Sep 29, 2005
Loading...

Share This Page