ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/ihost-perl/ihost.pl
Revision: 1.51
Committed: Fri Mar 28 16:30:30 2003 UTC (21 years, 8 months ago) by tdb
Content type: text/plain
Branch: MAIN
CVS Tags: HEAD
Changes since 1.50: +1 -1 lines
State: FILE REMOVED
Error occurred while calculating annotation data.
Log Message:
Removed some un-used code from CVS. We can always resurrect this later if
someone feels they want to work on it. Gone are the old perl ihost which
isn't needed now, winhost which is broken and shows no sign of being fixed,
and DBReporter. If someone wants to revive them, I'll undelete them :-)

File Contents

# Content
1 #!/usr/bin/perl -w
2
3 #
4 # i-scream central monitoring system
5 # http://www.i-scream.org.uk
6 # Copyright (C) 2000-2002 i-scream
7 #
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License
10 # as published by the Free Software Foundation; either version 2
11 # of the License, or (at your option) any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21 #
22
23 # -----------------------------------------------------------
24 # Perl i-scream Host.
25 # http://www.i-scream.org.uk
26 #
27 # An all-in-one script to act as an i-scream host on
28 # a typical Unix/Linux box.
29 #
30 # $Author: tdb $
31 # $Id: ihost.pl,v 1.50 2002/05/21 16:47:11 tdb Exp $
32 #------------------------------------------------------------
33
34 $| = 1;
35
36 use strict;
37 use IO::Socket;
38 use Sys::Hostname;
39
40 use vars qw (
41 $filter_manager_addr
42 $filter_manager_port
43 $seq_no
44 $udp_update_time
45 $tcp_update_time
46 $last_udp_time
47 $last_tcp_time
48 $last_modified
49 $udp_port
50 $tcp_port
51 $filter_addr
52 $file_list
53 $fqdn
54 $pidfile
55 $retry_wait
56 $ostype
57 $key
58 @data
59 );
60
61 if (@ARGV != 2) {
62 die "Usage: ihost.pl [i-scream filter manager] [TCP port]\n";
63 }
64
65 $filter_manager_addr = $ARGV[0];
66 $filter_manager_port = $ARGV[1];
67
68 $seq_no = 1;
69 $retry_wait = 60;
70
71 # work out our platform, if we can.
72 $ostype = `uname -s`;
73 chomp $ostype;
74 $ostype = "unknown" if not defined $ostype;
75
76 # write our PID to a file
77 # use home dir by default
78 #$pidfile = $ENV{"HOME"};
79 # or drop it in /var/tmp if we can't find HOME
80 $pidfile = "/var/tmp" if not defined $pidfile;
81 $pidfile .= "/.ihost.pid";
82 &write_pid();
83
84 &tcp_configure();
85 &send_tcp_heartbeat();
86 &send_udp_packet();
87
88 $last_udp_time = time;
89 $last_tcp_time = time;
90 while (1) {
91 my($time) = time;
92 if ($time >= $last_udp_time + $udp_update_time) {
93 &send_udp_packet();
94 $last_udp_time = $time;
95 }
96 if ($time >= $last_tcp_time + $tcp_update_time) {
97 &send_tcp_heartbeat();
98 $last_tcp_time = $time;
99 }
100 my($next_udp) = $udp_update_time - $time + $last_udp_time;
101 my($next_tcp) = $tcp_update_time - $time + $last_tcp_time;
102 my($delay);
103 if ($next_udp < $next_tcp) {
104 $delay = $next_udp
105 }
106 else {
107 $delay = $next_tcp;
108 }
109 sleep $delay;
110 }
111
112 # we'll probably never get here...
113 `rm -f $pidfile`;
114 exit(0);
115
116
117 #-----------------------------------------------------------------------
118 # wait_then_retry
119 # Waits for the period of time specified in $retry_wait, then attempts
120 # to reconfigure with the server.
121 #-----------------------------------------------------------------------
122 sub wait_then_retry() {
123 print "Will retry configuration with filter manager in $retry_wait seconds.\n";
124 sleep $retry_wait;
125 }
126
127
128 #-----------------------------------------------------------------------
129 # tcp_configure
130 # Establishes a TCP connection to the specified i-scream filter manager.
131 # The host then requests details from the server, such as the intervals
132 # at which to send UDP packets.
133 #-----------------------------------------------------------------------
134 sub tcp_configure() {
135
136 while (1) {
137 my($sock) = new IO::Socket::INET(
138 PeerAddr => $filter_manager_addr,
139 PeerPort => $filter_manager_port,
140 Proto => 'tcp'
141 ) or die "Cannot connect!";
142 if (!defined $sock) {
143 print "IHOST ERROR: Could not connect to $filter_manager_addr:$filter_manager_port.\n";
144 print "Please check that there is an i-scream server at this address.\n";
145 wait_then_retry();
146 next;
147 }
148
149 # Now run through the configuration process...
150 my($response);
151
152 print $sock "STARTCONFIG\n";
153 $response = <$sock>;
154 if ($response && !($response eq "OK\n")) {
155 print "The i-scream server rejected the STARTCONFIG command.\n";
156 close($sock);
157 wait_then_retry();
158 next;
159 }
160
161 print "Config started okay.\n";
162
163 print $sock "LASTMODIFIED\n";
164 $response = <$sock>;
165 if (!$response || $response eq "ERROR\n") {
166 print "The i-scream server did not provide the LASTMODIFIED value.\n";
167 close($sock);
168 wait_then_retry();
169 next;
170 }
171 chomp $response;
172 $last_modified = $response;
173
174 print "Config last modified: ". (scalar localtime $last_modified/1000) . "\n";
175
176 print $sock "FILELIST\n";
177 $response = <$sock>;
178 if (!$response || $response eq "ERROR\n") {
179 print "The i-scream server did not provide a configuration file list.\n";
180 close($sock);
181 wait_then_retry();
182 next;
183 }
184 chomp $response;
185 $file_list = $response;
186
187 print "File list obtained: $file_list\n";
188
189 print $sock "FQDN\n";
190 $response = <$sock>;
191 if (!$response || $response eq "ERROR\n") {
192 print "The i-scream server did not tell us our FQDN.\n";
193 close($sock);
194 wait_then_retry();
195 next;
196 }
197 chomp $response;
198 $fqdn = $response;
199
200 print "FQDN returned: $fqdn\n";
201
202 print $sock "UDPUpdateTime\n";
203 $response = <$sock>;
204 if (!$response || $response eq "ERROR\n") {
205 print "The i-scream server did not give us a UDPUpdateTime.\n";
206 close($sock);
207 wait_then_retry();
208 next;
209 }
210 chomp $response;
211 $udp_update_time = $response;
212
213 print $sock "TCPUpdateTime\n";
214 $response = <$sock>;
215 if (!$response || $response eq "ERROR\n") {
216 print "The i-scream server did not give us a TCPUpdateTime.\n";
217 close($sock);
218 wait_then_retry();
219 next;
220 }
221 chomp $response;
222 $tcp_update_time = $response;
223
224 print "UDP packet period: $udp_update_time seconds.\nTCP heartbeat period: $tcp_update_time seconds.\n";
225
226 print $sock "ENDCONFIG\n";
227 $response = <$sock>;
228 if ($response && !($response eq "OK\n")) {
229 print "ENDCONFIG command to server failed. Terminated.\n";
230 close($sock);
231 wait_then_retry();
232 next;
233 }
234
235 print "Config ended.\n";
236
237 print $sock "FILTER\n";
238 $response = <$sock>;
239 if (!$response) {
240 print "Failed: Could not get a filter address from the filter manager.\n";
241 close($sock);
242 wait_then_retry();
243 next;
244 }
245 chomp $response;
246 if ($response eq "ERROR") {
247 print "There are no active configured filters for your host.\n";
248 close($sock);
249 wait_then_retry();
250 next;
251 }
252 $response =~ /^(.*);(.*);(.*)/;
253 ($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
254 unless (defined($filter_addr) && defined($udp_port) && defined($tcp_port)) {
255 print "Failed: Filter address response from server did not make sense: $response\n";
256 close($sock);
257 wait_then_retry();
258 next;
259 }
260
261 print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";
262
263 print $sock "END\n";
264 $response = <$sock>;
265 if ($response && ($response eq "OK\n")) {
266 print "Host successfully configured via TCP.\n"
267 }
268 else {
269 print "The server failed the host configuration on the END command.\n";
270 close($sock);
271 wait_then_retry();
272 next;
273 }
274
275 close($sock);
276
277 print "Configuration finished sucessfully!\n";
278 last;
279 }
280 return;
281 }
282
283
284 #-----------------------------------------------------------------------
285 # send_udp_packet
286 # Sends a UDP packet to an i-scream filter.
287 # The packet contains XML markup describing some of the machine's state.
288 # Receipt of UDP packets is not guaranteed.
289 #-----------------------------------------------------------------------
290 sub send_udp_packet() {
291
292 my($plugins_dir) = "plugins";
293
294 opendir PLUGINS, $plugins_dir;
295 my(@plugins) = readdir PLUGINS;
296 foreach my $plugin (@plugins) {
297 push @data, `$plugins_dir/$plugin $ostype` if -x "$plugins_dir/$plugin" && -f "$plugins_dir/$plugin";
298 }
299
300 # get some extra data
301 my($date) = time;
302 my($ip);
303 $ip = inet_ntoa(scalar(gethostbyname(hostname())) || 'localhost') or $ip = 'localhost';
304
305 # add some extra data to the array
306 push(@data, "packet.attributes.seq_no $seq_no");
307 push(@data, "packet.attributes.machine_name $fqdn");
308 push(@data, "packet.attributes.date $date");
309 push(@data, "packet.attributes.type data");
310 push(@data, "packet.attributes.ip $ip");
311 push(@data, "packet.attributes.key $key");
312
313 # sort the data
314 @data = sort(grep(!/^$/, grep(/^packet\./, @data)));
315
316 # turn the array into some nice XML
317 my($xml) = &make_xml("", "");
318
319 my($sock) = new IO::Socket::INET (
320 PeerPort => $udp_port,
321 PeerAddr => $filter_addr,
322 Proto => 'udp'
323 ) or die "Could not send UDP: $!\n";
324
325 print $sock $xml or die "Could not send UDP packet: $!\n";
326 close($sock);
327 $seq_no++;
328 print "-";
329
330 return;
331 }
332
333
334 #-----------------------------------------------------------------------
335 # send_tcp_heartbeat
336 # Establishes a TCP connection to an i-scream filter.
337 # The heartbeat is used as a guaranteed "I'm alive" delivery mechanism.
338 # If we need to reconfigure, then we complete the heartbeat before
339 # doing so.
340 #-----------------------------------------------------------------------
341 sub send_tcp_heartbeat() {
342
343 my ($doReconfigure) = 0;
344
345 my($sock) = new IO::Socket::INET(
346 PeerAddr => $filter_addr,
347 PeerPort => $tcp_port,
348 Proto => 'tcp'
349 ) or return;
350 if (!defined $sock) {
351 print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
352 &tcp_configure();
353 return;
354 }
355
356 # Now run through the configuration process.
357 my($response);
358
359 print $sock "HEARTBEAT\n";
360 $response = <$sock>;
361 if (!$response eq "OK\n") {
362 close($sock);
363 print "Server gave wrong response to HEARTBEAT: $response\n";
364 &tcp_configure();
365 return;
366 }
367
368 print $sock "CONFIG\n";
369 $response = <$sock>;
370 if (!$response eq "OK\n") {
371 close($sock);
372 print "Server gave wrong response to CONFIG: $response\n";
373 &tcp_configure();
374 return;
375 }
376
377 print $sock "$file_list\n";
378 $response = <$sock>;
379 if (!$response eq "OK\n") {
380 close($sock);
381 print "Server gave wrong response to file list: $response\n";
382 &tcp_configure();
383 return;
384 }
385
386 print $sock "$last_modified\n";
387 $response = <$sock>;
388 if ($response eq "ERROR\n") {
389 close($sock);
390 print "Server configuration changed. Reconfiguring with filter manager.\n";
391 $doReconfigure = 1;
392 }
393 if (!$response eq "OK\n") {
394 close($sock);
395 print "Server gave wrong response to HEARTBEAT: $response\n";
396 &tcp_configure();
397 return;
398 }
399
400 print $sock "KEY\n";
401 $key = <$sock>;
402
403 print $sock "ENDHEARTBEAT\n";
404 $response = <$sock>;
405 if (!$response eq "OK\n") {
406 close($sock);
407 print "Server gave wrong response to ENDHEARTBEAT: $response\n";
408 &tcp_configure();
409 return;
410 }
411
412 close($sock);
413 print "^";
414
415 &tcp_configure() if $doReconfigure;
416
417 return;
418 }
419
420
421 #-----------------------------------------------------------------------
422 # write_pid
423 # Writes the PID (process ID) of this instance to $pidfile.
424 # This is then used by a seperate script to check (and restart) ihost.
425 #-----------------------------------------------------------------------
426 sub write_pid() {
427 open PID, ">$pidfile";
428 print PID $$;
429 close PID;
430
431 return;
432 }
433
434 #-----------------------------------------------------------------------
435 # make_xml
436 # Turns an array of plugins data into an XML string.
437 #-----------------------------------------------------------------------
438 sub make_xml() {
439 my($curlevel, $curline) = @_;
440 my($xmltemp) = ""; my($curtag) = ""; my($attributes) = "";
441 while(1) {
442 $curline = shift(@data) if $curline eq "";
443 return $xmltemp if not defined $curline;
444 chomp $curline;
445 # dealing with nest (or attributes)
446 if($curline =~ /^$curlevel([^\.\s]+\.)/) {
447 $curtag=$1;
448 if($curline =~ /^$curlevel$curtag([^\.\s]+)\s+(.*)$/) {
449 $xmltemp .= &make_xml("$curlevel$curtag", $curline);
450 }
451 elsif($curline =~ /^$curlevel$curtag(attributes)\.([^\.\s]+)\s+(.*)$/) {
452 $attributes .= " $2=\"$3\"";
453 }
454 else {
455 $xmltemp .= &make_xml("$curlevel$curtag", $curline);
456 }
457 my($nextline) = $data[0]; chomp $nextline if defined $nextline;
458 $curtag =~ s/(.*)\./$1/;
459 if((defined $nextline) && ($nextline =~ /^$curlevel$curtag\./)) {
460 $curline = "";
461 }
462 else {
463 $xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
464 return $xmltemp;
465 }
466 }
467 # dealing with value
468 elsif($curline =~ /^$curlevel([^\.\s]+)\s+(.*)$/) {
469 $curtag=$1;
470 $xmltemp=$2;
471 my($nextline) = $data[0]; chomp $nextline if defined $nextline;
472 if(defined $nextline && ($nextline =~ /^$curlevel$curtag\./ || $nextline =~ /^$curlevel$curtag\s+/)) {
473 $curline = "";
474 }
475 else {
476 $xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
477 return $xmltemp;
478 }
479 }
480 # dealing with a null value
481 elsif($curline =~ /^$curlevel([^\.\s]+)$/) {
482 # simply adding a space makes the above elsif deal with it :)
483 # just level with an empty tag in the XML
484 $curline .= " ";
485 }
486 # failing all that, skip the line
487 else {
488 $curline = "";
489 }
490 }
491 }