host/ihost-perl/ihost.pl

#!/usr/bin/perl -w

# -----------------------------------------------------------
# Perl i-scream Host.
# http://www.i-scream.org.uk
#
# An all-in-one script to act as an i-scream host on
# a typical Unix/Linux box.
#
# $Author: tdb1 $
# $Id: ihost.pl,v 1.35 2001/11/14 14:17:12 tdb1 Exp $
#------------------------------------------------------------

$| = 1;

use strict;
use IO::Socket;
use Sys::Hostname;

use vars qw (
             $filter_manager_addr
             $filter_manager_port
             $seq_no
             $udp_update_time
             $tcp_update_time
             $last_udp_time
             $last_tcp_time
             $last_modified
             $udp_port
             $tcp_port
             $filter_addr
             $file_list
             $fqdn
             $pidfile
             $retry_wait
             @statgrab
            );

if (@ARGV != 2) {
    die "Usage: ihost.pl [i-scream filter manager] [TCP port]\n";
}

$filter_manager_addr = $ARGV[0];
$filter_manager_port = $ARGV[1];

$seq_no = 1;
$retry_wait = 60;

# write our PID to a file
$pidfile = "/var/tmp/ihost.pid";
&write_pid();

&tcp_configure();
&send_udp_packet();

$last_udp_time = time;
$last_tcp_time = time;
while (1) {
    my($time) = time;
    if ($time >= $last_udp_time + $udp_update_time) {
        &send_udp_packet();
        $last_udp_time = $time;
    }
    if ($time >= $last_tcp_time + $tcp_update_time) {
        &send_tcp_heartbeat();
        $last_tcp_time = $time;
    }
    my($next_udp) = $udp_update_time - $time + $last_udp_time;
    my($next_tcp) = $tcp_update_time - $time + $last_tcp_time;
    my($delay);
    if ($next_udp < $next_tcp) {
        $delay = $next_udp
    }
    else {
        $delay = $next_tcp;
    }
    sleep $delay;
}

# we'll probably never get here...
`rm -f $pidfile`;
exit(0);


#-----------------------------------------------------------------------
# wait_then_retry
# Waits for the period of time specified in $retry_wait, then attempts
# to reconfigure with the server.
#-----------------------------------------------------------------------
sub wait_then_retry() {
    print "Will retry configuration with filter manager in $retry_wait seconds.\n";
    sleep $retry_wait;
}


