Website hosting service by Active-Venture.com
  

 Back to Index

Sockets: Client/Server Communication

While not limited to Unix-derived operating systems (e.g., WinSock on PCs provides socket support, as do some VMS libraries), you may not have sockets on your system, in which case this section probably isn't going to do you much good. With sockets, you can do both virtual circuits (i.e., TCP streams) and datagrams (i.e., UDP packets). You may be able to do even more depending on your system.

The Perl function calls for dealing with sockets have the same names as the corresponding system calls in C, but their arguments tend to differ for two reasons: first, Perl filehandles work differently than C file descriptors. Second, Perl already knows the length of its strings, so you don't need to pass that information.

One of the major problems with old socket code in Perl was that it used hard-coded values for some of the constants, which severely hurt portability. If you ever see code that does anything like explicitly setting $AF_INET = 2, you know you're in for big trouble: An immeasurably superior approach is to use the Socket module, which more reliably grants access to various constants and functions you'll need.

If you're not writing a server/client for an existing protocol like NNTP or SMTP, you should give some thought to how your server will know when the client has finished talking, and vice-versa. Most protocols are based on one-line messages and responses (so one party knows the other has finished when a "\n" is received) or multi-line messages and responses that end with a period on an empty line ("\n.\n" terminates a message/response).

Internet Line Terminators

The Internet line terminator is "\015\012". Under ASCII variants of Unix, that could usually be written as "\r\n", but under other systems, "\r\n" might at times be "\015\015\012", "\012\012\015", or something completely different. The standards specify writing "\015\012" to be conformant (be strict in what you provide), but they also recommend accepting a lone "\012" on input (but be lenient in what you require). We haven't always been very good about that in the code in this manpage, but unless you're on a Mac, you'll probably be ok.

Internet TCP Clients and Servers

Use Internet-domain sockets when you want to do client-server communication that might extend to machines outside of your own system.

Here's a sample TCP client using Internet-domain sockets:

 
    #!/usr/bin/perl -w
    use strict;
    use Socket;
    my ($remote,$port, $iaddr, $paddr, $proto, $line);

    $remote  = shift || 'localhost';
    $port    = shift || 2345;  # random port
    if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
    die "No port" unless $port;
    $iaddr   = inet_aton($remote) 		|| die "no host: $remote";
    $paddr   = sockaddr_in($port, $iaddr);

    $proto   = getprotobyname('tcp');
    socket(SOCK, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
    connect(SOCK, $paddr)    || die "connect: $!";
    while (defined($line = <SOCK>)) {
	print $line;
    }

    close (SOCK)	    || die "close: $!";
    exit;  

And here's a corresponding server to go along with it. We'll leave the address as INADDR_ANY so that the kernel can choose the appropriate interface on multihomed hosts. If you want sit on a particular interface (like the external side of a gateway or firewall machine), you should fill this in with your real address instead.

 
    #!/usr/bin/perl -Tw
    use strict;
    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    use Socket;
    use Carp;
    my $EOL = "\015\012";

    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

    my $port = shift || 2345;
    my $proto = getprotobyname('tcp');

    ($port) = $port =~ /^(\d+)$/                        or die "invalid port";

    socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
					pack("l", 1)) 	|| die "setsockopt: $!";
    bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
    listen(Server,SOMAXCONN) 				|| die "listen: $!";

    logmsg "server started on port $port";

    my $paddr;

    $SIG{CHLD} = \&REAPER;

    for ( ; $paddr = accept(Client,Server); close Client) {
	my($port,$iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr,AF_INET);

	logmsg "connection from $name [",
		inet_ntoa($iaddr), "]
		at port $port";

	print Client "Hello there, $name, it's now ",
			scalar localtime, $EOL;
    }  

