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.  You may adapt the data-gathering
# methods as you see fit.
#  - pjm2@ukc.ac.uk
#
# $Author: tdb1 $
# $Id: ihost.pl,v 1.16 2001/02/13 12:28:50 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
            );

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;

&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`;
}

exit(0);


#-----------------------------------------------------------------------
# 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() {
    
    my($sock) = new IO::Socket::INET(
                                     PeerAddr => $filter_manager_addr,
                                     PeerPort => $filter_manager_port,
                                     Proto => 'tcp'
                                    );
    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";
        print "Program ended.\n";
        exit(1);
    }

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

    print "Config started okay.\n";
    
    print $sock "LASTMODIFIED\n";
    $response = <$sock>;
    chop $response;
    $last_modified = $response;
    
    print "Config last modified: ". (scalar localtime $last_modified/1000) . "\n";

    print $sock "FILELIST\n";
    $response = <$sock>;
    chop $response;
    $file_list = $response;

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

    print $sock "FQDN\n";
    $response = <$sock>;
    chop $response;
    $fqdn = $response;

    print "FQDN returned: $fqdn\n";

    print $sock "UDPUpdateTime\n";
    $response = <$sock>;
    chop $response;
    $udp_update_time = $response;

    print $sock "TCPUpdateTime\n";
    $response = <$sock>;
    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>;
    chomp $response;
    if (!$response eq "OK") {
        print "ENDCONFIG command to server failed.  Terminated.\n";
        exit(1);
    }

    print "Config ended.\n";
    
    print $sock "FILTER\n";
    $response = <$sock>;
    chop $response;
    $response =~ /(.*);(.*);(.*)/;
    ($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
    
    print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";

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

    print "Configuration finished sucessfully!\n";
    
    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() {

    my(@statgrab) = `./statgrab.pl`;
    my(%packet);
    for (my($i) = 0; $i <= $#statgrab; $i++) {
        $statgrab[$i] =~ /^([^\s]*) (.*)$/;
        $packet{$1} = $2;
    }
    
    my($date) = time;
    
    my($disk_info) = "<disk>";
    my($i) = 0;
    while (defined $packet{"packet.disk.p$i.attributes.mount"}) {
        $disk_info .= "<p$i";
        $disk_info .= " name=\"" . $packet{"packet.disk.p$i.attributes.name"} . "\"";
        $disk_info .= " kbytes=\"" . $packet{"packet.disk.p$i.attributes.kbytes"} . "\"";
        $disk_info .= " used=\"" . $packet{"packet.disk.p$i.attributes.used"} . "\"";
        $disk_info .= " avail=\"" . $packet{"packet.disk.p$i.attributes.avail"} . "\"";
        $disk_info .= " mount=\"" . $packet{"packet.disk.p$i.attributes.mount"} . "\"";
        $disk_info .= "></p$i>";
        ++$i;
    }
    $disk_info .= "</disk>";

    my($hostname) = hostname();
    $hostname =~ s/\..*$//g;
    my($resolv) = `cat /etc/resolv.conf`;
    my($domainname);
    my($machine_name);
    if($resolv =~ /domain\s+([^\s]+)/) {
        # some machines have domain <domain> in resolv.conf
        $domainname = $1;
        $machine_name = "$hostname.$domainname";
    }
    elsif($resolv =~ /search\s+([^\s]+)/) {
        # some machines have search <domain> in resolv.conf
        $domainname = $1;
        $machine_name = "$hostname.$domainname";
    }
    else {
        # we can't find out the domain
        $machine_name = $hostname;
    }
    my($ip) = inet_ntoa(scalar(gethostbyname($hostname)) || 'localhost');

    # Build the XML packet this way, as we can clearly
    # see the structure and contents... I like this ;-)
    # [Note that the server rejects UDP packets that are
    # larger than 8196 bytes]
    my($xml) = <<EOF;
    
<packet seq_no="$seq_no" machine_name="$machine_name" date="$date" type="data" ip="$ip">
    <load>
        <load1>$packet{"packet.load.load1"}</load1>
        <load5>$packet{"packet.load.load5"}</load5>
        <load15>$packet{"packet.load.load15"}</load15>
    </load>
    <os>
        <name>$packet{"packet.os.name"}</name>
        <release>$packet{"packet.os.release"}</release>
        <platform>$packet{"packet.os.platform"}</platform>
        <sysname>$packet{"packet.os.sysname"}</sysname>
        <version>$packet{"packet.os.version"}</version>
        <uptime>$packet{"packet.os.uptime"}</uptime>
    </os>
    <users>
        <count>$packet{"packet.users.count"}</count>
        <list>$packet{"packet.users.list"}</list>
    </users>
    <processes>
        <total>$packet{"packet.processes.total"}</total>
        <sleeping>$packet{"packet.processes.sleeping"}</sleeping>
        <zombie>$packet{"packet.processes.zombie"}</zombie>
        <stopped>$packet{"packet.processes.stopped"}</stopped>
        <cpu>$packet{"packet.processes.cpu"}</cpu>
    </processes>
    <cpu>
        <idle>$packet{"packet.cpu.idle"}</idle>
        <user>$packet{"packet.cpu.user"}</user>
        <kernel>$packet{"packet.cpu.kernel"}</kernel>
        <iowait>$packet{"packet.cpu.iowait"}</iowait>
        <swap>$packet{"packet.cpu.swap"}</swap>
    </cpu>
    <memory>
        <total>$packet{"packet.memory.total"}</total>
        <free>$packet{"packet.memory.free"}</free>
    </memory>
    <swap>
        <total>$packet{"packet.swap.total"}</total>
        <free>$packet{"packet.swap.free"}</free>
    </swap>
    $disk_info
</packet>

EOF

    # Make the packet smaller by stripping out newlines and leading spaces.
    $xml =~ s/\n\s*//g;
    
    my($sock) = new IO::Socket::INET (
                                      PeerPort => $udp_port,
                                      PeerAddr => $filter_addr,
                                      Proto => 'udp'
                                     ) or die "Socket: $!\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.
#-----------------------------------------------------------------------
sub send_tcp_heartbeat() {

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

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

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

    print $sock "$file_list\n";
    $response = <$sock>;
    chop $response;
    if (!$response eq "OK") {
        close($sock);
        print "Server gave wrong response to file list: $response\n";
        return;
    }
    
    print $sock "$last_modified\n";
    $response = <$sock>;
    chop $response;
    if ($response eq "ERROR") {
        close($sock);
        &tcp_configure();
        return;
    }
    if (!$response eq "OK") {
        close($sock);
        print "Server gave wrong response to HEARTBEAT: $response\n";
        return;
    }
    
    print $sock "ENDHEARTBEAT\n";
    $response = <$sock>;
    chop $response;
    if (!$response eq "OK") {
        close($sock);
        print "Server gave wrong response to ENDHEARTBEAT: $response\n";
        return;
    }
    
    close($sock);
    print "^";
    
    return;
}
Revision:	1.17
Committed:	Tue Feb 27 19:14:26 2001 UTC (24 years, 8 months ago) by pjm2
Content type:	text/plain
Branch:	MAIN
Changes since 1.16:	+10 -2 lines
Log Message:	Updated to comply with the new FilterManger configuration protocol. Namely, the ihost now also sends "FQDN" to the server to request its fully qualified domain name. This simplifies the task of writing hosts as it no longer means that the host has to work out its own machine name (which is sometimes a non-trivial task on certain platforms)
#	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. You may adapt the data-gathering
9	# methods as you see fit.
10	# - pjm2@ukc.ac.uk
11	#
12	# $Author: tdb1 $
13	# $Id: ihost.pl,v 1.16 2001/02/13 12:28:50 tdb1 Exp $
14	#------------------------------------------------------------
15
16	$\| = 1;
17
18	use strict;
19	use IO::Socket;
20	use Sys::Hostname;
21
22	use vars qw (
23	$filter_manager_addr
24	$filter_manager_port
25	$seq_no
26	$udp_update_time
27	$tcp_update_time
28	$last_udp_time
29	$last_tcp_time
30	$last_modified
31	$udp_port
32	$tcp_port
33	$filter_addr
34	$file_list
35	$fqdn
36	);
37
38	if (@ARGV != 2) {
39	die "Usage: ihost.pl [i-scream filter manager] [TCP port]\n";
40	}
41
42	$filter_manager_addr = $ARGV[0];
43	$filter_manager_port = $ARGV[1];
44
45	$seq_no = 1;
46
47	&tcp_configure();
48	&send_udp_packet();
49
50	$last_udp_time = time;
51	$last_tcp_time = time;
52	while (1) {
53	my($time) = time;
54	if ($time >= $last_udp_time + $udp_update_time) {
55	&send_udp_packet();
56	$last_udp_time = $time;
57	}
58	if ($time >= $last_tcp_time + $tcp_update_time) {
59	&send_tcp_heartbeat();
60	$last_tcp_time = $time;
61	}
62	my($next_udp) = $udp_update_time - $time + $last_udp_time;
63	my($next_tcp) = $tcp_update_time - $time + $last_tcp_time;
64	my($delay);
65	if ($next_udp < $next_tcp) {
66	$delay = $next_udp
67	}
68	else {
69	$delay = $next_tcp;
70	}
71	`sleep $delay`;
72	}
73
74	exit(0);
75
76
77	#-----------------------------------------------------------------------
78	# tcp_configure
79	# Establishes a TCP connection to the specified i-scream filter manager.
80	# The host then requests details from the server, such as the intervals
81	# at which to send UDP packets.
82	#-----------------------------------------------------------------------
83	sub tcp_configure() {
84
85	my($sock) = new IO::Socket::INET(
86	PeerAddr => $filter_manager_addr,
87	PeerPort => $filter_manager_port,
88	Proto => 'tcp'
89	);
90	if (!defined $sock) {
91	print "IHOST ERROR: Could not connect to $filter_manager_addr:$filter_manager_port.\n";
92	print "Please check that there is an i-scream server at this address.\n";
93	print "Program ended.\n";
94	exit(1);
95	}
96
97	# Now run through the configuration process...
98	my($response);
99
100	print $sock "STARTCONFIG\n";
101	$response = <$sock>;
102	if (!chop $response eq "OK") {
103	print "The i-scream server rejected the STARTCONFIG command. Terminated.";
104	exit(1);
105	}
106
107	print "Config started okay.\n";
108
109	print $sock "LASTMODIFIED\n";
110	$response = <$sock>;
111	chop $response;
112	$last_modified = $response;
113
114	print "Config last modified: ". (scalar localtime $last_modified/1000) . "\n";
115
116	print $sock "FILELIST\n";
117	$response = <$sock>;
118	chop $response;
119	$file_list = $response;
120
121	print "File list obtained: $file_list\n";
122
123	print $sock "FQDN\n";
124	$response = <$sock>;
125	chop $response;
126	$fqdn = $response;
127
128	print "FQDN returned: $fqdn\n";
129
130	print $sock "UDPUpdateTime\n";
131	$response = <$sock>;
132	chop $response;
133	$udp_update_time = $response;
134
135	print $sock "TCPUpdateTime\n";
136	$response = <$sock>;
137	chop $response;
138	$tcp_update_time = $response;
139
140	print "UDP packet period: $udp_update_time seconds.\nTCP heartbeat period: $tcp_update_time seconds.\n";
141
142	print $sock "ENDCONFIG\n";
143	$response = <$sock>;
144	chomp $response;
145	if (!$response eq "OK") {
146	print "ENDCONFIG command to server failed. Terminated.\n";
147	exit(1);
148	}
149
150	print "Config ended.\n";
151
152	print $sock "FILTER\n";
153	$response = <$sock>;
154	chop $response;
155	$response =~ /(.);(.);(.*)/;
156	($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
157
158	print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";
159
160	print $sock "END\n";
161	$response = <$sock>;
162	chop $response;
163	if ($response eq "OK") {
164	print "Host successfully configured via TCP.\n"
165	}
166	else {
167	print "The server failed the host configuration on the END command.";
168	exit(1);
169	}
170
171	close($sock);
172
173	print "Configuration finished sucessfully!\n";
174
175	return;
176	}
177
178
179
180
181	#-----------------------------------------------------------------------
182	# send_udp_packet
183	# Sends a UDP packet to an i-scream filter.
184	# The packet contains XML markup describing some of the machine's state.
185	# Receipt of UDP packets is not guaranteed.
186	#-----------------------------------------------------------------------
187	sub send_udp_packet() {
188
189	my(@statgrab) = `./statgrab.pl`;
190	my(%packet);
191	for (my($i) = 0; $i <= $#statgrab; $i++) {
192	$statgrab[$i] =~ /^([^\s]) (.)$/;
193	$packet{$1} = $2;
194	}
195
196	my($date) = time;
197
198	my($disk_info) = "<disk>";
199	my($i) = 0;
200	while (defined $packet{"packet.disk.p$i.attributes.mount"}) {
201	$disk_info .= "<p$i";
202	$disk_info .= " name=\"" . $packet{"packet.disk.p$i.attributes.name"} . "\"";
203	$disk_info .= " kbytes=\"" . $packet{"packet.disk.p$i.attributes.kbytes"} . "\"";
204	$disk_info .= " used=\"" . $packet{"packet.disk.p$i.attributes.used"} . "\"";
205	$disk_info .= " avail=\"" . $packet{"packet.disk.p$i.attributes.avail"} . "\"";
206	$disk_info .= " mount=\"" . $packet{"packet.disk.p$i.attributes.mount"} . "\"";
207	$disk_info .= "></p$i>";
208	++$i;
209	}
210	$disk_info .= "</disk>";
211
212	my($hostname) = hostname();
213	$hostname =~ s/\..*$//g;
214	my($resolv) = `cat /etc/resolv.conf`;
215	my($domainname);
216	my($machine_name);
217	if($resolv =~ /domain\s+([^\s]+)/) {
218	# some machines have domain <domain> in resolv.conf
219	$domainname = $1;
220	$machine_name = "$hostname.$domainname";
221	}
222	elsif($resolv =~ /search\s+([^\s]+)/) {
223	# some machines have search <domain> in resolv.conf
224	$domainname = $1;
225	$machine_name = "$hostname.$domainname";
226	}
227	else {
228	# we can't find out the domain
229	$machine_name = $hostname;
230	}
231	my($ip) = inet_ntoa(scalar(gethostbyname($hostname)) \|\| 'localhost');
232
233	# Build the XML packet this way, as we can clearly
234	# see the structure and contents... I like this ;-)
235	# [Note that the server rejects UDP packets that are
236	# larger than 8196 bytes]
237	my($xml) = <<EOF;
238
239	<packet seq_no="$seq_no" machine_name="$machine_name" date="$date" type="data" ip="$ip">
240	<load>
241	<load1>$packet{"packet.load.load1"}</load1>
242	<load5>$packet{"packet.load.load5"}</load5>
243	<load15>$packet{"packet.load.load15"}</load15>
244	</load>
245	<os>
246	<name>$packet{"packet.os.name"}</name>
247	<release>$packet{"packet.os.release"}</release>
248	<platform>$packet{"packet.os.platform"}</platform>
249	<sysname>$packet{"packet.os.sysname"}</sysname>
250	<version>$packet{"packet.os.version"}</version>
251	<uptime>$packet{"packet.os.uptime"}</uptime>
252	</os>
253	<users>
254	<count>$packet{"packet.users.count"}</count>
255	<list>$packet{"packet.users.list"}</list>
256	</users>
257	<processes>
258	<total>$packet{"packet.processes.total"}</total>
259	<sleeping>$packet{"packet.processes.sleeping"}</sleeping>
260	<zombie>$packet{"packet.processes.zombie"}</zombie>
261	<stopped>$packet{"packet.processes.stopped"}</stopped>
262	<cpu>$packet{"packet.processes.cpu"}</cpu>
263	</processes>
264	<cpu>
265	<idle>$packet{"packet.cpu.idle"}</idle>
266	<user>$packet{"packet.cpu.user"}</user>
267	<kernel>$packet{"packet.cpu.kernel"}</kernel>
268	<iowait>$packet{"packet.cpu.iowait"}</iowait>
269	<swap>$packet{"packet.cpu.swap"}</swap>
270	</cpu>
271	<memory>
272	<total>$packet{"packet.memory.total"}</total>
273	<free>$packet{"packet.memory.free"}</free>
274	</memory>
275	<swap>
276	<total>$packet{"packet.swap.total"}</total>
277	<free>$packet{"packet.swap.free"}</free>
278	</swap>
279	$disk_info
280	</packet>
281
282	EOF
283
284	# Make the packet smaller by stripping out newlines and leading spaces.
285	$xml =~ s/\n\s*//g;
286
287	my($sock) = new IO::Socket::INET (
288	PeerPort => $udp_port,
289	PeerAddr => $filter_addr,
290	Proto => 'udp'
291	) or die "Socket: $!\n";
292
293	print $sock $xml or die "Could not send UDP packet: $!\n";
294	close($sock);
295	$seq_no++;
296	print "-";
297
298	return;
299	}
300
301
302
303
304	#-----------------------------------------------------------------------
305	# send_tcp_heartbeat
306	# Establishes a TCP connection to an i-scream filter.
307	# The heartbeat is used as a guaranteed "I'm alive" delivery mechanism.
308	#-----------------------------------------------------------------------
309	sub send_tcp_heartbeat() {
310
311	my($sock) = new IO::Socket::INET(
312	PeerAddr => $filter_addr,
313	PeerPort => $tcp_port,
314	Proto => 'tcp'
315	);
316	if (!defined $sock) {
317	print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
318	return;
319	}
320
321	# Now run through the configuration process.
322	my($response);
323
324	print $sock "HEARTBEAT\n";
325	$response = <$sock>;
326	chop $response;
327	if (!$response eq "OK") {
328	close($sock);
329	print "Server gave wrong response to HEARTBEAT: $response\n";
330	return;
331	}
332
333	print $sock "CONFIG\n";
334	$response = <$sock>;
335	chop $response;
336	if (!$response eq "OK") {
337	close($sock);
338	print "Server gave wrong response to CONFIG: $response\n";
339	return;
340	}
341
342	print $sock "$file_list\n";
343	$response = <$sock>;
344	chop $response;
345	if (!$response eq "OK") {
346	close($sock);
347	print "Server gave wrong response to file list: $response\n";
348	return;
349	}
350
351	print $sock "$last_modified\n";
352	$response = <$sock>;
353	chop $response;
354	if ($response eq "ERROR") {
355	close($sock);
356	&tcp_configure();
357	return;
358	}
359	if (!$response eq "OK") {
360	close($sock);
361	print "Server gave wrong response to HEARTBEAT: $response\n";
362	return;
363	}
364
365	print $sock "ENDHEARTBEAT\n";
366	$response = <$sock>;
367	chop $response;
368	if (!$response eq "OK") {
369	close($sock);
370	print "Server gave wrong response to ENDHEARTBEAT: $response\n";
371	return;
372	}
373
374	close($sock);
375	print "^";
376
377	return;
378	}