19.5.1. The Forking Server

The daemon main loop simply accepts connects as they arrive, storing the network socket handle in $ns, which the child inherits after the fork. While the child handles the current request, the parent closes its copy of $ns and resumes listening for network activity.

my $server = IO::Socket::INET->new
    Proto     => 'tcp',
    LocalHost => $DAEMON_HOST,
    LocalPort => $DAEMON_PORT,
    Listen    => SOMAXCONN,
    Reuse => 1,
);
die "Socket::INET::new failed: $!" unless defined $server;

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

    my $pid = undef;
    if ($pid = fork) {
        close $ns or die "Client socket close failed: $!";
    } elsif (defined $pid) {
        $ns->autoflush(1);
        client_connect $ns;
    } else {
        die "fork error: $!";
    }

} # whilend forever network daemon

19.5.2. IPADM Message Handling

CONNECTED:
  while (1) {
      my(@data) = ( );

    COMMAND:
      while (1) {
          $_ = <$ns>;
          last CONNECTED unless defined $_;
          last COMMAND if /^$EOF$/;
          push @data, $_;
      } # whilend COMMAND

      $_ = $data[0];

    CASE: 
      {
          /get_subnet_list/ and do { gsl $ns, @data; last CASE };
          /get_subnet_file/ and do { gsf $ns, @data; last CASE };
          /put_subnet_file/ and do { psf $ns, @data; last CASE };
          /unl_subnet_file/ and do { usf $ns, @data; last CASE };
          print $ns "1 Unknown command '$_'";
      } # casend

      print $ns "$EOF\n";
  } # whilend CONNECTED

Perhaps the simplest example of an IPADM command processor is the subroutine gsl, the get_subnet_list handler. Assuming it can open the SDB directory, it creates an array of filenames ending in .sdb, then reads the first line of each file, and outputs the filename and title line on the network socket. Notice gsl also provides status and/or error messages.

sub gsl {

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

    unless (opendir S, $SDB_PATH) {
        print $ns "1 Cannot Read SDB Directory $SDB_PATH: $!.\n";
        return;
    }
    my(@dirent) = grep /^.+\.sdb$/, sort(readdir S);
    closedir S;
    print $ns "0 OK\n";
 
    while ($_ = shift @dirent) {
        open S, "$SDB_PATH/$_" or die "Cannot open $_: $!";
        my $title = <S>;
        ($title) = $title =~ /^\s*Title\s*=\s*(.*)$/;
        print $ns "$_ $title\n";
        close S;
    }

} # end get_subnet_list

19.5.3. Locking an SDB File

But LockFile doesn't lock the SDB files; it's more clever than that. Instead, it locks access to an entire lock directory, where it creates special symbolic links that encode which SDBs are locked, who owns the locks, and when the locks were created.

An SDB is locked with a call like this:

my $lock = LockFile->new($sdb, $id);

where $sdb is the SDB pathname and $id is a unique user identifier composed of username, hostname, and process ID. LockFile interlocks the lock directory by flocking a special file named single_thread.lock, then proceeds to create the specially coded symbolic link. Here's an example of what the lock directory might look like:

lrwxr-xr-x Aug 11 23:33 Subnet_128B.sdb-lock -> bug@Pandy:193041
-rw-r--r-- Jul 10 21:54 single_thread.lock

The symbolic link tells us what subnet is locked (subnet 128B, the Rubber Band Development department), when it was locked, and what username, computer, and process ID has the lock.

Because we know the time a subnet was locked, it's possible to implement lock timeouts. Once granted exclusive access to an SDB, an administrator has a guaranteed minimum amount of time to complete his work. Other lock requests arriving in this time period are granted only concurrent read access. After the lock timeout interval expires, someone else can grab the SDB, but if no one does, the original person keeps the lock indefinitely. LockFile objects have these methods at their disposal:

The entire module is too long to show, but here's a small section that interlocks the lock directory and recreates the symbolic link:

my $file = $self->{-file};
my $lockname = lockname $file;
my $lockstring = $self->{-user};

sysopen(LOCK, "$LOCK_PATH/single_thread.lock", O_RDWR|O_CREAT) or
    do {carp "Can't open single_thread.lock: $!"; return 0};
flock(LOCK, LOCK_EX) or
    do {carp "Can't flock single_thread.lock: $!"; return 0};

my (@ls) = lstat $lockname;
unless (@ls) {              # file not locked, grab it
    symlink $lockstring, $lockname or die $!;
    close LOCK;
    return 1;
} else {                    # file lock held
    my $expires = ($ls[10] ||= 0) + ($self->lock_time * 60); # seconds
    if ((time > $expires) or $self->check_my_lock) {
        unlink $lockname or die $!;                   # lock's expired, or is mine,
        symlink $lockstring, $lockname or die $!;            # so recreate it
        close LOCK;
        return 1;
    } else {                # lock belongs to someone else
        close LOCK;
        my $free = localtime $expires;
        my $owner = readlink $lockname or die $!;
        $self->{free} = $free;
        $self->{owner} = $owner;
        return 0;
    }
}

19.5.4. Updating the DHCP and DNS Configuration Files

tie %MODTIMES, 'SDBM_File', $MOD_DB_PATH, O_RDWR|O_CREAT, 0644;
$SIG{ALRM} = \&update_network_dbs;
alarm 60;

This crude version of update_network_dbs compares the DBM's last filter time with the SDB's last modification time (second of the Unix epoch), gets an exclusive lock on the SDB file, and updates the network configuration files and DBM last filter time.

However, a better approach might be to make a list of modified SDBs and have the filter operate on all of them, so the configuration files are updated only once. This minimizes DHCP and DNS query delays, since the process of reinitializing these daemons can be lengthy.

sub update_network_dbs {

    # Compare subnet database files and SDBM last modification
    # dates. Lock recently changed files and update dhcpd.conf
    # and the named zone files.

    opendir S, $SDB_PATH or warn "Cannot open $SDB_PATH: $!";
    my(@dirent) = grep /^.+\.sdb$/, readdir S;
    closedir S;

    while (my $subnet = shift @dirent) {
        $MODTIMES{$subnet} ||= 0;
        my $last_mod = (stat "$SDB_PATH/$subnet")[9];
        if ($last_mod > $MODTIMES{$subnet}) {
            # Lock the subnet file, update DHCP/DNS config files. 
            $MODTIMES{$subnet} = $last_mod;
        }
    }

    $SIG{ALRM} = \&update_network_dbs;
    alarm 60;

} # end update_network_dbs

19.5.5. What About Security?