andy7t has asked for the wisdom of the Perl Monks concerning the following question:

Hi, Straight to the point. I'm confused by forking!
I have a while loop:

while ($new_sock = $sock->accept()) {
# HERE I WOULD LIKE TO FORK

#Do lots of stuff
}

I can get it to fork, but the processes just stay open, even though they have reached the end of the while loop.
What's the best way of forking at that point?

Considered: etcshadow "do we still hate one-word titles"
Unconsidered by castaway: Keep/Edit/Delete: 11/22/0 - not a useful consideration

Replies are listed 'Best First'.
Re: Forking
by etcshadow (Priest) on Jan 04, 2005 at 21:22 UTC
    You basically want to do something like: 
    while ($new_sock = $sock->accept()) {
   # fork returns undef if it failed, zero if you are
   # in the child process and the kid's pid if you are
   # in the parent... thus, by checking the return value
   # of the fork you know if you are the parent or you
   # are the child... since in all other ways the two
   # are identical in their state and execution
   my $pid = fork;
   die "Couldn't fork: $!\n" unless defined $pid;
   if (!$pid) {
       # if you are the kid, then

       # DO STUFF

       # and then EXIT when done.  That's right, you
       # were a process created to perform a certain
       # task, and you have performed it, so now exit.
       # if you DON'T exit, you'll just return to the
       # top of the loop.
       exit;
   }

   # if you were the parent, of course, you didn't go
   # into that if block, and you just quickly cycle 
   # back around to the top of the loop
}

    [download]
    ------------
:Wq
Not an editor command: Wq

    [download]
[reply]
[d/l]
[select]
      Hi Again,

      That works great!
      But there is one small problem.

      A quick run down of what i'm doing.
      I've created a simple webserver (mainly because Apache can't execute root commands, but thats another story).
      So, i have this: 
      #START MY LISTENING DAEMON WITH HTTP::DAEMON

# Fork to begin with so that it can run from 
# shell in the background
my $mainpid = fork;
  if(!$mainpid)
  {
     while ($new_sock = $sock->accept()) {
     # Theres a connection, fork it so that that user 
     # has there own dedicated process
     
      my $pid = fork; 
       if(!$pid)
         { 
       while (my $request_obj = $new_sock->get_request()) {
        #This is a new HTTP header, and is basically a 
        #request for a page
        #Fork again

           my $pid2 = fork;
           if(!$pid2) {

             #RETURN THE PAGE 

                      exit; #This kill $pid 
                      }

        	} #End reading the object
	exit; #Kill the child
       }#End Fork2	

     } #End Accept Request
    } # End the main fork

      This code works fine. The problem is, it leaves behind lots of these:
      root 5066 0.0 0.0 0 0 pts/1 Z 21:33 0:00 perl <defunct>
      What's causing it?
[reply]
        Well, in short, what's causing it is that *nix won't clean up a process until its parent has collected its status. That is, the process manager is holding onto such information as the exit status of the process, so that the parent can call waitpid on it.

        Anyway, it's really easy to deal with this in perl... you just add this line to the top of your script: 

        $SIG{CHLD} = 'IGNORE';

        [download]

        Now, as for writing your own web server... to do this as a learning exercise is cool and all, but I think you'd really be much better off using an already existing one (such as apache) for real use. It's easier to work around the problems of not being able to run the web server as root (which you really shouldn't be doing! there's a good reason apache wants you to setuid to an unpriveleged user!) than to work out all of the stuff that apache can do for you.

        That all being said, though, here's a simple web server that I once wrote (as a learning exercise)... just to give you some more example code. I'm not claiming it to be super good or secure or anything... but it is a good example of forking in practice. I think it borrows pretty heavily from an example in the Perl Cookbook (which you might want to get a copy of). 

        use IO::Socket;
use Sys::Hostname;
use strict;

my $docroot = shift || die "Usage: $0 (document root path) [server por
+t (default 80)]\n";
my $port = shift || 80;
my $serverhandle = IO::Socket::INET->new(
    Proto => 'tcp',
    Listen => SOMAXCONN,
    LocalAddr => Sys::Hostname::hostname(),
    LocalPort => $port) or die "Could not listen on port $port... $!\n
+";

my $CRLF = "\015\012";
my $error404 = "<html><head><title>404 Not Found</title><body><h1>Erro
+r 404 File Not Found</h1>
                The requested URL could not be located on this server.
+</body></html>";
my $error501 = "<html><head><title>501 Not Implemented</title><body><h
+1>Error 501 Method Not Implemented</h1>
                The http method in your request is not implemented by 
+this server.</body></html>";
my $otherheaders = "Server: Steve's 60-line web server${CRLF}Connectio
+n: close${CRLF}";
my $htmlheader = "Content-Type: text/html$CRLF";
my $textheader = "Content-Type: text/plain$CRLF";
$/ = "$CRLF$CRLF";
$SIG{CHLD} = 'IGNORE';
while (my $clienthandle = $serverhandle->accept) {
    my $inpid = fork;
    if (!defined $inpid) {
        die "Could not fork: $!";
    } elsif ($inpid) {
        $clienthandle->close;
        next;
    }

    my $name = $clienthandle->peerhost;
    my $request = <$clienthandle>;
    my ($method,$url,$httpversion,$headers) = ($request =~ /(\S+)\s+(\
+S+)\s+HTTP\/(\S+)$CRLF(.*)/s);
    print localtime()." - $name - \"$method $url HTTP/$httpversion\" -
+";
    if (uc $method eq 'GET') {
        my $nofile = 0;
        open GETFILE,$docroot.$url or $nofile = 1;
        if ($nofile) {
            print $clienthandle "HTTP/1.1 404 Not Found$CRLF$otherhead
+ers$htmlheader"
                ."Content-Length: ".length($error404).$CRLF.$CRLF.$err
+or404;
            print " 404\n";
        } else {
            my $buffer = '';
            while (<GETFILE>) {
                $buffer .= $_;
            }
            close GETFILE;
            my $contenttype = ($url =~ /\.html?$/) ? $htmlheader : $te
+xtheader;
            print $clienthandle "HTTP/1.1 200 OK$CRLF$otherheaders"
                ."Content-Length: ".length($buffer).$CRLF.$CRLF.$buffe
+r;
            print " 200\n";
        }
    } else {
        print $clienthandle "HTTP/1.1 501 Not Implemented$CRLF$otherhe
+aders$htmlheader"
            ."Content-Length: ".length($error501).$CRLF.$CRLF.$error50
+1;
        print " 501\n";
    }
    close $serverhandle;
    close $clienthandle;
    exit;
}
close $serverhandle;

        [download]

        Enjoy! 

        ------------
:Wq
Not an editor command: Wq

        [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom