Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: Forking

by etcshadow (Priest)
on Jan 04, 2005 at 21:22 UTC ( #419415=note: print w/replies, xml ) Need Help??


in reply to Forking

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 }
------------ :Wq Not an editor command: Wq

Replies are listed 'Best First'.
Re^2: Forking
by andy7t (Initiate) on Jan 05, 2005 at 21:50 UTC
    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?
      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';

      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;

      Enjoy!

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://419415]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (11)
As of 2019-05-23 18:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you enjoy 3D movies?



    Results (146 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!