#########################################################################
##
##  myServer.pl by Jake Roberts.
##
##  A newbies attempt at TCP socket networking and Perl
##
##  This is a forking TCP server.  This is my first try with forks, IPC,
##  sockets, and protocols.
##
##  The server opens a socket and waits for a connection.  When one is
##  recieved a fork is made.  The child starts then tells the parent he
##  is ready for him to close is connection (I don't know if it is necessary
##  for the child to talk to the parent but I found that sometimes the parent
##  seemed to close the connection to fast.  I could have used sleep() but
##  that seems like a shody way to do it.)  Then the child begins ping pong, etc.
##
##  The parent continues waiting for connections and making babies.
##
##
##  That idea was a real trip up for me as a newbie.
##
##  The network/socket/fork/ipc stuff was taken from examples from
##  www.perlmonks.org (an excellent web site) and pieced together by
##  yours truely
##
##
#########################################################################

#!/perl/bin/perl -w

    use strict;
  	use warnings;

	#use Socket;
	use IO::Handle;     # thousands of lines just for autoflush :-(
	use IO::Socket::INET;




	# We say AF_UNIX because although *_LOCAL is the
	# POSIX 1003.1g form of the constant, many machines
	# still don't have it.


#ignore child processes to prevent zombies
	$SIG{CHLD} = 'IGNORE';


  	my $socket = IO::Socket::INET->new(	LocalPort => 1776,
          								Type      => SOCK_STREAM,
          								Reuse     => 1,
          								Listen    => 10 )
							or die "IO::Socket::INET->new : $!\n\n";

    warn "Server Started...\n";
    warn "Waiting for connections...\n";

	while ( my $client = $socket->accept() ) {  ## Wait for a connection
    	{
        	my $child;

			## Setup IPC so the parent waits until the child is ready before closing the connection.
            ## Taken from www.perlmonks.org search: perlipc    I honestly don't fully understand whats going on.
			pipe(PARENT_RDR, CHILD_WTR);                # XXX: failure?
	    	pipe(CHILD_RDR,  PARENT_WTR);               # XXX: failure?

			CHILD_WTR->autoflush(1);
			PARENT_WTR->autoflush(1);

			# perform the fork or exit
         	die "Can't fork: $!" unless defined ($child = fork());

		 	## Now there are two identical programs running, one is the child and should do one thing
            ## One is the parent and should do something else

			if ($child == 0) {   # I'm the child!
				# Close the child's listen socket, we dont need it the parent is the one listening.
            	$socket->close;

				## More confusing IPC stuff.  There we tell the parent that I'm up and going
				print PARENT_WTR "Going\n";  ## Tell the parent I'm ready
                close CHILD_RDR; close CHILD_WTR;  # Close my end IPC since I don't want to talk to myself
				close PARENT_RDR; close PARENT_WTR;  # Done talking to the Parent so close IPC to parent

				
				#########
				# Main child rountine
                #########

                ## The client needs this line to begin to talk
                print $client "Connection Established\n";
                
				## Ping Pong
                while (1) {
	                my $response = <$client>; ## Wait for the client to talk

					if ($response) {  # Make sure we really got something
						chomp $response;
    	                if ($response eq "ping") {  ## If the client said ping its our turn to say pong
                            warn "ping\n";
        	                print $client "pong\n";
            	        }
                	    elsif ($response eq "quit") {  ## Not really used but can be used for clean closure (We all need closure)
                    	    warn "Closing ",$client->peerhost,"\n";
                        	last;
	                    }
                    } else { ## We got an undef and therefore the socket is closed
        			    warn $client->peerhost," lost connection\n";  ## print who was lost to the console
		    	        last; ## and exit
                    }
                }


                #########
                # If the child subroutine returns, then clean up and exit;
                #########
				close($client);
				exit 0;

			}
         	else {   # I'm the parent!
                my $line;

				close PARENT_RDR; close PARENT_WTR; # Close my end IPC because I don't need to talk to myself

				# Send Connection notice to Console
             	warn "Connection recieved ... ",$client->peerhost,"\n";

                ## Wait for the child to talk to me and say he's started up
                ## We do this so I don't close the socket connection before he can get started up
             	
				while(chomp($line = <CHILD_RDR>)) {
                    if ($line eq "Going") {
						last;
					}
                    sleep(1); ## Check every one second....I don't know if this is needed
                }

				close CHILD_RDR; close CHILD_WTR; # Done talking to the child so close the IPC

				# Close the connection, its been passed it off to a child.
				$client->close();
         	}
		}
  	}

	close($socket);