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.42 2001/11/21 10:08:20 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
             @data
            );

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
# use home dir by default
#$pidfile = $ENV{"HOME"};
# or drop it in /var/tmp if we can't find HOME
$pidfile = "/var/tmp" if not defined $pidfile;
$pidfile .= "/.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() {

    my($plugins_dir) = "plugins";
    
    opendir PLUGINS, $plugins_dir;
    my(@plugins) = readdir PLUGINS;
    foreach my $plugin (@plugins) {
        push @data, `$plugins_dir/$plugin` if -x "$plugins_dir/$plugin" && -f "$plugins_dir/$plugin";
    }
    
    # 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(@data, "packet.attributes.seq_no $seq_no");
    push(@data, "packet.attributes.machine_name $fqdn");
    push(@data, "packet.attributes.date $date");
    push(@data, "packet.attributes.type data");
    push(@data, "packet.attributes.ip $ip");
    
    # sort the data
    @data = sort(grep(!/^$/, grep(/^packet\./, @data)));

    # 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 plugins data into an XML string.
#-----------------------------------------------------------------------
sub make_xml() {
    my($curlevel, $curline) = @_;
    my($xmltemp) = ""; my($curtag) = ""; my($attributes) = "";
    while(1) {
        $curline = shift(@data) if $curline eq "";
        return $xmltemp if not defined $curline;
        chomp $curline;
        # dealing with nest (or attributes)
        if($curline =~ /^$curlevel([^\.\s]+\.)/) {
            $curtag=$1;
            if($curline =~ /^$curlevel$curtag([^\.\s]+)\s+(.*)$/) {
                $xmltemp .= &make_xml("$curlevel$curtag", $curline);
            }
            elsif($curline =~ /^$curlevel$curtag(attributes)\.([^\.\s]+)\s+(.*)$/) {
                $attributes .= " $2=\"$3\"";
            }
            else {
                $xmltemp .= &make_xml("$curlevel$curtag", $curline);
            }
            my($nextline) = $data[0]; chomp $nextline if defined $nextline;
            if((defined $nextline) && ($nextline =~ /^$curlevel$curtag/)) {
                $curline = ""; 
            }
            else {
                $curtag =~ s/(.*)\./$1/;
                $xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
                return $xmltemp;
            }
        }
        # dealing with value
        elsif($curline =~ /^$curlevel([^\.\s]+)\s+(.*)$/) {
            $curtag=$1;
            $xmltemp=$2;           
            my($nextline) = $data[0]; chomp $nextline if defined $nextline;
            if(defined $nextline && ($nextline =~ /^$curlevel$curtag\./ || $nextline =~ /^$curlevel$curtag\s+/)) {
                $curline = ""; 
            }
            else {
                $xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
                return $xmltemp;
            }
        }
    }
}
Revision:	1.43
Committed:	Tue Dec 18 03:51:11 2001 UTC (22 years, 9 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
Changes since 1.42:	+43 -27 lines
Log Message:	A bunch of changes to the XML handling. Firstly the packet tag's attributes were being put in wrong, how this got through I don't know! (they were being parsed correctly too, which is kinda odd -- how could both right and wrong attribute tags be parsed?) Secondly the inputted data from plugins is pruned slightly. All blank lines are dropped, along with any lines that don't start with "packet." (this is a requirement I guess) Then the XML code has been made slightly more robust. It wasn't dealing with attributes correctly before, although it went unnoticed. Testing has been a bit more thorough this time, although there could still be bugs. It's a slightly confusing block of recursive code :)
#	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	tdb	1.43	# $Id: ihost.pl,v 1.42 2001/11/21 10:08:20 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.37	@data
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.41	# use home dir by default
51	tdb	1.42	#$pidfile = $ENV{"HOME"};
52	tdb	1.41	# or drop it in /var/tmp if we can't find HOME
53			$pidfile = "/var/tmp" if not defined $pidfile;
54			$pidfile .= "/.ihost.pid";
55	tdb	1.25	&write_pid();
56
57	pjm2	1.1	&tcp_configure();
58			&send_udp_packet();
59
60			$last_udp_time = time;
61			$last_tcp_time = time;
62			while (1) {
63	pjm2	1.9	my($time) = time;
64			if ($time >= $last_udp_time + $udp_update_time) {
65	pjm2	1.1	&send_udp_packet();
66	pjm2	1.9	$last_udp_time = $time;
67	pjm2	1.1	}
68	pjm2	1.9	if ($time >= $last_tcp_time + $tcp_update_time) {
69	pjm2	1.1	&send_tcp_heartbeat();
70	pjm2	1.9	$last_tcp_time = $time;
71	pjm2	1.1	}
72	pjm2	1.9	my($next_udp) = $udp_update_time - $time + $last_udp_time;
73			my($next_tcp) = $tcp_update_time - $time + $last_tcp_time;
74			my($delay);
75			if ($next_udp < $next_tcp) {
76			$delay = $next_udp
77			}
78			else {
79			$delay = $next_tcp;
80			}
81	tdb	1.35	sleep $delay;
82	pjm2	1.1	}
83
84	tdb	1.25	# we'll probably never get here...
85			`rm -f $pidfile`;
86	pjm2	1.1	exit(0);
87
88	pjm2	1.12
89			#-----------------------------------------------------------------------
90	pjm2	1.28	# wait_then_retry
91			# Waits for the period of time specified in $retry_wait, then attempts
92			# to reconfigure with the server.
93			#-----------------------------------------------------------------------
94			sub wait_then_retry() {
95			print "Will retry configuration with filter manager in $retry_wait seconds.\n";
96	tdb	1.35	sleep $retry_wait;
97	pjm2	1.28	}
98
99
100			#-----------------------------------------------------------------------
101	pjm2	1.12	# tcp_configure
102			# Establishes a TCP connection to the specified i-scream filter manager.
103			# The host then requests details from the server, such as the intervals
104			# at which to send UDP packets.
105			#-----------------------------------------------------------------------
106	pjm2	1.1	sub tcp_configure() {
107
108	pjm2	1.31	while (1) {
109	pjm2	1.28	my($sock) = new IO::Socket::INET(
110			PeerAddr => $filter_manager_addr,
111			PeerPort => $filter_manager_port,
112			Proto => 'tcp'
113			) or die "Cannot connect!";
114			if (!defined $sock) {
115			print "IHOST ERROR: Could not connect to $filter_manager_addr:$filter_manager_port.\n";
116			print "Please check that there is an i-scream server at this address.\n";
117			wait_then_retry();
118			next;
119			}
120
121			# Now run through the configuration process...
122			my($response);
123
124			print $sock "STARTCONFIG\n";
125			$response = <$sock>;
126	pjm2	1.32	if ($response && !($response eq "OK\n")) {
127			print "The i-scream server rejected the STARTCONFIG command.\n";
128	pjm2	1.28	close($sock);
129			wait_then_retry();
130			next;
131			}
132
133			print "Config started okay.\n";
134
135			print $sock "LASTMODIFIED\n";
136			$response = <$sock>;
137	pjm2	1.32	if (!$response) {
138			print "The i-scream server did not return anything for the LASTMODIFIED command.\n";
139			close($sock);
140			wait_then_retry();
141			next;
142			}
143	pjm2	1.28	chop $response;
144			$last_modified = $response;
145
146			print "Config last modified: ". (scalar localtime $last_modified/1000) . "\n";
147
148			print $sock "FILELIST\n";
149			$response = <$sock>;
150	pjm2	1.32	if (!$response) {
151			print "The i-scream server did not provide a configuration file list.\n";
152			close($sock);
153			wait_then_retry();
154			next;
155			}
156	pjm2	1.28	chop $response;
157			$file_list = $response;
158
159			print "File list obtained: $file_list\n";
160
161			print $sock "FQDN\n";
162			$response = <$sock>;
163	pjm2	1.32	if (!$response) {
164			print "The i-scream server did not tell us our FQDN.\n";
165			close($sock);
166			wait_then_retry();
167			next;
168			}
169	pjm2	1.28	chop $response;
170			$fqdn = $response;
171
172			print "FQDN returned: $fqdn\n";
173
174			print $sock "UDPUpdateTime\n";
175			$response = <$sock>;
176	pjm2	1.32	if (!$response) {
177			print "The i-scream server did not give us a UDPUpdateTime.\n";
178			close($sock);
179			wait_then_retry();
180			next;
181			}
182	pjm2	1.28	chop $response;
183			$udp_update_time = $response;
184
185			print $sock "TCPUpdateTime\n";
186			$response = <$sock>;
187	pjm2	1.32	if (!$response) {
188			print "The i-scream server did not give us a TCPUpdateTime.\n";
189			close($sock);
190			wait_then_retry();
191			next;
192			}
193	pjm2	1.28	chop $response;
194			$tcp_update_time = $response;
195
196			print "UDP packet period: $udp_update_time seconds.\nTCP heartbeat period: $tcp_update_time seconds.\n";
197
198			print $sock "ENDCONFIG\n";
199			$response = <$sock>;
200	pjm2	1.32	if ($response && !($response eq "OK\n")) {
201	pjm2	1.28	print "ENDCONFIG command to server failed. Terminated.\n";
202			close($sock);
203			wait_then_retry();
204			next;
205			}
206
207			print "Config ended.\n";
208
209			print $sock "FILTER\n";
210			$response = <$sock>;
211	pjm2	1.32	if (!$response) {
212	pjm2	1.28	print "Failed: Could not get a filter address from the filter manager.\n";
213			close($sock);
214			wait_then_retry();
215			next;
216			}
217			chop $response;
218	pjm2	1.32	$response =~ /^(.);(.);(.*)/;
219	pjm2	1.28	if ($response eq "ERROR") {
220			print "There are no active configured filters for your host.\n";
221			close($sock);
222			wait_then_retry();
223			next;
224			}
225			($filter_addr, $udp_port, $tcp_port) = ($1, $2, $3);
226			unless (defined($filter_addr) && defined($udp_port) && defined($tcp_port)) {
227			print "Failed: Filter address response from server did not make sense: $response\n";
228			close($sock);
229			wait_then_retry();
230			next;
231			}
232
233			print "Got filter data ($filter_addr, $udp_port, $tcp_port)\n";
234
235			print $sock "END\n";
236			$response = <$sock>;
237	pjm2	1.32	if ($response && ($response eq "OK\n")) {
238	pjm2	1.28	print "Host successfully configured via TCP.\n"
239			}
240			else {
241	pjm2	1.32	print "The server failed the host configuration on the END command.\n";
242	pjm2	1.28	close($sock);
243			wait_then_retry();
244			next;
245			}
246	pjm2	1.1
247	pjm2	1.28	close($sock);
248	pjm2	1.1
249	pjm2	1.28	print "Configuration finished sucessfully!\n";
250			last;
251	pjm2	1.1	}
252	pjm2	1.12	return;
253	pjm2	1.1	}
254
255	pjm2	1.12
256			#-----------------------------------------------------------------------
257			# send_udp_packet
258			# Sends a UDP packet to an i-scream filter.
259			# The packet contains XML markup describing some of the machine's state.
260			# Receipt of UDP packets is not guaranteed.
261			#-----------------------------------------------------------------------
262	pjm2	1.1	sub send_udp_packet() {
263
264	tdb	1.37	my($plugins_dir) = "plugins";
265
266			opendir PLUGINS, $plugins_dir;
267			my(@plugins) = readdir PLUGINS;
268			foreach my $plugin (@plugins) {
269			push @data, `$plugins_dir/$plugin` if -x "$plugins_dir/$plugin" && -f "$plugins_dir/$plugin";
270			}
271	pjm2	1.1
272	tdb	1.36	# get some extra data
273	pjm2	1.1	my($date) = time;
274	pjm2	1.33	my($ip);
275			$ip = inet_ntoa(scalar(gethostbyname(hostname())) \|\| 'localhost') or $ip = 'localhost';
276	tdb	1.36
277			# add some extra data to the array
278	tdb	1.43	push(@data, "packet.attributes.seq_no $seq_no");
279			push(@data, "packet.attributes.machine_name $fqdn");
280			push(@data, "packet.attributes.date $date");
281			push(@data, "packet.attributes.type data");
282			push(@data, "packet.attributes.ip $ip");
283	tdb	1.39
284			# sort the data
285	tdb	1.43	@data = sort(grep(!/^$/, grep(/^packet\./, @data)));
286
287	tdb	1.36	# turn the array into some nice XML
288			my($xml) = &make_xml("", "");
289	tdb	1.43
290	pjm2	1.1	my($sock) = new IO::Socket::INET (
291			PeerPort => $udp_port,
292			PeerAddr => $filter_addr,
293			Proto => 'udp'
294	pjm2	1.21	) or die "Could not send UDP: $!\n";
295	tdb	1.36
296	pjm2	1.1	print $sock $xml or die "Could not send UDP packet: $!\n";
297			close($sock);
298			$seq_no++;
299	tdb	1.38	print "-";
300	pjm2	1.12
301			return;
302	pjm2	1.1	}
303
304	pjm2	1.12
305			#-----------------------------------------------------------------------
306			# send_tcp_heartbeat
307			# Establishes a TCP connection to an i-scream filter.
308			# The heartbeat is used as a guaranteed "I'm alive" delivery mechanism.
309	pjm2	1.34	# If we need to reconfigure, then we complete the heartbeat before
310			# doing so.
311	pjm2	1.12	#-----------------------------------------------------------------------
312	pjm2	1.1	sub send_tcp_heartbeat() {
313
314	pjm2	1.34	my ($doReconfigure) = 0;
315
316	pjm2	1.1	my($sock) = new IO::Socket::INET(
317			PeerAddr => $filter_addr,
318			PeerPort => $tcp_port,
319			Proto => 'tcp'
320	pjm2	1.21	) or return;
321	pjm2	1.11	if (!defined $sock) {
322			print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
323	pjm2	1.27	&tcp_configure();
324	pjm2	1.11	return;
325			}
326	pjm2	1.1
327			# Now run through the configuration process.
328			my($response);
329
330			print $sock "HEARTBEAT\n";
331			$response = <$sock>;
332	pjm2	1.32	if (!$response eq "OK\n") {
333	pjm2	1.1	close($sock);
334			print "Server gave wrong response to HEARTBEAT: $response\n";
335	pjm2	1.27	&tcp_configure();
336	pjm2	1.1	return;
337			}
338
339			print $sock "CONFIG\n";
340			$response = <$sock>;
341	pjm2	1.32	if (!$response eq "OK\n") {
342	pjm2	1.1	close($sock);
343			print "Server gave wrong response to CONFIG: $response\n";
344	pjm2	1.27	&tcp_configure();
345	pjm2	1.1	return;
346			}
347
348			print $sock "$file_list\n";
349			$response = <$sock>;
350	pjm2	1.32	if (!$response eq "OK\n") {
351	pjm2	1.1	close($sock);
352			print "Server gave wrong response to file list: $response\n";
353	pjm2	1.27	&tcp_configure();
354	pjm2	1.1	return;
355			}
356
357			print $sock "$last_modified\n";
358			$response = <$sock>;
359	pjm2	1.32	if ($response eq "ERROR\n") {
360	pjm2	1.1	close($sock);
361	pjm2	1.27	print "Server configuration changed. Reconfiguring with filter manager.\n";
362	pjm2	1.34	$doReconfigure = 1;
363	pjm2	1.1	}
364	pjm2	1.32	if (!$response eq "OK\n") {
365	pjm2	1.1	close($sock);
366			print "Server gave wrong response to HEARTBEAT: $response\n";
367	pjm2	1.27	&tcp_configure();
368	pjm2	1.1	return;
369			}
370
371			print $sock "ENDHEARTBEAT\n";
372	pjm2	1.23	$response = <$sock>;
373	pjm2	1.32	if (!$response eq "OK\n") {
374	pjm2	1.1	close($sock);
375			print "Server gave wrong response to ENDHEARTBEAT: $response\n";
376	pjm2	1.27	&tcp_configure();
377	pjm2	1.1	return;
378			}
379
380			close($sock);
381			print "^";
382	pjm2	1.34
383			&tcp_configure() if $doReconfigure;
384	tdb	1.25
385			return;
386			}
387
388	tdb	1.36
389	tdb	1.25	#-----------------------------------------------------------------------
390			# write_pid
391			# Writes the PID (process ID) of this instance to $pidfile.
392			# This is then used by a seperate script to check (and restart) ihost.
393			#-----------------------------------------------------------------------
394			sub write_pid() {
395			open PID, ">$pidfile";
396			print PID $$;
397			close PID;
398	pjm2	1.12
399			return;
400	tdb	1.36	}
401
402			#-----------------------------------------------------------------------
403			# make_xml
404	tdb	1.37	# Turns an array of plugins data into an XML string.
405	tdb	1.36	#-----------------------------------------------------------------------
406			sub make_xml() {
407			my($curlevel, $curline) = @_;
408			my($xmltemp) = ""; my($curtag) = ""; my($attributes) = "";
409	tdb	1.40	while(1) {
410	tdb	1.43	$curline = shift(@data) if $curline eq "";
411			return $xmltemp if not defined $curline;
412			chomp $curline;
413			# dealing with nest (or attributes)
414	tdb	1.36	if($curline =~ /^$curlevel([^\.\s]+\.)/) {
415			$curtag=$1;
416	tdb	1.43	if($curline =~ /^$curlevel$curtag([^\.\s]+)\s+(.*)$/) {
417			$xmltemp .= &make_xml("$curlevel$curtag", $curline);
418			}
419			elsif($curline =~ /^$curlevel$curtag(attributes)\.([^\.\s]+)\s+(.*)$/) {
420			$attributes .= " $2=\"$3\"";
421			}
422			else {
423			$xmltemp .= &make_xml("$curlevel$curtag", $curline);
424			}
425			my($nextline) = $data[0]; chomp $nextline if defined $nextline;
426			if((defined $nextline) && ($nextline =~ /^$curlevel$curtag/)) {
427			$curline = "";
428			}
429			else {
430			$curtag =~ s/(.*)\./$1/;
431			$xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
432			return $xmltemp;
433			}
434	tdb	1.36	}
435	tdb	1.43	# dealing with value
436			elsif($curline =~ /^$curlevel([^\.\s]+)\s+(.*)$/) {
437			$curtag=$1;
438			$xmltemp=$2;
439			my($nextline) = $data[0]; chomp $nextline if defined $nextline;
440			if(defined $nextline && ($nextline =~ /^$curlevel$curtag\./ \|\| $nextline =~ /^$curlevel$curtag\s+/)) {
441			$curline = "";
442			}
443			else {
444			$xmltemp = "<$curtag$attributes>$xmltemp</$curtag>" unless $curtag eq "";
445			return $xmltemp;
446			}
447	tdb	1.36	}
448			}
449	pjm2	1.1	}