ViewVC Help

View File | Revision Log | Show Annotations | Revision Graph | Root Listing

root/i-scream/projects/cms/source/host/ihost-perl/ihost.pl

Comparing projects/cms/source/host/ihost-perl/ihost.pl (file contents):
Revision 1.10 by tdb, Thu Feb 1 03:17:32 2001 UTC vs.
Revision 1.26 by tdb, Mon Mar 12 23:51:15 2001 UTC

#	Line 2 | Line 2
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
#	Line 31 | Line 32 | use vars qw (
32		$tcp_port
33		$filter_addr
34		$file_list
35	+	$fqdn
36	+	$pidfile
37		);
38
39		if (@ARGV != 2) {
#	Line 42 | Line 45 | $filter_manager_port = $ARGV[1];
45
46		$seq_no = 1;
47
48	+	# write our PID to a file
49	+	$pidfile = "/var/tmp/ihost.pid";
50	+	&write_pid();
51	+
52		&tcp_configure();
53		&send_udp_packet();
54
#	Line 69 | Line 76 | while (1) {
76		`sleep $delay`;
77		}
78
79	+	# we'll probably never get here...
80	+	`rm -f $pidfile`;
81		exit(0);
82
83	+
84	+	#-----------------------------------------------------------------------
85	+	# tcp_configure
86	+	# Establishes a TCP connection to the specified i-scream filter manager.
87	+	# The host then requests details from the server, such as the intervals
88	+	# at which to send UDP packets.
89	+	#-----------------------------------------------------------------------
90		sub tcp_configure() {
91
92		my($sock) = new IO::Socket::INET(
93		PeerAddr => $filter_manager_addr,
94		PeerPort => $filter_manager_port,
95		Proto => 'tcp'
96	<	) or die "Could not perform configuration via TCP: $!\n";
96	>	) or die "Cannot connect!";
97	>	if (!defined $sock) {
98	>	print "IHOST ERROR: Could not connect to $filter_manager_addr:$filter_manager_port.\n";
99	>	print "Please check that there is an i-scream server at this address.\n";
100	>	print "Program ended.\n";
101	>	exit(1);
102	>	}
103
104	<	die "Could not connect to the i-scream filter manager: $!\n" unless $sock;
83	<
84	<	# Now run through the configuration process.
104	>	# Now run through the configuration process...
105		my($response);
106
107		print $sock "STARTCONFIG\n";
#	Line 107 | Line 127 | sub tcp_configure() {
127
128		print "File list obtained: $file_list\n";
129
130	+	print $sock "FQDN\n";
131	+	$response = <$sock>;
132	+	chop $response;
133	+	$fqdn = $response;
134	+
135	+	print "FQDN returned: $fqdn\n";
136	+
137		print $sock "UDPUpdateTime\n";
138		$response = <$sock>;
139		chop $response;
#	Line 131 | Line 158 | sub tcp_configure() {
158
159		print $sock "FILTER\n";
160		$response = <$sock>;
161	+	unless (defined($response)) {
162	+	print "Failed: Could not get a filter address from the filter manager.\n";
163	+	exit(1);
164	+	}
165		chop $response;
166		$response =~ /(.*);(.*);(.*)/;
167		($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
168	+	unless (defined($filter_addr) && defined($udp_port) && defined($tcp_port)) {
169	+	print "Failed: Filter address response from server did not make sense: $response\n";
170	+	exit(1);
171	+	}
172
173		print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";
174
#	Line 151 | Line 186 | sub tcp_configure() {
186		close($sock);
187
188		print "Configuration finished sucessfully!\n";
189	+
190	+	return;
191		}
192
193	+
194	+
195	+
196	+	#-----------------------------------------------------------------------
197	+	# send_udp_packet
198	+	# Sends a UDP packet to an i-scream filter.
199	+	# The packet contains XML markup describing some of the machine's state.
200	+	# Receipt of UDP packets is not guaranteed.
201	+	#-----------------------------------------------------------------------
202		sub send_udp_packet() {
203
204		my(@statgrab) = `./statgrab.pl`;
205		my(%packet);
206	<	for (my($i) = 0; $i < $#statgrab; $i++) {
206	>	for (my($i) = 0; $i <= $#statgrab; $i++) {
207		$statgrab[$i] =~ /^([^\s]*) (.*)$/;
208		$packet{$1} = $2;
209		}
#	Line 167 | Line 213 | sub send_udp_packet() {
213		my($disk_info) = "<disk>";
214		my($i) = 0;
215		while (defined $packet{"packet.disk.p$i.attributes.mount"}) {
216	<	$disk_info .= "<p$i>";
217	<	$disk_info .= qq/<name>$packet{"packet.disk.p$i.attributes.name"}<\/name>/;
218	<	$disk_info .= qq/<kbytes>$packet{"packet.disk.p$i.attributes.kbytes"}<\/kbytes>/;
219	<	$disk_info .= qq/<used>$packet{"packet.disk.p$i.attributes.used"}<\/used>/;
220	<	$disk_info .= qq/<avail>$packet{"packet.disk.p$i.attributes.avail"}<\/avail>/;
221	<	$disk_info .= qq/<mount>$packet{"packet.disk.p$i.attributes.mount"}<\/mount>/;
222	<	$disk_info .= "</p$i>";
216	>	$disk_info .= "<p$i";
217	>	$disk_info .= " name=\"" . $packet{"packet.disk.p$i.attributes.name"} . "\"";
218	>	$disk_info .= " kbytes=\"" . $packet{"packet.disk.p$i.attributes.kbytes"} . "\"";
219	>	$disk_info .= " used=\"" . $packet{"packet.disk.p$i.attributes.used"} . "\"";
220	>	$disk_info .= " avail=\"" . $packet{"packet.disk.p$i.attributes.avail"} . "\"";
221	>	$disk_info .= " mount=\"" . $packet{"packet.disk.p$i.attributes.mount"} . "\"";
222	>	$disk_info .= "></p$i>";
223		++$i;
224		}
225		$disk_info .= "</disk>";
226
227	<	my($hostname) = hostname();
182	<	$hostname =~ s/\..*$//g;
183	<	`cat /etc/resolv.conf` =~ /domain\s+([^\s]+)/;
184	<	my($domainname) = $1;
185	<	my($machine_name) = "$hostname.$domainname";
186	<	my($ip) = inet_ntoa(scalar(gethostbyname($hostname)) || 'localhost');
227	>	my($ip) = inet_ntoa(scalar(gethostbyname(hostname())) || 'localhost');
228
229		# Build the XML packet this way, as we can clearly
230		# see the structure and contents... I like this ;-)
231	+	# [Note that the server rejects UDP packets that are
232	+	# larger than 8196 bytes]
233		my($xml) = <<EOF;
234
235	<	<packet seq_no="$seq_no" machine_name="$machine_name" date="$date" type="data" ip="$ip">
235	>	<packet seq_no="$seq_no" machine_name="$fqdn" date="$date" type="data" ip="$ip">
236		<load>
237		<load1>$packet{"packet.load.load1"}</load1>
238		<load5>$packet{"packet.load.load5"}</load5>
#	Line 222 | Line 265 | sub send_udp_packet() {
265		<swap>$packet{"packet.cpu.swap"}</swap>
266		</cpu>
267		<memory>
268	<	<total>$packet{"packet.memory.real"}</total>
268	>	<total>$packet{"packet.memory.total"}</total>
269		<free>$packet{"packet.memory.free"}</free>
270		</memory>
271		<swap>
272	<	<total>$packet{"packet.memory.swap_total"}</total>
273	<	<free>$packet{"packet.memory.swap_free"}</free>
272	>	<total>$packet{"packet.swap.total"}</total>
273	>	<free>$packet{"packet.swap.free"}</free>
274		</swap>
275		$disk_info
276		</packet>
277
278		EOF
279
280	+	# Make the packet smaller by stripping out newlines and leading spaces.
281		$xml =~ s/\n\s*//g;
282	<
282	>
283		my($sock) = new IO::Socket::INET (
284		PeerPort => $udp_port,
285		PeerAddr => $filter_addr,
286		Proto => 'udp'
287	<	) or die "Socket: $!\n";
287	>	) or die "Could not send UDP: $!\n";
288
289		print $sock $xml or die "Could not send UDP packet: $!\n";
290		close($sock);
291		$seq_no++;
292		print "-";
293	+
294	+	return;
295		}
296
297	+
298	+
299	+
300	+	#-----------------------------------------------------------------------
301	+	# send_tcp_heartbeat
302	+	# Establishes a TCP connection to an i-scream filter.
303	+	# The heartbeat is used as a guaranteed "I'm alive" delivery mechanism.
304	+	#-----------------------------------------------------------------------
305		sub send_tcp_heartbeat() {
306
307		my($sock) = new IO::Socket::INET(
308		PeerAddr => $filter_addr,
309		PeerPort => $tcp_port,
310		Proto => 'tcp'
311	<	) or die "Could not perform heartbeat via TCP: $!\n";
311	>	) or return;
312	>	if (!defined $sock) {
313	>	print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
314	>	return;
315	>	}
316
259	–	die "Could not connect to the i-scream filter: $!\n" unless $sock;
260	–
317		# Now run through the configuration process.
318		my($response);
319
320		print $sock "HEARTBEAT\n";
321		$response = <$sock>;
322	+	return if (!defined $response);
323		chop $response;
324		if (!$response eq "OK") {
325		close($sock);
#	Line 272 | Line 329 | sub send_tcp_heartbeat() {
329
330		print $sock "CONFIG\n";
331		$response = <$sock>;
332	+	return if (!defined $response);
333		chop $response;
334		if (!$response eq "OK") {
335		close($sock);
#	Line 281 | Line 339 | sub send_tcp_heartbeat() {
339
340		print $sock "$file_list\n";
341		$response = <$sock>;
342	+	return if (!defined $response);
343		chop $response;
344		if (!$response eq "OK") {
345		close($sock);
#	Line 290 | Line 349 | sub send_tcp_heartbeat() {
349
350		print $sock "$last_modified\n";
351		$response = <$sock>;
352	+	return if (!defined $response);
353		chop $response;
354		if ($response eq "ERROR") {
355		close($sock);
#	Line 304 | Line 364 | sub send_tcp_heartbeat() {
364
365		print $sock "ENDHEARTBEAT\n";
366		$response = <$sock>;
367	+	return if (!defined $response);
368		chop $response;
369		if (!$response eq "OK") {
370		close($sock);
#	Line 313 | Line 374 | sub send_tcp_heartbeat() {
374
375		close($sock);
376		print "^";
377	+
378	+	return;
379	+	}
380	+
381	+	#-----------------------------------------------------------------------
382	+	# write_pid
383	+	# Writes the PID (process ID) of this instance to $pidfile.
384	+	# This is then used by a seperate script to check (and restart) ihost.
385	+	#-----------------------------------------------------------------------
386	+	sub write_pid() {
387	+	open PID, ">$pidfile";
388	+	print PID $$;
389	+	close PID;
390	+
391	+	return;
392		}

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines