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 (23 years 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.
#	Content
1	#!/usr/bin/perl -w
2
3	# -----------------------------------------------------------
4	# Perl i-scream Host.
5	# http://www.i-scream.org.uk
6	#
7	# An all-in-one script to act as an i-scream host on
8	# a typical Unix/Linux box.
9	#
10	# $Author: tdb1 $
11	# $Id: ihost.pl,v 1.35 2001/11/14 14:17:12 tdb1 Exp $
12	#------------------------------------------------------------
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	$fqdn
34	$pidfile
35	$retry_wait
36	@statgrab
37	);
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	$retry_wait = 60;
48
49	# write our PID to a file
50	$pidfile = "/var/tmp/ihost.pid";
51	&write_pid();
52
53	&tcp_configure();
54	&send_udp_packet();
55
56	$last_udp_time = time;
57	$last_tcp_time = time;
58	while (1) {
59	my($time) = time;
60	if ($time >= $last_udp_time + $udp_update_time) {
61	&send_udp_packet();
62	$last_udp_time = $time;
63	}
64	if ($time >= $last_tcp_time + $tcp_update_time) {
65	&send_tcp_heartbeat();
66	$last_tcp_time = $time;
67	}
68	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	sleep $delay;
78	}
79
80	# we'll probably never get here...
81	`rm -f $pidfile`;
82	exit(0);
83
84
85	#-----------------------------------------------------------------------
86	# 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	sleep $retry_wait;
93	}
94
95
96	#-----------------------------------------------------------------------
97	# 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	sub tcp_configure() {
103
104	while (1) {
105	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	if ($response && !($response eq "OK\n")) {
123	print "The i-scream server rejected the STARTCONFIG command.\n";
124	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	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	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	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	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	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	chop $response;
166	$fqdn = $response;
167
168	print "FQDN returned: $fqdn\n";
169
170	print $sock "UDPUpdateTime\n";
171	$response = <$sock>;
172	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	chop $response;
179	$udp_update_time = $response;
180
181	print $sock "TCPUpdateTime\n";
182	$response = <$sock>;
183	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	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	if ($response && !($response eq "OK\n")) {
197	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	if (!$response) {
208	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	$response =~ /^(.);(.);(.*)/;
215	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	if ($response && ($response eq "OK\n")) {
234	print "Host successfully configured via TCP.\n"
235	}
236	else {
237	print "The server failed the host configuration on the END command.\n";
238	close($sock);
239	wait_then_retry();
240	next;
241	}
242
243	close($sock);
244
245	print "Configuration finished sucessfully!\n";
246	last;
247	}
248	return;
249	}
250
251
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	sub send_udp_packet() {
259
260	@statgrab = `./statgrab.pl`;
261
262	# get some extra data
263	my($date) = time;
264	my($ip);
265	$ip = inet_ntoa(scalar(gethostbyname(hostname())) \|\| 'localhost') or $ip = 'localhost';
266
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	my($sock) = new IO::Socket::INET (
278	PeerPort => $udp_port,
279	PeerAddr => $filter_addr,
280	Proto => 'udp'
281	) or die "Could not send UDP: $!\n";
282
283	print $sock $xml or die "Could not send UDP packet: $!\n";
284	close($sock);
285	$seq_no++;
286	print "-";
287
288	return;
289	}
290
291
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	# If we need to reconfigure, then we complete the heartbeat before
297	# doing so.
298	#-----------------------------------------------------------------------
299	sub send_tcp_heartbeat() {
300
301	my ($doReconfigure) = 0;
302
303	my($sock) = new IO::Socket::INET(
304	PeerAddr => $filter_addr,
305	PeerPort => $tcp_port,
306	Proto => 'tcp'
307	) or return;
308	if (!defined $sock) {
309	print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
310	&tcp_configure();
311	return;
312	}
313
314	# Now run through the configuration process.
315	my($response);
316
317	print $sock "HEARTBEAT\n";
318	$response = <$sock>;
319	if (!$response eq "OK\n") {
320	close($sock);
321	print "Server gave wrong response to HEARTBEAT: $response\n";
322	&tcp_configure();
323	return;
324	}
325
326	print $sock "CONFIG\n";
327	$response = <$sock>;
328	if (!$response eq "OK\n") {
329	close($sock);
330	print "Server gave wrong response to CONFIG: $response\n";
331	&tcp_configure();
332	return;
333	}
334
335	print $sock "$file_list\n";
336	$response = <$sock>;
337	if (!$response eq "OK\n") {
338	close($sock);
339	print "Server gave wrong response to file list: $response\n";
340	&tcp_configure();
341	return;
342	}
343
344	print $sock "$last_modified\n";
345	$response = <$sock>;
346	if ($response eq "ERROR\n") {
347	close($sock);
348	print "Server configuration changed. Reconfiguring with filter manager.\n";
349	$doReconfigure = 1;
350	}
351	if (!$response eq "OK\n") {
352	close($sock);
353	print "Server gave wrong response to HEARTBEAT: $response\n";
354	&tcp_configure();
355	return;
356	}
357
358	print $sock "ENDHEARTBEAT\n";
359	$response = <$sock>;
360	if (!$response eq "OK\n") {
361	close($sock);
362	print "Server gave wrong response to ENDHEARTBEAT: $response\n";
363	&tcp_configure();
364	return;
365	}
366
367	close($sock);
368	print "^";
369
370	&tcp_configure() if $doReconfigure;
371
372	return;
373	}
374
375
376	#-----------------------------------------------------------------------
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
386	return;
387	}
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	}