Chapter 19. Interprocess Communication with Pipes and Sockets

19.1.1. The Media Change Client, mediachangec

When the system backup reaches end of volume, it executes this incredibly simple client code, specifying the IP address of the media change server plus a message string to display. The code first opens a socket to the server and unbuffers it.[49]

[49] The autoflush call is not required in recent versions of IO::Socket but is included for completeness.

The PeerAddr and PeerPort options specify the host to contact and the TCP/IP port the server listens on. The client code then outputs the message on the socket, reads the operator's response from the socket, and prints it on STDOUT.

use IO::Socket;

do {print "Usage:  mediachangec host message\n"; exit} unless @ARGV == 2;

$sock = IO::Socket::INET->new(
    PeerAddr => $ARGV[0],
    Proto    => 'tcp',
    PeerPort => 8979,
);
die "Cannot connect: $!" unless defined $sock;
$sock->autoflush(1);

print $sock $ARGV[1], "\n";     # send operator message
print STDOUT <$sock>;           # display operator response

As shown in Figure 19-1, the response comes directly from a messageBox widget posted on the server's display and can be either "Ok" or "Cancel."

Figure 19-1. A media change operator message

19.1.2. The Media Change Server, mediachanged

We're about to see a forking TCP/IP server, sometimes called a network daemon. In typical Unix fashion, we'll call it mediachanged, with the trailing d identifying it as a daemon program. This bare-bones example serves as the basis for the much more complicated IPADM server discussed in the remaining sections of this chapter.

The following code is initiated on the media change server at boot time and runs forever. It opens a listen socket on the little-known port 8979 and, as requests arrive, it forks a new child that creates a Tk MainWindow with a lone messageBox widget. Here are the preamble statements:

#!/usr/local/bin/perl -w
# 
# mediachanged - media change daemon.
#
# Wait for connect on our well known port, display the received message
# in a Tk messageBox, and return the operator's reply.

use 5.005;
use IO::Handle;
use IO::Socket;
use Net::hostent;
use POSIX qw/setsid/;
use Tk;
use subs qw/client_connect/;
use strict;

This statement ensures that the daemon's children are properly disposed of after they terminate:

$SIG{CHLD} = sub {wait};

The program backgrounds itself by forking and terminating the parent:

my $pid = fork;
die "fork failed: $!" unless defined $pid;
exit if $pid;                   # parent exits, daemon continues
setsid or die "setsid failed: $!";

Here we create a listen socket, distinct from the client's connect socket, differentiated by the Listen option that specifies how many simultaneous incoming connections on port 8979 are possible:

my $server = IO::Socket::INET->new(
    Proto     => 'tcp',
    LocalPort => 8979,
    Listen    => SOMAXCONN,
    Reuse     => 1,
);

die "Socket::INET::new failed: $!" unless defined $server;

At last, here is the daemon's main loop, where it blocks on the accept statement until a media change request arrives. It then makes a (very) feeble attempt at authentication by verifying that the peer's IP address is from a legal subnet (192.168.x.x). Unfortunately, an IP address is easily spoofed, so this authentication scheme is unreliable. Nevertheless, within the context of an isolated machine room, the data is useful enough, so we initialize the variable $from with the peer's human-readable IP name.

The daemon then quickly spawns a child to handle the request and resumes waiting on the accept. The child unbuffers the network socket, $ns, and calls client_connect to continue processing.

while (my $ns = $server->accept) {

    my $peeraddr = $ns->peeraddr;
    my $hostinfo = gethostbyaddr($peeraddr);
    my $remote_host = $hostinfo->name || $ns->peerhost;
    my(@inetaddr) = unpack('C4', $peeraddr);
    my $from = "Message from $remote_host (" . join('.', @inetaddr) . ')';
    unless ($inetaddr[0] == 192 and $inetaddr[1] == 168) {
        close $ns;
        next;
    }
 
    if (my $pid = fork) {
        close $ns or die "Client socket close failed: $!";
    } elsif (defined $pid) {
        $ns->autoflush(1);
        client_connect $ns, $from;
    } else {
        die "fork error: $!";
    }
    
} # whilend forever network daemon

Subroutine client_connect first reads the media change message from the network socket. Then it creates the MainWindow, withdraws it, creates a 15-second repeating timer event to ring the bell and alert the operator, and posts an OKCancel messageBox dialog widget. Eventually the operator interacts with the messageBox, which returns either the string OK or the string Cancel. This reply string is sent to the peer via the network socket, and we're done.

sub client_connect {

    # Process a client connect - send our client either an "Ok" or
    # "Cancel" string, depending upon how the media change went.

    my($ns, $from) = @_;

    chomp( $_ = <$ns> );

    my $mw = MainWindow->new;
    $mw->withdraw;
    $mw->bell;
    $mw->repeat(15 * 1000 => sub {$mw->bell});
    my $reply = $mw->messageBox(
        -icon       => 'info',
        -type       => 'OKCancel',
        -message    => "$from\n\n$_",
        -wraplength => '6i',
        -title      => 'mediachanged',
        -background => '#ECFFFF',
    );
    print $ns "$reply\n";
    close $ns;
    exit;

} # end client_connect

Armed with the know-how to build a TCP/IP client/server, let's examine a more complicated scenario involving a Perl/Tk client.