 |  |
| |
The client's primary duties are to build the human interface and establish a communications link to the server, ipadmd. In order to talk to the server, ipadm starts the helper, ipadmh, as a separate process. Then ipadm sends a message to the daemon requesting a list of subnet descriptions, which it uses to construct the hypertext interface shown in Figure 19-2. Each subnet description has tags and bindings that react to mouseclicks and subsequently display the subnet's nodes, as shown in Figure 19-3.
The following sections explain all this in detail.
As Figure 19-2 shows, ipadm's MainWindow is essentially a single, scrolled ROText widget listing all of ACME Rocket Supply's subnets.
my $t = $MW->Scrolled('ROText',
qw/-width 80 -height 10 -relief ridge -scrollbars w/);As the cursor passes over a subnet line, it becomes "hot," is highlighted in green, and is able to respond to a button click. Clicking on a hot item opens a Toplevel "subnet editing" window, which we'll see shortly. All these actions are controlled by text tags and bindings. First, we create and configure several tags:
$t->tagConfigure(qw/title -font/ => 'Helvetica 18 bold'); $t->tagConfigure(qw/subnet -lmargin1 .5c -lmargin2 1c -foreground blue/); $t->tagConfigure(qw/hot -relief raised -borderwidth 1 -background green/);
The title tag is applied to the title line, giving it a nice, large font. The subnet tag is applied to each subnet line, and the hot tag is applied to a subnet line as the cursor moves over it and is removed as the cursor leaves.
This dynamic manipulation of the hot tag is handled by tag bindings for <Enter> and <Leave> events.
my $last_hot = '';
$t->tagBind(qw/subnet <Enter>/ => sub {
my $text = shift;
my($x, $y) = ($Tk::event->x, $Tk::event->y);
$last_hot = $text->index("\@$x,$y linestart");
$text->tagAdd('hot', $last_hot, "$last_hot lineend");
});As usual, the first argument to a bind callback is the bound object reference, here the ROText widget. We can determine the text line on which the event occurred by fetching the event's cursor coordinates and using index to convert them to a string in "line.character" notation. The linestart modifier ensures that the character portion is always 0. Now we can add the hot tag to the entire line, changing its background color to green.
The <Leave> callback is even simpler, because we can unconditionally clear the hot tag from the entire text area. Note the shift trick that returns the implicit ROText widget reference.
$t->tagBind(qw/subnet <Leave>/ => sub {
shift->tagRemove(qw/hot 1.0 end/);
});Our tag bindings tell us when the cursor enters or leaves any text tagged with the subnet tag; they don't tell us when the cursor crosses line boundaries. If you place the cursor at the top of the ipadm window and drag it downward, a single <Enter> event is generated as the cursor hits the first subnet line, and a corresponding <Leave> event is generated as the cursor moves out the bottom of the window. Essentially, no events whatsoever are generated as the cursor moves over subnet lines between the first and last. We handle this with a <Motion> binding that checks to see when the cursor moves to a different line and updates the hot tags appropriately.
$t->tagBind(qw/subnet <Motion>/ => sub {
my $text = shift;
my($x, $y) = ($Tk::event->x, $Tk::event->y);
my $new_hot = $text->index("\@$x,$y linestart");
if ($new_hot ne $last_hot) {
$text->tagRemove(qw/hot 1.0 end/);
$text->tagAdd('hot', $new_hot, "$new_hot lineend");
$last_hot = $new_hot;
}
});As we learned in the previous section, the actual data inserted into the ROText widget comes from a get_subnet_list IPADM command. The do_command subroutine, described later, handles all the busy work concerning the pipe I/O and protocol details, but note that it issues a single, human-legible command and returns the command status and data. Each line of data consists of two tokens: the SDB filename and the Title line from the SDB file. In the following code, each line is tagged with two strings: "subnet" and the SDB filename (the filename has the extension .sdb).
my($status, @subnet_list) = do_command "get_subnet_list\n";
die "Cannot get SDB list" unless $status =~ /OK/;
foreach (sort numerically @subnet_list) {
my($sdb, $title) = /^(\S+)\s+(.*)/;
$t->insert('end', "$title\n", ['subnet', $sdb]);
}To complete the user interface, we need to invoke the subnet editor when a subnet line is clicked:
$t->tagBind(qw/subnet <ButtonRelease-1>/ => \&open_subnet);
The open_subnet subroutine creates an instance of a Subnet widget for editing an SDB file. It fetches the list of tags associated with the current line and searches the list[51] for a tag ending in .sdb, the SDB filename. The SDB filename, plus a unique identifier used by the daemon for file-locking purposes (described in Section 19.5.3, "Locking an SDB File"), are supplied as parameters to the get_subnet_file IPADM command. The command status line and SDB contents are returned to the @sdb array. We are looking for either of two status responses indicating whether ipadmd acquired an exclusive or nonexclusive lock. Anything else is an error. Ideally, we'd like an exclusive lock so the subnet editor can modify the subnet, but failing that, the subnet editor lets us look at, but not modify, the subnet.
[51] lsearch is a local subroutine that searches a list using the supplied regular expression and returns a match ordinal, or -1 if not found.
The subnet editor is really a composite widget that produces a window like that shown in Figure 19-3. After interacting with the subnet editor, we can either update the subnet or cancel all changes, so we supply callbacks that handle those actions (by issuing the appropriate IPADM command).
sub open_subnet {
my($text) = @_;
my @tags = $text->tagNames('current');
my $i = lsearch('.*\.sdb', @tags);
return if $i < 0;
$text->Busy(-recurse => 1);
my $id = "$ME\@$HN:$$";
my(@sdb) = do_command "get_subnet_file $tags[$i] $id\n";
if ($sdb[0] =~ /Have Lock|Lock Failed/) {
$text->Subnet(
-sdb_path => $tags[$i],
-sdb => \@sdb,
-id => $id,
-updatecmd => sub {do_command "put_subnet_file $tags[$i] $id\n", @sdb},
-cancelcmd => sub {do_command "unl_subnet_file $tags[$i] $id\n"},
);
} else {
$text->messageBox(-message => "SDB Open Error: $sdb[0]",
-type => 'ok', -bitmap => 'error');
}
$text->Unbusy;
} # end open_subnetA Subnet widget has two sections, paralleling the two sections of an SDB file. The top section is a series of LabEntry widgets that display data from the SDB header, while the bottom section displays the characteristics of a single network node. In Figure 19-3, we see details of the node known as JetDirect3, a three-port print server used by the Rubber Band Development department.
The A (address) field is the unqualified IP name of the node. People on the Rubber Band subnet can refer to the print server using this name or the IP number 192.168.128.17. People on other ACME subnets must use either the IP number or include the domain and use the fully qualified IP name, JetDirect3.RubberBand.ACME.Com. The CNAME (canonical name) field is an alias for the node's IP name. The MX (mail exchange) field typically points to a mail server that handles mail on behalf of the node; it's not relevant in this case. The Comments field is just that.
As the balloon help suggests, the subnet administrator can type a search string in any node field to perform a search. Once a node entry is loaded, he makes his changes and clicks Apply. Or, to make a new node entry, he clicks on an available IP number in the Listbox on the right, moving it from the free list to the edit area, configures the node, and applies the changes. When complete, he can either update the subnet with his changes (put_subnet_file) or cancel them all (unl_subnet_file).
Although we won't spend much more time discussing the Subnet widget, it does have one trick up its sleeve, and that's how it uses watchpoints to track changes to any of the subnet header LabEntry widgets. The widget's Populate method reserves an instance variable in the composite hash, $cw->{Subnet_Changes}, so all we need do is register a STORE callback on an entry's -textvariable to set that flag. Since the composite widget reference, $cw, is in scope, we simply create a closure and feed that to the CPAN module Tie::Watch:
my $callback = sub {
shift->Store(shift);
$cw->{Subnet_Changes}++;
};
Tie::Watch->new(-variable => \$title, -store => $callback);Whenever the variable $title is written, the callback is invoked with two arguments: a reference to the Tie::Watch object and the watched variable's new value.
The IPADM client, ipadm, starts its IPADM helper, ipadmh, in the standard Unix manner[52] and talks to it via two unidirectional pipes. From our point of view (the parent), we use the file handles PR and PW to read and write data from/to the helper (our child). From the child's point of view, it simply reads from STDIN and writes to STDOUT/STDERR, which we connect to the opposite ends of the two pipes, CR and CW, respectively. Note that we unbuffer all the output file handles.
[52] Here we exec a non-Tk program after the fork (we don't require Tk functionality or desire its added baggage), but that's not strictly necessary; it's perfectly okay to have a Perl/Tk child, with two caveats. First, the child must not touch, reference, or manipulate Tk objects belonging to the parent in any way. Second, if the child terminates before the parent, it must override the standard Tk exit command and use CORE::exit, or better, POSIX::exit. Invoking plain exit(Tk::exit) unceremoniously destroys all widgets and data structures and terminates the application.
As its first task, ipadmh attempts to connect to the daemon, ipadmd, and pipes us an unsolicited message indicating whether or not the connect was successful. Calling do_command without a command reads this message for us.
Finally, note the dubious use of a signal handler to catch a SIGPIPE error. Generally, mixing signals with Perl/Tk causes unexpected application crashes, but in this case, losing contact with the helper is, for all intents and purposes, fatal, and this lets us exit gracefully.
sub start_ipc_helper {
$SIG{PIPE} = sub {print STDERR "ipadmh pipe failure.\n"; exit};
pipe CR, PW or die "cr/pw pipe $!";
pipe PR, CW or die "pr/cw pipe $!";
if ($PID = fork) { # parent, ipadm/Tk
close CR;
close CW;
PW->autoflush(1);
} elsif (defined $PID) { # child, exec ipadmh
close PR;
close PW;
open STDIN, "<&CR" or die "STDIN open $!";
open STDOUT, ">&CW" or die "STDOUT open $!";
open STDERR, ">&CW" or die "STDERR open $!";
STDOUT->autoflush(1);
STDERR->autoflush(1);
exec("./ipadmh", $DAEMON_HOST, $DAEMON_PORT) or die "exec $!";
die "exec warp $!";
} else {
die "fork $!";
} # ifend fork
my(@stat) = do_command undef; # did helper make a connection?
return if $stat[0] =~ /Connect OK/;
$MW->messageBox(-message => "Cannot connect to remote IPADM daemon " .
"$DAEMON_HOST:$DAEMON_PORT. Please try again later.",
-title => 'Daemon is Dead', -icon => 'warning',
-type => 'OK');
fini;
} # end start_ipc_helper
sub fini {
kill 'SIGTERM', $PID;
exit;
}And now, here is do_command, the guts of ipadm's message handling:
sub do_command {
# Issue a single IPADM command and wait for a reply. Using
# pipes and fileevent( ) allows X11 events to continue flowing.
pipe_out @_;
return pipe_in;
} # end do_commandRecall that ipadm uses this code to get a list of subnets:
my($status, @subnet_list) = do_command "get_subnet_list\n"; die "Cannot get SDB list" unless $status =~ /OK/;
do_command's helper pipe_out appends the terminating string, $EOF, to the outgoing data, then registers a callback that's invoked when the output pipe is writable. Because we're coding with use strict in effect, we cannot give fileevent a bare file handle but must use a reference to a glob instead. The callback outputs its data, including the $EOF, using syswrite, at which time it increments $wait. Meanwhile, waitVariable has logically suspended us, pending a change in $wait, at which time the writable callback is canceled.
sub pipe_out {
# Issue an IPADM command by syswrite-ing all the data plus
# the terminating $EOF.
return unless defined $_[0];
my($bytes, $offset, $sysdata, $sysstat, $wait);
$sysdata = join '', @_, "$EOF\n";
$bytes = length $sysdata;
$offset = 0;
$MW->fileevent(\*PW, 'writable' => sub {
while ($bytes > 0) {
$sysstat = syswrite PW, $sysdata, $bytes, $offset;
die "ipadm: syswrite error $!" unless defined $sysstat;
$bytes -= $sysstat;
$offset += $sysstat;
}
$wait++;
});
$MW->waitVariable(\$wait);
$MW->fileevent(\*PW, 'writable' => '');
} # end pipe_outUnsurprisingly, pipe_in reads the reply data[53] in a similar manner.
[53] Notice that Tk 800.015 and earlier do not use sysread due to differences in fileevent handling. This leaves us open to a potential deadlock, but our line-oriented protocol is simple enough that in practice, this never happens.
sub pipe_in {
# Now that the IPADM command has been issued, keep sysread-ing
# until the $EOF string is read, and return all the accumulated
# data, excluding $EOF.
my(@data, $sysbuf, $sysdata, $sysstat, $wait);
$MW->fileevent(\*PR, 'readable' => sub {
if ( $Tk::VERSION le '800.015' ) {
$sysbuf = <PR>;
} else {
$sysstat = sysread PR, $sysbuf, 4096;
die "ipadm: sysread error $!" unless defined $sysstat;
}
$sysdata .= $sysbuf;
if ($sysdata =~ /$EOF$/s) {
@data = split /\n/, $sysdata;
$#data--; # throw $EOF away
$wait++; # unblock waitVariable( )
}
});
$MW->waitVariable(\$wait);
$MW->fileevent(\*PR, 'readable' => '');
@data;
} # end pipe_in |  | |
| 19.2. IPADM Design Considerations |  | 19.4. The IPADM Helper, ipadmh |
Copyright © 2002 O'Reilly & Associates. All rights reserved.