And here's a multithreaded version. It's multithreaded in that like most typical servers, it spawns (forks) a slave server to handle the client request so that the master server can quickly go back to service a new client.

 
    #!/usr/bin/perl -Tw
    use strict;
    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    use Socket;
    use Carp;
    my $EOL = "\015\012";

    sub spawn;  # forward declaration
    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

    my $port = shift || 2345;
    my $proto = getprotobyname('tcp');

    ($port) = $port =~ /^(\d+)$/                        or die "invalid port";

    socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
					pack("l", 1)) 	|| die "setsockopt: $!";
    bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
    listen(Server,SOMAXCONN) 				|| die "listen: $!";

    logmsg "server started on port $port";

    my $waitedpid = 0;
    my $paddr;

    use POSIX ":sys_wait_h";
    sub REAPER {
	my $child;
        while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
	    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
	}
	$SIG{CHLD} = \&REAPER;  # loathe sysV
    }

    $SIG{CHLD} = \&REAPER;

    for ( $waitedpid = 0;
	  ($paddr = accept(Client,Server)) || $waitedpid;
	  $waitedpid = 0, close Client)
    {
	next if $waitedpid and not $paddr;
	my($port,$iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr,AF_INET);

	logmsg "connection from $name [",
		inet_ntoa($iaddr), "]
		at port $port";

	spawn sub {
	    $|=1;
	    print "Hello there, $name, it's now ", scalar localtime, $EOL;
	    exec '/usr/games/fortune'		# XXX: `wrong' line terminators
		or confess "can't exec fortune: $!";
	};

    }

    sub spawn {
	my $coderef = shift;

	unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
	    confess "usage: spawn CODEREF";
	}

	my $pid;
	if (!defined($pid = fork)) {
	    logmsg "cannot fork: $!";
	    return;
	} elsif ($pid) {
	    logmsg "begat $pid";
	    return; # I'm the parent
	}
	# else I'm the child -- go spawn

	open(STDIN,  "<&Client")   || die "can't dup client to stdin";
	open(STDOUT, ">&Client")   || die "can't dup client to stdout";
	## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
	exit &$coderef();
    }  

This server takes the trouble to clone off a child version via fork() for each incoming request. That way it can handle many requests at once, which you might not always want. Even if you don't fork(), the listen() will allow that many pending connections. Forking servers have to be particularly careful about cleaning up their dead children (called "zombies" in Unix parlance), because otherwise you'll quickly fill up your process table.

We suggest that you use the -T flag to use taint checking (see perlsec) even if we aren't running setuid or setgid. This is always a good idea for servers and other programs run on behalf of someone else (like CGI scripts), because it lessens the chances that people from the outside will be able to compromise your system.

Let's look at another TCP client. This one connects to the TCP "time" service on a number of different machines and shows how far their clocks differ from the system on which it's being run:

 
    #!/usr/bin/perl  -w
    use strict;
    use Socket;

    my $SECS_of_70_YEARS = 2208988800;
    sub ctime { scalar localtime(shift) }

    my $iaddr = gethostbyname('localhost');
    my $proto = getprotobyname('tcp');
    my $port = getservbyname('time', 'tcp');
    my $paddr = sockaddr_in(0, $iaddr);
    my($host);

    $| = 1;
    printf "%-24s %8s %s\n",  "localhost", 0, ctime(time());

    foreach $host (@ARGV) {
	printf "%-24s ", $host;
	my $hisiaddr = inet_aton($host)     || die "unknown host";
	my $hispaddr = sockaddr_in($port, $hisiaddr);
	socket(SOCKET, PF_INET, SOCK_STREAM, $proto)   || die "socket: $!";
	connect(SOCKET, $hispaddr)          || die "bind: $!";
	my $rtime = '    ';
	read(SOCKET, $rtime, 4);
	close(SOCKET);
	my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
	printf "%8d %s\n", $histime - time, ctime($histime);
    }  

Unix-Domain TCP Clients and Servers

That's fine for Internet-domain clients and servers, but what about local communications? While you can use the same setup, sometimes you don't want to. Unix-domain sockets are local to the current host, and are often used internally to implement pipes. Unlike Internet domain sockets, Unix domain sockets can show up in the file system with an ls(1) listing.

 
    % ls -l /dev/log
    srw-rw-rw-  1 root            0 Oct 31 07:23 /dev/log  

