By Newbies for Newbies. This is an implentation of a simple Client/Server script. It uses IPC, forks, and IO:Socket:INET. I found it fairly confusion and thought people would like to see some commented code.

I know this isn't the best code so comments are very welcome!!!
SERVER PORTION: 
######################################################################
+###
##
##  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, IP
+C,
##  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 h
+e
##  is ready for him to close is connection (I don't know if it is nec
+essary
##  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 connecti
+on
        {
            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 hones
+tly 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 t
+he 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 re
+ady
                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 t
+o talk

                    if ($response) {  # Make sure we really got someth
+ing
                        chomp $response;
                        if ($response eq "ping") {  ## If the client s
+aid ping its our turn to say pong
                            warn "ping\n";
                            print $client "pong\n";
                        }
                        elsif ($response eq "quit") {  ## Not really u
+sed 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 sock
+et 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 e
+xit;
                #########
                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 start
+ed up
                ## We do this so I don't close the socket connection b
+efore he can get started up
                 
                while(chomp($line = <CHILD_RDR>)) {
                    if ($line eq "Going") {
                        last;
                    }
                    sleep(1); ## Check every one second....I don't kno
+w if this is needed
                }

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

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

    close($socket);

[download]
CLIENT PORTION: (you need to change PeerAddr to reflect who you want to connect to) 
######################################################################
+###
##
##  myClient.pl by Jake Roberts.
##
##  A newbies attempt at TCP socket networking and Perl
##
##  This client plays ping pong with the server.  Its rather simple.
##
##  It does demonstrate the importance of defining a protocol for spea
+king
##  to the server.  The client must wait his turn to print to the $soc
+ket or
##  you can get locked up.
##
##  That idea was a real trip up for me as a newbie.
##
##  Most of the network/socket stuff was taken from examples from
##  www.perlmonks.org an excellent web site
##
##
######################################################################
+###

#!/perl/bin/perl -w

    use strict;
    use warnings;

    use IO::Socket::INET;


## Open a connection to the server
    my $socket = IO::Socket::INET->new(
                            PeerAddr => 'localhost',
                                PeerPort => '1776',
                              Proto    => "tcp",
                              Type     => SOCK_STREAM)
                        or die "Socket::INET->new: $!\n\n";


## Modes
# 1 = Waiting for server connection
# 2 = Wait for Pong then Send Ping


## Play Ping ping with the server
    my $mode = 1;

    while (1) {
        my $response = <$socket>;   ## Read data from Server  ## It wi
+ll wait here until it recieves a \n from the server
                                    ## Reading data from the server th
+is way kind of sucks because you don't have any type of timeout


        if ($response) {  ## Important to check because if the connect
+ion is closed then $response will be undef
            chomp $response;  ## Remove the \n


            ############
            ##  This is my ping Protocal.
            ##  The client and server MUST take turns talking or they 
+will get stuck
            ##  So...first the client waits for a Connection Establish
+ed signal....
            ##  then the client sends a ping to the server and waits h
+is turn and listens
            ##  for a pong.  When a pong is recieved a ping is sent ag
+ain...and so on.
            ##  They must play like good children and take turns talki
+ng and listening
            ############

            ## Mode 1 -- Waiting for connection signal
            if ($mode == 1) {
                if ($response eq "Connection Established") {
                    print $response,"\n";
                    print $socket "ping\n";  ## The server send a Conn
+ect so now its our turn to say ping
                    print "ping...";
                    $mode = 2;
                }
            } elsif ($mode == 2) {   ## We sent a ping and now we must
+ wait for a pong before talking again.
                if ($response eq "pong") { ## We recieved a pong
                    print "pong\n";
                    sleep(3);    ## Wait just so things to fly by too 
+fast
                    print $socket "ping\n";  ## Now its our turn to ta
+lk...say ping
                    print "ping...";
                    $mode = 2;  ## Now that we said ping wait for a po
+ng
                }
            } else {  ## Just in case some wierd thing happens
                close($socket);
                die "Entered invalid mode";
            }

        } else {  ## We got an undef and therefore?? the connection wa
+s closed.
            print "Lost connection\n";
            last;
        }
    }


    close($socket);

exit 0;

[download]

Replies are listed 'Best First'.
Re: Newbies TCP Networking
by tadman (Prior) on Jul 07, 2001 at 12:49 UTC
    Just a few minor points to enhance your example:
    1. You should probably use IO::Select to show how simple multiplexing IO can be done, or at least use non-blocking sockets ($socket->blocking(0)). The next question people ask is often along these lines, so take the initiative.
    2. If you're using IO::Socket, you should say $socket->close() instead of close($socket). Use object methods wherever possible.
    3. Likewise, you could be using $socket->getline() instead of <$socket> to read a single line. If you're so embittered about using IO::Handle ("thousands of lines") then why not make more use of it?
    4. s/protocal/protocol/i
    5. I'm not sure why you've indented your entire program four spaces. It ruins registration and is causing massive linewrapping problems in the PM code display window
    6. Your program is "paranoid" in that you are checking for a condition which can never be true. According to your code, there is no way that $mode could ever be 1 or 2, and you are checking for a hypothetical third condition. The only way this is going to happen is if you have bad ram, aliens abduct your computer, or you're hacking around in the debugger.
    7. Read up on IPC pipe code, and then post your explanation too. No sense in answering questions with a question.
[reply]
[d/l]
[select]
      Like I said.....By a newbie :)

      I didn't use IO::Select because I couldn't find any useful examples for it. Since I really don't know what I'm doing I had to go by what I could find examples for.

      Thanks for the $socket->close(). Again with little docs and based on examples I found I didn't even know I could do it that way.

      I indent my code as I program, It makes for easy readibility (I use a 4 space tab)...Sorry that it screwed up so much on the page.

      My "paranoid" client is a scaled down uncleaned version. I had 3 conditions but removed one and I also feel that including an extra (even if impossible) else statement is good for debugging.

      I've got lots to learn about IPC. I don't think I understand it too well. I was using some server code found on the site and when it forked it seemed to lose the connection or something. Someone suggested putting a sleep(5) line in and that seemed to fix it, but I wasn't satified with that kind of a fix. I wanted to see if I could get the processes to talk to each other so they could confirm having started before closing any connections. I think I accomplished that, but then again I don't really know much about IPC.

      (That comment about IO:Handle and the thousands of lines is from a search: perlipc example....I just didn't take it out.)

      :) Thanks for the comments
[reply]
        If you're really feeling "paraniod", you have to be very careful not to fall in the "defensive programming" mode which can be very damaging. With defensive programming, your function which should do something, but receives bad input, does nothing. You just created a ticking time-bomb, because sooner or later some other function is going to set it off, and you'll have no idea where the problem came from.

        Consider: 
        sub OpenSomething
{
      my ($param) = @_;

      # What kind of an idiot would forget the foo parameter!
      return unless (defined $param->{foo});

      my $thing = new Object ($param->{foo}, $param->{zoo});
      $thing->open($param->{foozoo});

      return $thing;
}

sub CloseSomething
{
      my ($thing) = @_;
      $thing->close();
}

        [download]
        Now, in your program you will call OpenSomething(), which might actually return nothing. You forget to check if you got anything back, so later on when you call CloseSomething() you get an error. The error, it would seem, originates in CloseSomething().

        Of course, you could just get more defensive: 
        sub CloseSomething
{
      my ($thing) = @_;

      # Maybe they forgot to pass the parameter?
      return unless (defined $thing);

      $thing->close();
}

        [download]
        Now what you have done, effectively, is swept all these errors under the carpet. They don't manifest, and they don't cause "errors" in the visible sense, but there may be problems with the way your program runs that doesn't make any sense.

        It is probably better to die and get it over with: 
        sub OpenSomething
{
      my ($param) = @_;

      # What kind of an idiot would forget the foo parameter!
      die "No 'foo' param passed to OpenSomething()" unless (defined $
+param->{foo});

      my $thing = new Object ($param->{foo}, $param->{zoo});
      $thing->open($param->{foozoo});

      return $thing;
}

sub CloseSomething
{
      my ($thing) = @_;

      die "Cannot CloseSomething() with undefined parameter" unless (d
+efined $thing);
      $thing->close();
}

        [download]
        Using die in this capacity is similar to the ASSERT() macro used in C programming which will completely halt the program if something is seriously out of line.

        If the train comes off the tracks, you'd best stop it.
[reply]
[d/l]
[select]
        OOps Forgot to login :) Otijim
[reply]

Back to Cool Uses for Perl