Professional Web Applications Themes

Tring to kill my kids, but they are stuborn little s! - PERL Miscellaneous

Removed by Administrator...

  1. Moderated Post

    Default Tring to kill my kids, but they are stuborn little s!

    Removed by Administrator
    Eric Frazier Guest
    Moderated Post

  2. #2

    Default Re: Tring to kill my kids, but they are stuborn little s!

    Eric Frazier <ericdmcontact.com> wrote:
    > I am running on perl 5.8
    >
    > $SIG{CHLD} = \&REAPER;
    >
    > while (my $connection = $listen_socket->accept()) {
    The "deferred signal" system introduced in 5.8.0 doesn't use SA_RESTART
    when installing %SIG handlers (and you didn't use it with sigaction()
    in the bit I snipped). This means that the accept() syscall will fail
    when it's interrupted by any of those handled signals.

    I'm not sure whether this matches the symptoms you were trying to describe,
    since the result will be that the parent exits after the first signal
    arrives, but it's certainly something to consider. The simplest solution
    is to rewrite the loop with an extra test for EINTR.

    use Errno;

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

    --
    Steve
    Steve Grazzini Guest

  3. #3

    Default Re: Tring to kill my kids, but they are stuborn little s!

    Hi,

    The parent is not getting killed. At least I am pretty sure it is not.
    I will do some reading, I don't know about EINTR at all.

    What I see happening is that I start the server, I telnet to it and run
    a command, exit with quit.
    then do a ps and see 2 perl processes, both look the same, neither has
    the (perl) which I thought ment that it was a child. If I do this same
    process of connect/exit connect/exit I will build up more and more of
    these processes.

    root 5356 0.0 0.6 7232 6704 p3 I 9:27AM 0:00.21
    /usr/bin/perl -w ./franken_socket.pl
    root 5364 0.0 0.6 7360 6716 p3 I 9:27AM 0:00.01
    /usr/bin/perl -w ./franken_socket.pl
    root 5369 0.0 0.6 7296 6712 p3 I 9:27AM 0:00.00
    /usr/bin/perl -w ./franken_socket.pl

    The above results from starting the server and connecting twice.

    I also may be getting a little confused because I did do some of this
    work on a machine with 5.6 and I know there have been a lot of changes.


    Thank you for your response.

    Eric

    Steve Grazzini wrote:
    >
    > Eric Frazier <ericdmcontact.com> wrote:
    > > I am running on perl 5.8
    > >
    > > $SIG{CHLD} = \&REAPER;
    > >
    > > while (my $connection = $listen_socket->accept()) {
    >
    > The "deferred signal" system introduced in 5.8.0 doesn't use SA_RESTART
    > when installing %SIG handlers (and you didn't use it with sigaction()
    > in the bit I snipped). This means that the accept() syscall will fail
    > when it's interrupted by any of those handled signals.
    >
    > I'm not sure whether this matches the symptoms you were trying to describe,
    > since the result will be that the parent exits after the first signal
    > arrives, but it's certainly something to consider. The simplest solution
    > is to rewrite the loop with an extra test for EINTR.
    >
    > use Errno;
    >
    > while (1) {
    > my $con = $sock->accept() or do {
    > next if $!{EINTR};
    > last;
    > };
    > }
    >
    > --
    > Steve
    Eric Frazier Guest

  4. #4

    Default Re: Tring to kill my kids, but they are stuborn little s!

    In article <3F64B2EB.3E7E39CAdmcontact.com>, [email]ericdmcontact.com[/email] says...

    I didn' test this, but please consider the following:

    [code snipped]
    >while (my $connection = $listen_socket->accept()) {
    >
    > my $pid;
    > if (!defined($pid = fork)) {
    > logmsg "cannot fork: $!";
    >
    > }elsif ($pid) {
    > logmsg "begat $pid";
    > }else{
    > # else i'm the child -- go spawn
    > print $connection "Command?";
    > while ( <$connection> ){
    >
    > if (/quit|exit/i) {
    >last; }
    This gets the child out of the 'while ( <$connection> )' loop, but leaves it in the 'while (my $connection = $listen_socket->accept())' loop. So the child never dies, but listens for new connections.
    Entering the command dieT at your prompt should really kill the child.

    > 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; }
    dieT is a typo, isn't it.

    hth.

    --
    Heinrich Mislik
    Zentraler Informatikdienst der Universitaet Wien
    A-1010 Wien, Universitaetsstrasse 7
    Tel.: (+43 1) 4277-14056, Fax: (+43 1) 4277-9140

    Heinrich Mislik Guest

  5. #5

    Default Re: Tring to kill my kids, but they are stuborn little s!

    Hi,

    You know you really kind of hit the nail on the head. The exit or die,
    don't kill the child. I do want to be able to have the child accept a
    command though, so other than not dieing when it is done, it is doing
    what I want.

    Thanks for your post,

    Eric

    Heinrich Mislik wrote:
    > In article <3F64B2EB.3E7E39CAdmcontact.com>, [email]ericdmcontact.com[/email] says...
    >
    > I didn' test this, but please consider the following:
    >
    > [code snipped]
    >
    >
    >>while (my $connection = $listen_socket->accept()) {
    >>
    >> my $pid;
    >> if (!defined($pid = fork)) {
    >> logmsg "cannot fork: $!";
    >>
    >> }elsif ($pid) {
    >> logmsg "begat $pid";
    >> }else{
    >> # else i'm the child -- go spawn
    >> print $connection "Command?";
    >> while ( <$connection> ){
    >>
    >> if (/quit|exit/i) {
    >>last; }
    >
    >
    > This gets the child out of the 'while ( <$connection> )' loop, but leaves it in the 'while (my $connection = $listen_socket->accept())' loop. So the child never dies, but listens for new connections.
    > Entering the command dieT at your prompt should really kill the child.
    >
    >
    >
    >> 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; }
    >
    >
    > dieT is a typo, isn't it.
    >
    > hth.
    >
    bob Guest

  6. #6

    Default Re: Tring to kill my kids, but they are stuborn little s!

    Hi,

    This is another example I did = cut from examples.

    This one, works, but when I exit the whole thing including the parent die!

    #!/usr/bin/perl -w

    use strict;
    use POSIX ();
    use POSIX 'WNOHANG';
    #use POSIX ":sys_wait_h";
    use FindBin ();
    use File::Basename ();
    use File::Spec::Functions;
    use Net::hostent;
    use Carp;
    use Data::Dumper;
    use Asiadebit;

    $|=1;
    sub spawn; # forward declaration
    sub logmsg { print "$0 $$: _ at ", scalar localtime, "\n" }


    #use IO::Socket::INET;
    use IO::Socket;


    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 "reaped $wpid" . ($? ? " with exit $?" : '');

    }



    }




    code();



    sub code {
    print "PID: $$\n";
    print "ARGV: ARGV\n";
    open (DIED, ">>/var/log/daemon_log") or warn "$!";


    my $c = 0;
    #while (++$c) {
    # sleep 2;
    # my $bob = `w`;
    # print DIED "$bob\n";

    #print "$c\n";
    #}
    print "[Server $0 accepting clients]\n";
    while (my $connection = $listen_socket->accept()) {
    $connection->autoflush(1);
    print $connection "Welcome to $0; type help for command list.\n";
    my $hostinfo = gethostbyaddr($connection->peeraddr);
    printf "[Connect from %s]\n", $hostinfo->name || $connection->peerhost;
    print $connection "Command? ";



    spawn sub {

    while ( <$client>) {
    next unless /\S/; # blank line
    if (/quit|exit/i) { last; }
    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; }
    elsif (/spawnme/i ) { spawn \&code(); }
    elsif (/cleanme/i ) { REAPER(); }
    elsif (/debug/i ) { print Dumper($client);}
    elsif (/spawn/i) {

    spawn sub {

    sleep 1;

    print "Hello there, it's now ", scalar localtime, "\n";

    sleep 3;

    print "EXITING\n";
    #exec '/usr/games/fortune'
    # or confess "can't exec fortune: $!";
    };

    }
    elsif (/alarmtest/i) { test_alarm(); }
    elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
    elsif (/AUTH/i ) { print do_auth($_) }
    else {
    print $client "Commands: quit date who cookie motd\n";
    print DIED "Commands: quit date who cookie motd\n";
    }


    ### print the prompt again regardless of input...
    print $connection "Command? ";
    }
    close $connection;
    } ## end 2nd while

    } ### end code sub

    } ## end 1st while

    sub test_alarm {


    alarm 5;

    while (1>0){
    sleep 1;
    print "$_ to go";

    }



    }

    sub spawn {

    my $coderef = shift;


    #local $SIG{CHLD} = \&REAPER;

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

    unless (_ == 0 && $coderef && ref($coderef) eq 'CODE') {
    confess "usage: spawn CODEREF";
    }
    my $pid;
    if (!defined($pid = fork)) {
    logmsg "cannot fork: $!";
    return;
    } elsif ($pid) {
    logmsg "begat $pid";
    return; # i'm the parent
    }
    # else i'm the child -- go spawn
    #open(STDIN, "<$client") || die "can't dup client to stdin";
    #open(STDOUT, ">$client") || die "can't dup client to stdout";
    #open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";


    #### Works but we need the connected socket object!!!!
    #STDIN->fdopen($client,"r") || die "can't dup client to stdin";
    #STDOUT->fdopen($client,"w") || die "can't dup client to stdout";
    #STDERR->fdopen($client,"w") || die "can't dup stdout to stderr";



    exit &$coderef();



    }



    Heinrich Mislik wrote:
    > In article <3F64B2EB.3E7E39CAdmcontact.com>, [email]ericdmcontact.com[/email] says...
    >
    > I didn' test this, but please consider the following:
    >
    > [code snipped]
    >
    >
    >>while (my $connection = $listen_socket->accept()) {
    >>
    >> my $pid;
    >> if (!defined($pid = fork)) {
    >> logmsg "cannot fork: $!";
    >>
    >> }elsif ($pid) {
    >> logmsg "begat $pid";
    >> }else{
    >> # else i'm the child -- go spawn
    >> print $connection "Command?";
    >> while ( <$connection> ){
    >>
    >> if (/quit|exit/i) {
    >>last; }
    >
    >
    > This gets the child out of the 'while ( <$connection> )' loop, but leaves it in the 'while (my $connection = $listen_socket->accept())' loop. So the child never dies, but listens for new connections.
    > Entering the command dieT at your prompt should really kill the child.
    >
    >
    >
    >> 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; }
    >
    >
    > dieT is a typo, isn't it.
    >
    > hth.
    >
    bob Guest

  7. #7

    Default Re: Tring to kill my kids, but they are stuborn little s!

    bob <ericdmcontact.com> wrote:
    > This one, works, but when I exit the whole thing including the
    > parent die!
    > $SIG{CHLD} = \&REAPER_NEW;
    >
    > while (my $connection = $listen_socket->accept()) {
    I already told you why this is happening.

    When the child exits, SIGCHLD will interrupt the accept() system
    call. Perl 5.8 installs %SIG handlers without SA_RESTART, and so
    accept() fails when interrupted. (And then the parent falls out
    of its loop and exits.)

    --
    Steve
    Steve Grazzini Guest

  8. #8

    Default Re: Tring to kill my kids, but they are stuborn little s!

    Hi,

    I think I see that happening, and know you are right, but this doesn't
    seem to matter.

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


    Sorry if I am being clueless, but I have done a lot of reading and
    working at this, but I seem to keep getting it wrong.

    Here is a sample run, with what I write to my log file:

    secure# ./franken_socket.pl &
    [1] 7186
    secure# PID: 7186
    ARGV:
    [Server ./franken_socket.pl accepting clients]

    secure# telnet localhost 1081
    Trying 127.0.0.1...
    Connected to localhost.
    Escape character is '^]'.
    Command?who
    root ttyp0 Sep 11 10:51 (24.68.221.164)
    root ttyp1 Sep 11 10:52 (24.68.221.164)
    root ttyp2 Sep 11 11:23 (24.68.221.164)
    Command?quit
    Connection closed by foreign host.
    [1] + Done ./franken_socket.pl


    Log file cotains:

    ../franken_socket.pl 7194: got - CHLD
    at Mon Sep 15 05:49:55 2003
    I got forked
    ../franken_socket.pl 7186: begat 7194 at Mon Sep 15 05:49:54 2003
    begat 7194
    ../franken_socket.pl 7186: got - CHLD
    at Mon Sep 15 05:49:58 2003
    ../franken_socket.pl 7186: main 7194 -- reaped 1 at Mon Sep 15 05:49:58 2003
    reaped 1



    This is what I am running above:

    #!/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;
    };

    $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; exit(0); }
    elsif (/who/i ) { print $connection `who 2>&1`;}
    elsif (/dienow/i ) { alarm 2; exit(0); }
    elsif (/dieT/i ) { die; }

    print $connection "Command?";

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


    } ## end while <$connection>

    } ## end else

    close ($listen_socket);



    Steve Grazzini wrote:
    > bob <ericdmcontact.com> wrote:
    >
    >>This one, works, but when I exit the whole thing including the
    >>parent die!
    >> $SIG{CHLD} = \&REAPER_NEW;
    >>
    >> while (my $connection = $listen_socket->accept()) {
    >
    >
    > I already told you why this is happening.
    >
    > When the child exits, SIGCHLD will interrupt the accept() system
    > call. Perl 5.8 installs %SIG handlers without SA_RESTART, and so
    > accept() fails when interrupted. (And then the parent falls out
    > of its loop and exits.)
    >
    bob Guest

  9. #9

    Default Re: Tring to kill my kids, but they are stuborn little s!

    Hi,

    I just wanted to confirm, this exact code does work prefectly in Perl
    5.6. So Steve, you are certainly correct. I just don't know how to fix
    it in 5.8.

    Thanks,

    Eric

    bob wrote:
    > Hi,
    >
    > I think I see that happening, and know you are right, but this doesn't
    > seem to matter.
    >
    > #while (my $connection = $listen_socket->accept()) {
    > while (1) {
    > my $connection = $listen_socket->accept() or do {
    > next if $!{EINTR};
    > last;
    > };
    bob Guest

Similar Threads

  1. How do I kill it?
    By rufus2 in forum Macromedia Flash Player
    Replies: 0
    Last Post: May 15th, 04:28 AM
  2. How to kill client var?
    By alecken in forum Coldfusion - Getting Started
    Replies: 2
    Last Post: November 22nd, 11:04 AM
  3. CFM will kill iis when off
    By theAgencyMan in forum Coldfusion Server Administration
    Replies: 1
    Last Post: September 23rd, 01:40 PM
  4. How to kill gdm??
    By Zhao You Bing in forum Debian
    Replies: 1
    Last Post: July 21st, 02:30 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

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 136 137 138 139