You can test for these with Perl's -S file test:

 
    unless ( -S '/dev/log' ) {
	die "something's wicked with the log system";
    }  

Here's a sample Unix-domain client:

 
    #!/usr/bin/perl -w
    use Socket;
    use strict;
    my ($rendezvous, $line);

    $rendezvous = shift || '/tmp/catsock';
    socket(SOCK, PF_UNIX, SOCK_STREAM, 0)	|| die "socket: $!";
    connect(SOCK, sockaddr_un($rendezvous))	|| die "connect: $!";
    while (defined($line = <SOCK>)) {
	print $line;
    }
    exit;  

And here's a corresponding server. You don't have to worry about silly network terminators here because Unix domain sockets are guaranteed to be on the localhost, and thus everything works right.

 
    #!/usr/bin/perl -Tw
    use strict;
    use Socket;
    use Carp;

    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    sub spawn;  # forward declaration
    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

    my $NAME = '/tmp/catsock';
    my $uaddr = sockaddr_un($NAME);
    my $proto = getprotobyname('tcp');

    socket(Server,PF_UNIX,SOCK_STREAM,0) 	|| die "socket: $!";
    unlink($NAME);
    bind  (Server, $uaddr) 			|| die "bind: $!";
    listen(Server,SOMAXCONN)			|| die "listen: $!";

    logmsg "server started on $NAME";

    my $waitedpid;

    use POSIX ":sys_wait_h";
    sub REAPER {
	my $child;
        while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
	    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
	}
	$SIG{CHLD} = \&REAPER;  # loathe sysV
    }

    $SIG{CHLD} = \&REAPER;


    for ( $waitedpid = 0;
	  accept(Client,Server) || $waitedpid;
	  $waitedpid = 0, close Client)
    {
	next if $waitedpid;
	logmsg "connection on $NAME";
	spawn sub {
	    print "Hello there, it's now ", scalar localtime, "\n";
	    exec '/usr/games/fortune' or die "can't exec fortune: $!";
	};
    }

    sub spawn {
	my $coderef = shift;

	unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
	    confess "usage: spawn CODEREF";
	}

	my $pid;
	if (!defined($pid = fork)) {
	    logmsg "cannot fork: $!";
	    return;
	} elsif ($pid) {
	    logmsg "begat $pid";
	    return; # I'm the parent
	}
	# else I'm the child -- go spawn

	open(STDIN,  "<&Client")   || die "can't dup client to stdin";
	open(STDOUT, ">&Client")   || die "can't dup client to stdout";
	## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
	exit &$coderef();
    }  

As you see, it's remarkably similar to the Internet domain TCP server, so much so, in fact, that we've omitted several duplicate functions--spawn(), logmsg(), ctime(), and REAPER()--which are exactly the same as in the other server.

So why would you ever want to use a Unix domain socket instead of a simpler named pipe? Because a named pipe doesn't give you sessions. You can't tell one process's data from another's. With socket programming, you get a separate session for each client: that's why accept() takes two arguments.

For example, let's say that you have a long running database server daemon that you want folks from the World Wide Web to be able to access, but only if they go through a CGI interface. You'd have a small, simple CGI program that does whatever checks and logging you feel like, and then acts as a Unix-domain client and connects to your private server.

 

 

 

Domain name registration - 
Register cheap domain name from $7.95 and enjoy free domain services 
 

Cheap domain name search service -
Domain name services at just
$8.95/year only
 


Buy domain name registration and cheap domain transfer at low, affordable price.

2002-2004 Active-Venture.com Web Site Hosting Service

 

[ Computers do not solve problems, they execute solutions.   ]

 

 
 
 

Disclaimer: This documentation is provided only for the benefits of our web hosting customers.
For authoritative source of the documentation, please refer to http://www.perldoc.com