 |  |
| |
The daemon's duties consist of:
Creating the well-known server socket, then looping forever, accepting client connect requests and forking a copy of itself to handle them
Processing IPADM messages for the duration of the session
Employing advisory file locking so only one client has write access to an SDB at any point in time, thus ensuring the integrity of the SDB files
Keeping the DHCP and DNS configuration files current by periodically checking for modified SDB files, and running the filter as required
We'll look briefly at how these functions are handled, but only briefly; we're beginning to stray far from the topic of choice.
We want a forking server, because each connect typically takes many minutes to service; after all, there's a human on the other end of the socket, slowly clicking and typing away at the Tk client. With Perl and IO::Socket, writing such a server is a piece of cake. First, ipadmd creates its socket endpoint. The Listen parameter specifies the maximum number of simultaneous open sockets and indicates that this socket listens for connect attempts rather than attempting a connect itself.
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 daemonThe child forked by ipadmd has yet another main loop, which lasts as long as the Perl/Tk client keeps the socket alive. The child reads the socket line by line until the $EOF terminator arrives and dispatches the IPADM message to the proper processing subroutine. This code also appends the $EOF terminator to whatever data the command processor might have returned, as required by the IPADM protocol.
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 CONNECTEDPerhaps 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_listPotentially, several network clients and this daemon could be vying for a single SDB file, so it's imperative that we provide a reliable locking mechanism. For example, the Perl/Tk client ipadm wants exclusive access so it can modify the SDB, while this daemon wants exclusive access so it can read the SDB without fear of it changing under its nose.
We have at our disposal a cool module that implements advisory file locking using LockFile objects. As the word advisory suggests, this module only advises us if we have an exclusive lock on a file; it can't actually enforce or guarantee exclusiveness. The underlying locking mechanism is implemented via the Perl built-in flock function, with all its caveats and limitations, although in this mutually cooperative environment where everyone uses LockFile, it works just fine.
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;
}
}ipadmd maintains a DBM file whose keys are SDB filenames and whose values indicate when the SDB file was last filtered, i.e., when it was incorporated in the DHCP and DNS configuration files. The following statements bind the DBM file $MOD_DB_PATH (creating it if needed) to the global hash %MODTIMES and initialize an alarm handler that calls update_network_dbs every minute.
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_dbsThat's beyond the scope of this book. Really. See Recipe 17.7 in the Perl Cookbook (O'Reilly).
|  | |
| 19.4. The IPADM Helper, ipadmh |  | 19.6. Polling Win32 Sockets |
Copyright © 2002 O'Reilly & Associates. All rights reserved.