#-----------------------------------------------------------------------
# tcp_configure
# Establishes a TCP connection to the specified i-scream filter manager.
# The host then requests details from the server, such as the intervals
# at which to send UDP packets.
#-----------------------------------------------------------------------
sub tcp_configure() {
    
    while (1) {
        my($sock) = new IO::Socket::INET(
                                         PeerAddr => $filter_manager_addr,
                                         PeerPort => $filter_manager_port,
                                         Proto => 'tcp'
                                        ) or die "Cannot connect!";
        if (!defined $sock) {
            print "IHOST ERROR: Could not connect to $filter_manager_addr:$filter_manager_port.\n";
            print "Please check that there is an i-scream server at this address.\n";
            wait_then_retry();
            next;
        }

        # Now run through the configuration process...
        my($response);
    
        print $sock "STARTCONFIG\n";
        $response = <$sock>;
        if ($response && !($response eq "OK\n")) {
            print "The i-scream server rejected the STARTCONFIG command.\n";
            close($sock);
            wait_then_retry();
            next;
        }

        print "Config started okay.\n";
    
        print $sock "LASTMODIFIED\n";
        $response = <$sock>;
        if (!$response) {
            print "The i-scream server did not return anything for the LASTMODIFIED command.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        chop $response;
        $last_modified = $response;
    
        print "Config last modified: ". (scalar localtime $last_modified/1000) . "\n";

        print $sock "FILELIST\n";
        $response = <$sock>;
        if (!$response) {
            print "The i-scream server did not provide a configuration file list.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        chop $response;
        $file_list = $response;

        print "File list obtained: $file_list\n";

        print $sock "FQDN\n";
        $response = <$sock>;
        if (!$response) {
            print "The i-scream server did not tell us our FQDN.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        chop $response;
        $fqdn = $response;

        print "FQDN returned: $fqdn\n";

        print $sock "UDPUpdateTime\n";
        $response = <$sock>;
        if (!$response) {
            print "The i-scream server did not give us a UDPUpdateTime.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        chop $response;
        $udp_update_time = $response;

        print $sock "TCPUpdateTime\n";
        $response = <$sock>;
        if (!$response) {
            print "The i-scream server did not give us a TCPUpdateTime.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        chop $response;
        $tcp_update_time = $response;
    
        print "UDP packet period: $udp_update_time seconds.\nTCP heartbeat period: $tcp_update_time seconds.\n";

        print $sock "ENDCONFIG\n";
        $response = <$sock>;
        if ($response && !($response eq "OK\n")) {
            print "ENDCONFIG command to server failed.  Terminated.\n";
            close($sock);
            wait_then_retry();
            next;
        }

        print "Config ended.\n";
    
        print $sock "FILTER\n";
        $response = <$sock>;
        if (!$response) {
            print "Failed: Could not get a filter address from the filter manager.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        chop $response;
        $response =~ /^(.*);(.*);(.*)/;
        if ($response eq "ERROR") {
            print "There are no active configured filters for your host.\n";
            close($sock);
            wait_then_retry();
            next;
        }
        ($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
        unless (defined($filter_addr) && defined($udp_port) && defined($tcp_port)) {
            print "Failed: Filter address response from server did not make sense: $response\n";
            close($sock);
            wait_then_retry();
            next;
        }
    
        print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";

        print $sock "END\n";
        $response = <$sock>;
        if ($response && ($response eq "OK\n")) {
            print "Host successfully configured via TCP.\n"
        }
        else {
            print "The server failed the host configuration on the END command.\n";
            close($sock);
            wait_then_retry();
            next;
        }
    
        close($sock);

        print "Configuration finished sucessfully!\n";
        last;
    }
    return;
}


#-----------------------------------------------------------------------
# send_udp_packet
# Sends a UDP packet to an i-scream filter.
# The packet contains XML markup describing some of the machine's state.
# Receipt of UDP packets is not guaranteed.
#-----------------------------------------------------------------------
sub send_udp_packet() {

    @statgrab = `./statgrab.pl`;
    
    # get some extra data
    my($date) = time;
    my($ip);
    $ip = inet_ntoa(scalar(gethostbyname(hostname())) || 'localhost') or $ip = 'localhost';
    
    # add some extra data to the array
    push(@statgrab, "packet.attributes.seq_no=$seq_no");
    push(@statgrab, "packet.attributes.machine_name=$fqdn");
    push(@statgrab, "packet.attributes.date=$date");
    push(@statgrab, "packet.attributes.type=data");
    push(@statgrab, "packet.attributes.ip=$ip");
    
    # turn the array into some nice XML
    my($xml) = &make_xml("", "");
    
    my($sock) = new IO::Socket::INET (
                                      PeerPort => $udp_port,
                                      PeerAddr => $filter_addr,
                                      Proto => 'udp'
                                     ) or die "Could not send UDP: $!\n";
    
    print $sock $xml or die "Could not send UDP packet: $!\n";
    close($sock);
    $seq_no++;
    print "-";
    
    return;
}


#-----------------------------------------------------------------------
# send_tcp_heartbeat
# Establishes a TCP connection to an i-scream filter.
# The heartbeat is used as a guaranteed "I'm alive" delivery mechanism.
# If we need to reconfigure, then we complete the heartbeat before
# doing so.
#-----------------------------------------------------------------------
sub send_tcp_heartbeat() {

    my ($doReconfigure) = 0;

    my($sock) = new IO::Socket::INET(
                                     PeerAddr => $filter_addr,
                                     PeerPort => $tcp_port,
                                     Proto => 'tcp'
                                    ) or return;
    if (!defined $sock) {
        print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
        &tcp_configure();
        return;
    }

    # Now run through the configuration process.
    my($response);

    print $sock "HEARTBEAT\n";
    $response = <$sock>;
    if (!$response eq "OK\n") {
        close($sock);
        print "Server gave wrong response to HEARTBEAT: $response\n";
        &tcp_configure();
        return;
    }
    
    print $sock "CONFIG\n";
    $response = <$sock>;
    if (!$response eq "OK\n") {
        close($sock);
        print "Server gave wrong response to CONFIG: $response\n";
        &tcp_configure();
        return;
    }

    print $sock "$file_list\n";
    $response = <$sock>;
    if (!$response eq "OK\n") {
        close($sock);
        print "Server gave wrong response to file list: $response\n";
        &tcp_configure();
        return;
    }
    
    print $sock "$last_modified\n";
    $response = <$sock>;
    if ($response eq "ERROR\n") {
        close($sock);
        print "Server configuration changed.  Reconfiguring with filter manager.\n";
        $doReconfigure = 1;
    }
    if (!$response eq "OK\n") {
        close($sock);
        print "Server gave wrong response to HEARTBEAT: $response\n";
        &tcp_configure();
        return;
    }
    
    print $sock "ENDHEARTBEAT\n";
    $response = <$sock>;
    if (!$response eq "OK\n") {
        close($sock);
        print "Server gave wrong response to ENDHEARTBEAT: $response\n";
        &tcp_configure();
        return;
    }
    
    close($sock);
    print "^";
    
    &tcp_configure() if $doReconfigure;
    
    return;
}


#-----------------------------------------------------------------------
# write_pid
# Writes the PID (process ID) of this instance to $pidfile.
# This is then used by a seperate script to check (and restart) ihost.
#-----------------------------------------------------------------------
sub write_pid() {
    open PID, ">$pidfile";
    print PID $$;
    close PID;
    
    return;
}

#-----------------------------------------------------------------------
# make_xml
# Turns an array of statgrab data into an XML string.
#-----------------------------------------------------------------------
sub make_xml() {
    my($curlevel, $curline) = @_;
    my($xmltemp) = ""; my($curtag) = ""; my($attributes) = "";
    while(true) {
        $curline = shift(@statgrab) if $curline eq ""; chomp $curline;
        if($curline =~ /^$curlevel([^\.\s]+\.)/) {
            $curtag=$1;
        }
        if($curline =~ /^$curlevel$curtag([^\.\s]+)\s+(.*)$/) {
            $xmltemp .= "<$1$attributes>$2</$1>";
        }
        elsif($curline =~ /^$curlevel$curtag(attributes)\.([^\.=]+)=(.*)$/) {
            $attributes .= " $2=\"$3\"";
        }
        else {
            $xmltemp .= &make_xml("$curlevel$curtag", $curline);
        }
        my($nextline) = $statgrab[0]; chomp $nextline if defined $nextline;
        $curtag =~ s/(.*)\./$1/;                
        if(defined $nextline && $nextline =~ /^$curlevel$curtag\./) {
            $curline = "";
        }
        else {
            $xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
            return $xmltemp;
        }
    }
}
Revision:	1.36
Committed:	Wed Nov 14 16:41:30 2001 UTC (22 years, 10 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
Changes since 1.35:	+52 -86 lines
Log Message:	Feature fullfilling some of the following tracker ID on sourceforge: [ #479690 ] make ihost/statgrab more modular This is my proposal for the new ihost XML processing. It now dynamically creates the XML from the data given to it my statgrab. This allows further expansion in the future with statgrab, possibly making it into smaller sub-scripts to collect data. (ie. cpu.pl disk.pl etc). This takes the largest chunk out of the above feature request. There was some discussion over how this XML processing should be done. In the end I opted for a recursive solution, as we only go a few levels deep. This also means the code is tidy and readable.
#	User	Rev	Content
1	pjm2	1.6	#!/usr/bin/perl -w
2	pjm2	1.1
3			# -----------------------------------------------------------
4			# Perl i-scream Host.
5	pjm2	1.12	# http://www.i-scream.org.uk
6	pjm2	1.1	#
7			# An all-in-one script to act as an i-scream host on
8	tdb	1.36	# a typical Unix/Linux box.
9	pjm2	1.1	#
10	tdb	1.36	# $Author: tdb1 $
11			# $Id: ihost.pl,v 1.35 2001/11/14 14:17:12 tdb1 Exp $
12	pjm2	1.1	#------------------------------------------------------------
13
14			$\| = 1;
15
16			use strict;
17			use IO::Socket;
18			use Sys::Hostname;
19
20			use vars qw (
21			$filter_manager_addr
22			$filter_manager_port
23			$seq_no
24			$udp_update_time
25			$tcp_update_time
26			$last_udp_time
27			$last_tcp_time
28			$last_modified
29			$udp_port
30			$tcp_port
31			$filter_addr
32			$file_list
33	pjm2	1.17	$fqdn
34	tdb	1.25	$pidfile
35	pjm2	1.28	$retry_wait
36	tdb	1.36	@statgrab
37	pjm2	1.1	);
38
39			if (@ARGV != 2) {
40			die "Usage: ihost.pl [i-scream filter manager] [TCP port]\n";
41			}
42
43			$filter_manager_addr = $ARGV[0];
44			$filter_manager_port = $ARGV[1];
45
46			$seq_no = 1;
47	pjm2	1.33	$retry_wait = 60;
48	pjm2	1.1
49	tdb	1.25	# write our PID to a file
50	tdb	1.26	$pidfile = "/var/tmp/ihost.pid";
51	tdb	1.25	&write_pid();
52
53	pjm2	1.1	&tcp_configure();
54			&send_udp_packet();
55
56			$last_udp_time = time;
57			$last_tcp_time = time;
58			while (1) {
59	pjm2	1.9	my($time) = time;
60			if ($time >= $last_udp_time + $udp_update_time) {
61	pjm2	1.1	&send_udp_packet();
62	pjm2	1.9	$last_udp_time = $time;
63	pjm2	1.1	}
64	pjm2	1.9	if ($time >= $last_tcp_time + $tcp_update_time) {
65	pjm2	1.1	&send_tcp_heartbeat();
66	pjm2	1.9	$last_tcp_time = $time;
67	pjm2	1.1	}
68	pjm2	1.9	my($next_udp) = $udp_update_time - $time + $last_udp_time;
69			my($next_tcp) = $tcp_update_time - $time + $last_tcp_time;
70			my($delay);
71			if ($next_udp < $next_tcp) {
72			$delay = $next_udp
73			}
74			else {
75			$delay = $next_tcp;
76			}
77	tdb	1.35	sleep $delay;
78	pjm2	1.1	}
79
80	tdb	1.25	# we'll probably never get here...
81			`rm -f $pidfile`;
82	pjm2	1.1	exit(0);
83
84	pjm2	1.12
85			#-----------------------------------------------------------------------
86	pjm2	1.28	# wait_then_retry
87			# Waits for the period of time specified in $retry_wait, then attempts
88			# to reconfigure with the server.
89			#-----------------------------------------------------------------------
90			sub wait_then_retry() {
91			print "Will retry configuration with filter manager in $retry_wait seconds.\n";
92	tdb	1.35	sleep $retry_wait;
93	pjm2	1.28	}
94
95
96			#-----------------------------------------------------------------------
97	pjm2	1.12	# tcp_configure
98			# Establishes a TCP connection to the specified i-scream filter manager.
99			# The host then requests details from the server, such as the intervals
100			# at which to send UDP packets.
101			#-----------------------------------------------------------------------
102	pjm2	1.1	sub tcp_configure() {
103
104	pjm2	1.31	while (1) {
105	pjm2	1.28	my($sock) = new IO::Socket::INET(
106			PeerAddr => $filter_manager_addr,
107			PeerPort => $filter_manager_port,
108			Proto => 'tcp'
109			) or die "Cannot connect!";
110			if (!defined $sock) {
111			print "IHOST ERROR: Could not connect to $filter_manager_addr:$filter_manager_port.\n";
112			print "Please check that there is an i-scream server at this address.\n";
113			wait_then_retry();
114			next;
115			}
116
117			# Now run through the configuration process...
118			my($response);
119
120			print $sock "STARTCONFIG\n";
121			$response = <$sock>;
122	pjm2	1.32	if ($response && !($response eq "OK\n")) {
123			print "The i-scream server rejected the STARTCONFIG command.\n";
124	pjm2	1.28	close($sock);
125			wait_then_retry();
126			next;
127			}
128
129			print "Config started okay.\n";
130
131			print $sock "LASTMODIFIED\n";
132			$response = <$sock>;
133	pjm2	1.32	if (!$response) {
134			print "The i-scream server did not return anything for the LASTMODIFIED command.\n";
135			close($sock);
136			wait_then_retry();
137			next;
138			}
139	pjm2	1.28	chop $response;
140			$last_modified = $response;
141
142			print "Config last modified: ". (scalar localtime $last_modified/1000) . "\n";
143
144			print $sock "FILELIST\n";
145			$response = <$sock>;
146	pjm2	1.32	if (!$response) {
147			print "The i-scream server did not provide a configuration file list.\n";
148			close($sock);
149			wait_then_retry();
150			next;
151			}
152	pjm2	1.28	chop $response;
153			$file_list = $response;
154
155			print "File list obtained: $file_list\n";
156
157			print $sock "FQDN\n";
158			$response = <$sock>;
159	pjm2	1.32	if (!$response) {
160			print "The i-scream server did not tell us our FQDN.\n";
161			close($sock);
162			wait_then_retry();
163			next;
164			}
165	pjm2	1.28	chop $response;
166			$fqdn = $response;
167
168			print "FQDN returned: $fqdn\n";
169
170			print $sock "UDPUpdateTime\n";
171			$response = <$sock>;
172	pjm2	1.32	if (!$response) {
173			print "The i-scream server did not give us a UDPUpdateTime.\n";
174			close($sock);
175			wait_then_retry();
176			next;
177			}
178	pjm2	1.28	chop $response;
179			$udp_update_time = $response;
180
181			print $sock "TCPUpdateTime\n";
182			$response = <$sock>;
183	pjm2	1.32	if (!$response) {
184			print "The i-scream server did not give us a TCPUpdateTime.\n";
185			close($sock);
186			wait_then_retry();
187			next;
188			}
189	pjm2	1.28	chop $response;
190			$tcp_update_time = $response;
191
192			print "UDP packet period: $udp_update_time seconds.\nTCP heartbeat period: $tcp_update_time seconds.\n";
193
194			print $sock "ENDCONFIG\n";
195			$response = <$sock>;
196	pjm2	1.32	if ($response && !($response eq "OK\n")) {
197	pjm2	1.28	print "ENDCONFIG command to server failed. Terminated.\n";
198			close($sock);
199			wait_then_retry();
200			next;
201			}
202
203			print "Config ended.\n";
204
205			print $sock "FILTER\n";
206			$response = <$sock>;
207	pjm2	1.32	if (!$response) {
208	pjm2	1.28	print "Failed: Could not get a filter address from the filter manager.\n";
209			close($sock);
210			wait_then_retry();
211			next;
212			}
213			chop $response;
214	pjm2	1.32	$response =~ /^(.);(.);(.*)/;
215	pjm2	1.28	if ($response eq "ERROR") {
216			print "There are no active configured filters for your host.\n";
217			close($sock);
218			wait_then_retry();
219			next;
220			}
221			($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
222			unless (defined($filter_addr) && defined($udp_port) && defined($tcp_port)) {
223			print "Failed: Filter address response from server did not make sense: $response\n";
224			close($sock);
225			wait_then_retry();
226			next;
227			}
228
229			print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";
230
231			print $sock "END\n";
232			$response = <$sock>;
233	pjm2	1.32	if ($response && ($response eq "OK\n")) {
234	pjm2	1.28	print "Host successfully configured via TCP.\n"
235			}
236			else {
237	pjm2	1.32	print "The server failed the host configuration on the END command.\n";
238	pjm2	1.28	close($sock);
239			wait_then_retry();
240			next;
241			}
242	pjm2	1.1
243	pjm2	1.28	close($sock);
244	pjm2	1.1
245	pjm2	1.28	print "Configuration finished sucessfully!\n";
246			last;
247	pjm2	1.1	}
248	pjm2	1.12	return;
249	pjm2	1.1	}
250
251	pjm2	1.12
252			#-----------------------------------------------------------------------
253			# send_udp_packet
254			# Sends a UDP packet to an i-scream filter.
255			# The packet contains XML markup describing some of the machine's state.
256			# Receipt of UDP packets is not guaranteed.
257			#-----------------------------------------------------------------------
258	pjm2	1.1	sub send_udp_packet() {
259
260	tdb	1.36	@statgrab = `./statgrab.pl`;
261	pjm2	1.1
262	tdb	1.36	# get some extra data
263	pjm2	1.1	my($date) = time;
264	pjm2	1.33	my($ip);
265			$ip = inet_ntoa(scalar(gethostbyname(hostname())) \|\| 'localhost') or $ip = 'localhost';
266	tdb	1.36
267			# add some extra data to the array
268			push(@statgrab, "packet.attributes.seq_no=$seq_no");
269			push(@statgrab, "packet.attributes.machine_name=$fqdn");
270			push(@statgrab, "packet.attributes.date=$date");
271			push(@statgrab, "packet.attributes.type=data");
272			push(@statgrab, "packet.attributes.ip=$ip");
273
274			# turn the array into some nice XML
275			my($xml) = &make_xml("", "");
276
277	pjm2	1.1	my($sock) = new IO::Socket::INET (
278			PeerPort => $udp_port,
279			PeerAddr => $filter_addr,
280			Proto => 'udp'
281	pjm2	1.21	) or die "Could not send UDP: $!\n";
282	tdb	1.36
283	pjm2	1.1	print $sock $xml or die "Could not send UDP packet: $!\n";
284			close($sock);
285			$seq_no++;
286			print "-";
287	pjm2	1.12
288			return;
289	pjm2	1.1	}
290
291	pjm2	1.12
292			#-----------------------------------------------------------------------
293			# send_tcp_heartbeat
294			# Establishes a TCP connection to an i-scream filter.
295			# The heartbeat is used as a guaranteed "I'm alive" delivery mechanism.
296	pjm2	1.34	# If we need to reconfigure, then we complete the heartbeat before
297			# doing so.
298	pjm2	1.12	#-----------------------------------------------------------------------
299	pjm2	1.1	sub send_tcp_heartbeat() {
300
301	pjm2	1.34	my ($doReconfigure) = 0;
302
303	pjm2	1.1	my($sock) = new IO::Socket::INET(
304			PeerAddr => $filter_addr,
305			PeerPort => $tcp_port,
306			Proto => 'tcp'
307	pjm2	1.21	) or return;
308	pjm2	1.11	if (!defined $sock) {
309			print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
310	pjm2	1.27	&tcp_configure();
311	pjm2	1.11	return;
312			}
313	pjm2	1.1
314			# Now run through the configuration process.
315			my($response);
316
317			print $sock "HEARTBEAT\n";
318			$response = <$sock>;
319	pjm2	1.32	if (!$response eq "OK\n") {
320	pjm2	1.1	close($sock);
321			print "Server gave wrong response to HEARTBEAT: $response\n";
322	pjm2	1.27	&tcp_configure();
323	pjm2	1.1	return;
324			}
325
326			print $sock "CONFIG\n";
327			$response = <$sock>;
328	pjm2	1.32	if (!$response eq "OK\n") {
329	pjm2	1.1	close($sock);
330			print "Server gave wrong response to CONFIG: $response\n";
331	pjm2	1.27	&tcp_configure();
332	pjm2	1.1	return;
333			}
334
335			print $sock "$file_list\n";
336			$response = <$sock>;
337	pjm2	1.32	if (!$response eq "OK\n") {
338	pjm2	1.1	close($sock);
339			print "Server gave wrong response to file list: $response\n";
340	pjm2	1.27	&tcp_configure();
341	pjm2	1.1	return;
342			}
343
344			print $sock "$last_modified\n";
345			$response = <$sock>;
346	pjm2	1.32	if ($response eq "ERROR\n") {
347	pjm2	1.1	close($sock);
348	pjm2	1.27	print "Server configuration changed. Reconfiguring with filter manager.\n";
349	pjm2	1.34	$doReconfigure = 1;
350	pjm2	1.1	}
351	pjm2	1.32	if (!$response eq "OK\n") {
352	pjm2	1.1	close($sock);
353			print "Server gave wrong response to HEARTBEAT: $response\n";
354	pjm2	1.27	&tcp_configure();
355	pjm2	1.1	return;
356			}
357
358			print $sock "ENDHEARTBEAT\n";
359	pjm2	1.23	$response = <$sock>;
360	pjm2	1.32	if (!$response eq "OK\n") {
361	pjm2	1.1	close($sock);
362			print "Server gave wrong response to ENDHEARTBEAT: $response\n";
363	pjm2	1.27	&tcp_configure();
364	pjm2	1.1	return;
365			}
366
367			close($sock);
368			print "^";
369	pjm2	1.34
370			&tcp_configure() if $doReconfigure;
371	tdb	1.25
372			return;
373			}
374
375	tdb	1.36
376	tdb	1.25	#-----------------------------------------------------------------------
377			# write_pid
378			# Writes the PID (process ID) of this instance to $pidfile.
379			# This is then used by a seperate script to check (and restart) ihost.
380			#-----------------------------------------------------------------------
381			sub write_pid() {
382			open PID, ">$pidfile";
383			print PID $$;
384			close PID;
385	pjm2	1.12
386			return;
387	tdb	1.36	}
388
389			#-----------------------------------------------------------------------
390			# make_xml
391			# Turns an array of statgrab data into an XML string.
392			#-----------------------------------------------------------------------
393			sub make_xml() {
394			my($curlevel, $curline) = @_;
395			my($xmltemp) = ""; my($curtag) = ""; my($attributes) = "";
396			while(true) {
397			$curline = shift(@statgrab) if $curline eq ""; chomp $curline;
398			if($curline =~ /^$curlevel([^\.\s]+\.)/) {
399			$curtag=$1;
400			}
401			if($curline =~ /^$curlevel$curtag([^\.\s]+)\s+(.*)$/) {
402			$xmltemp .= "<$1$attributes>$2</$1>";
403			}
404			elsif($curline =~ /^$curlevel$curtag(attributes)\.([^\.=]+)=(.*)$/) {
405			$attributes .= " $2=\"$3\"";
406			}
407			else {
408			$xmltemp .= &make_xml("$curlevel$curtag", $curline);
409			}
410			my($nextline) = $statgrab[0]; chomp $nextline if defined $nextline;
411			$curtag =~ s/(.*)\./$1/;
412			if(defined $nextline && $nextline =~ /^$curlevel$curtag\./) {
413			$curline = "";
414			}
415			else {
416			$xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
417			return $xmltemp;
418			}
419			}
420	pjm2	1.1	}