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, 10 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 :)
#	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.42 2001/11/21 10:08:20 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	@data
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	# use home dir by default
51	#$pidfile = $ENV{"HOME"};
52	# 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	&write_pid();
56
57	&tcp_configure();
58	&send_udp_packet();
59
60	$last_udp_time = time;
61	$last_tcp_time = time;
62	while (1) {
63	my($time) = time;
64	if ($time >= $last_udp_time + $udp_update_time) {
65	&send_udp_packet();
66	$last_udp_time = $time;
67	}
68	if ($time >= $last_tcp_time + $tcp_update_time) {
69	&send_tcp_heartbeat();
70	$last_tcp_time = $time;
71	}
72	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	sleep $delay;
82	}
83
84	# we'll probably never get here...
85	`rm -f $pidfile`;
86	exit(0);
87
88
89	#-----------------------------------------------------------------------
90	# 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	sleep $retry_wait;
97	}
98
99
100	#-----------------------------------------------------------------------
101	# 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	sub tcp_configure() {
107
108	while (1) {
109	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	if ($response && !($response eq "OK\n")) {
127	print "The i-scream server rejected the STARTCONFIG command.\n";
128	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	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	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	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	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	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	chop $response;
170	$fqdn = $response;
171
172	print "FQDN returned: $fqdn\n";
173
174	print $sock "UDPUpdateTime\n";
175	$response = <$sock>;
176	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	chop $response;
183	$udp_update_time = $response;
184
185	print $sock "TCPUpdateTime\n";
186	$response = <$sock>;
187	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	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	if ($response && !($response eq "OK\n")) {
201	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	if (!$response) {
212	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	$response =~ /^(.);(.);(.*)/;
219	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	if ($response && ($response eq "OK\n")) {
238	print "Host successfully configured via TCP.\n"
239	}
240	else {
241	print "The server failed the host configuration on the END command.\n";
242	close($sock);
243	wait_then_retry();
244	next;
245	}
246
247	close($sock);
248
249	print "Configuration finished sucessfully!\n";
250	last;
251	}
252	return;
253	}
254
255
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	sub send_udp_packet() {
263
264	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
272	# get some extra data
273	my($date) = time;
274	my($ip);
275	$ip = inet_ntoa(scalar(gethostbyname(hostname())) \|\| 'localhost') or $ip = 'localhost';
276
277	# add some extra data to the array
278	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
284	# sort the data
285	@data = sort(grep(!/^$/, grep(/^packet\./, @data)));
286
287	# turn the array into some nice XML
288	my($xml) = &make_xml("", "");
289
290	my($sock) = new IO::Socket::INET (
291	PeerPort => $udp_port,
292	PeerAddr => $filter_addr,
293	Proto => 'udp'
294	) or die "Could not send UDP: $!\n";
295
296	print $sock $xml or die "Could not send UDP packet: $!\n";
297	close($sock);
298	$seq_no++;
299	print "-";
300
301	return;
302	}
303
304
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	# If we need to reconfigure, then we complete the heartbeat before
310	# doing so.
311	#-----------------------------------------------------------------------
312	sub send_tcp_heartbeat() {
313
314	my ($doReconfigure) = 0;
315
316	my($sock) = new IO::Socket::INET(
317	PeerAddr => $filter_addr,
318	PeerPort => $tcp_port,
319	Proto => 'tcp'
320	) or return;
321	if (!defined $sock) {
322	print "IHOST WARNING: Failed to deliver a heartbeat to the i-scream filter.\n";
323	&tcp_configure();
324	return;
325	}
326
327	# Now run through the configuration process.
328	my($response);
329
330	print $sock "HEARTBEAT\n";
331	$response = <$sock>;
332	if (!$response eq "OK\n") {
333	close($sock);
334	print "Server gave wrong response to HEARTBEAT: $response\n";
335	&tcp_configure();
336	return;
337	}
338
339	print $sock "CONFIG\n";
340	$response = <$sock>;
341	if (!$response eq "OK\n") {
342	close($sock);
343	print "Server gave wrong response to CONFIG: $response\n";
344	&tcp_configure();
345	return;
346	}
347
348	print $sock "$file_list\n";
349	$response = <$sock>;
350	if (!$response eq "OK\n") {
351	close($sock);
352	print "Server gave wrong response to file list: $response\n";
353	&tcp_configure();
354	return;
355	}
356
357	print $sock "$last_modified\n";
358	$response = <$sock>;
359	if ($response eq "ERROR\n") {
360	close($sock);
361	print "Server configuration changed. Reconfiguring with filter manager.\n";
362	$doReconfigure = 1;
363	}
364	if (!$response eq "OK\n") {
365	close($sock);
366	print "Server gave wrong response to HEARTBEAT: $response\n";
367	&tcp_configure();
368	return;
369	}
370
371	print $sock "ENDHEARTBEAT\n";
372	$response = <$sock>;
373	if (!$response eq "OK\n") {
374	close($sock);
375	print "Server gave wrong response to ENDHEARTBEAT: $response\n";
376	&tcp_configure();
377	return;
378	}
379
380	close($sock);
381	print "^";
382
383	&tcp_configure() if $doReconfigure;
384
385	return;
386	}
387
388
389	#-----------------------------------------------------------------------
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
399	return;
400	}
401
402	#-----------------------------------------------------------------------
403	# make_xml
404	# Turns an array of plugins data into an XML string.
405	#-----------------------------------------------------------------------
406	sub make_xml() {
407	my($curlevel, $curline) = @_;
408	my($xmltemp) = ""; my($curtag) = ""; my($attributes) = "";
409	while(1) {
410	$curline = shift(@data) if $curline eq "";
411	return $xmltemp if not defined $curline;
412	chomp $curline;
413	# dealing with nest (or attributes)
414	if($curline =~ /^$curlevel([^\.\s]+\.)/) {
415	$curtag=$1;
416	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	}
435	# 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	}
448	}
449	}