5dd01c3d7c61c537b599f1cb94b884690fabea0d
1 #!/usr/bin/perl
2 #===============================================================================
3 #
4 # FILE: gosa-server
5 #
6 # USAGE: gosa-si-client
7 #
8 # DESCRIPTION:
9 #
10 # OPTIONS: ---
11 # REQUIREMENTS: libnetaddr-ip-perl
12 # BUGS: ---
13 # NOTES:
14 # AUTHOR: (Andreas Rettenberger), <rettenberger@gonicus.de>
15 # COMPANY:
16 # VERSION: 1.0
17 # CREATED: 12.09.2007 08:54:41 CEST
18 # REVISION: ---
19 #===============================================================================
21 use strict;
22 use warnings;
23 use Getopt::Long;
24 use Config::IniFiles;
25 use POSIX;
26 use Time::HiRes qw( gettimeofday );
28 use POE qw(Component::Server::TCP Wheel::FollowTail);
29 use IO::Socket::INET;
30 use NetAddr::IP;
31 use Data::Dumper;
32 use Crypt::Rijndael;
33 use GOSA::GosaSupportDaemon;
34 use Digest::MD5 qw(md5_hex md5 md5_base64);
35 use MIME::Base64;
36 use XML::Simple;
37 use Net::DNS;
38 use File::Basename;
40 my $event_dir = "/usr/lib/gosa-si/client/events";
41 use lib "/usr/lib/gosa-si/client/events";
43 my ($cfg_file, %cfg_defaults, $foreground, $verbose, $pid_file, $opts_file, $procid, $pid, $log_file, $fai_logpath);
44 my ($server_ip, $server_port, $server_key, $server_timeout, $server_domain, $server_key_lifetime);
45 my ($client_ip, $client_port, $client_mac_address, $ldap_enabled, $ldap_config, $pam_config, $nss_config);
46 my $xml;
47 my $default_server_key;
48 my $event_hash;
49 my @servers;
50 my $gotoHardwareChecksum;
51 my $gosa_si_client_fifo;
52 my %files_to_watch;
53 $verbose= 1;
55 # globalise variables which are used in imported events
56 our $cfg_file;
57 our $server_address;
58 our $client_address;
59 our $server_key;
61 # default variables
62 our $REGISTERED = 0;
64 # path to fifo for non-gosa-si-client messages to gosa-si-server
65 $gosa_si_client_fifo = "/var/run/gosa-si-client.socket";
66 %files_to_watch = (fifo => $gosa_si_client_fifo);
68 # in function register_at_gosa_si_server, after which period of seconds a new registration should be tried if a registration was
69 # not successful until now
70 my $delay_set_time = 5;
71 our $prg= basename($0);
73 %cfg_defaults = (
74 "general" =>
75 {"log-file" => [\$log_file, "/var/run/".$prg.".log"],
76 "pid-file" => [\$pid_file, "/var/run/".$prg.".pid"],
77 "opts-file" => [\$opts_file, "/var/run/".$prg.".opts"],
78 },
79 "client" =>
80 {"port" => [\$client_port, "20083"],
81 "ip" => [\$client_ip, "0.0.0.0"],
82 "mac-address" => [\$client_mac_address, "00:00:00:00:00:00"],
83 "server-domain" => [\$server_domain, ""],
84 "ldap" => [\$ldap_enabled, 1],
85 "ldap-config" => [\$ldap_config, "/etc/ldap/ldap.conf"],
86 "pam-config" => [\$pam_config, "/etc/pam_ldap.conf"],
87 "nss-config" => [\$nss_config, "/etc/libnss_ldap.conf"],
88 "fai-logpath" => [\$fai_logpath, "/var/log/fai/fai.log"],
89 },
90 "server" => {
91 "ip" => [\$server_ip, "127.0.0.1"],
92 "port" => [\$server_port, "20081"],
93 "key" => [\$server_key, ""],
94 "timeout" => [\$server_timeout, 10],
95 "key-lifetime" => [\$server_key_lifetime, 600],
96 },
98 );
101 #=== FUNCTIONS = functions =====================================================
103 #=== FUNCTION ================================================================
104 # NAME: check_cmdline_param
105 # PARAMETERS:
106 # RETURNS:
107 # DESCRIPTION:
108 #===============================================================================
109 sub check_cmdline_param () {
110 my $err_config;
111 my $err_counter = 0;
112 if(not defined($cfg_file)) {
113 $cfg_file = "/etc/gosa-si/client.conf";
114 if(! -r $cfg_file) {
115 $err_config = "please specify a config file";
116 $err_counter += 1;
117 }
118 }
119 if( $err_counter > 0 ) {
120 &usage( "", 1 );
121 if( defined( $err_config)) { print STDERR "$err_config\n"}
122 print STDERR "\n";
123 exit( -1 );
124 }
125 }
128 #=== FUNCTION ================================================================
129 # NAME: read_configfile
130 # PARAMETERS: cfg_file - string -
131 # RETURNS:
132 # DESCRIPTION:
133 #===============================================================================
134 sub read_configfile {
135 my ($cfg_file, %cfg_defaults) = @_ ;
136 my $cfg;
137 if( defined( $cfg_file) && ( length($cfg_file) > 0 )) {
138 if( -r $cfg_file ) {
139 $cfg = Config::IniFiles->new( -file => $cfg_file );
140 } else {
141 print STDERR "Couldn't read config file!";
142 }
143 } else {
144 $cfg = Config::IniFiles->new() ;
145 }
146 foreach my $section (keys %cfg_defaults) {
147 foreach my $param (keys %{$cfg_defaults{ $section }}) {
148 my $pinfo = $cfg_defaults{ $section }{ $param };
149 ${@$pinfo[ 0 ]} = $cfg->val( $section, $param, @$pinfo[ 1 ] );
150 }
151 }
152 }
155 #=== FUNCTION ================================================================
156 # NAME: check_pid
157 # PARAMETERS:
158 # RETURNS:
159 # DESCRIPTION:
160 #===============================================================================
161 sub check_pid {
162 $pid = -1;
163 # Check, if we are already running
164 if( open(LOCK_FILE, "<$pid_file") ) {
165 $pid = <LOCK_FILE>;
166 if( defined $pid ) {
167 chomp( $pid );
168 if( -f "/proc/$pid/stat" ) {
169 my($stat) = `cat /proc/$pid/stat` =~ m/$pid \((.+)\).*/;
170 if( $0 eq $stat ) {
171 close( LOCK_FILE );
172 exit -1;
173 }
174 }
175 }
176 close( LOCK_FILE );
177 unlink( $pid_file );
178 }
180 # create a syslog msg if it is not to possible to open PID file
181 if (not sysopen(LOCK_FILE, $pid_file, O_WRONLY|O_CREAT|O_EXCL, 0644)) {
182 my($msg) = "Couldn't obtain lockfile '$pid_file' ";
183 if (open(LOCK_FILE, '<', $pid_file)
184 && ($pid = <LOCK_FILE>))
185 {
186 chomp($pid);
187 $msg .= "(PID $pid)\n";
188 } else {
189 $msg .= "(unable to read PID)\n";
190 }
191 if( ! ($foreground) ) {
192 openlog( $0, "cons,pid", "daemon" );
193 syslog( "warning", $msg );
194 closelog();
195 }
196 else {
197 print( STDERR " $msg " );
198 }
199 exit( -1 );
200 }
201 }
204 sub sig_int_handler {
205 my ($signal) = @_;
207 daemon_log("shutting down gosa-si-server", 1);
208 exit(1);
209 }
210 $SIG{INT} = \&sig_int_handler;
213 #=== FUNCTION ================================================================
214 # NAME: logging
215 # PARAMETERS: level - string - default 'info'
216 # msg - string -
217 # facility - string - default 'LOG_DAEMON'
218 # RETURNS:
219 # DESCRIPTION:
220 #===============================================================================
221 sub daemon_log {
222 # log into log_file
223 my( $msg, $level ) = @_;
224 if(not defined $msg) { return }
225 if(not defined $level) { $level = 1 }
226 if(defined $log_file){
227 open(LOG_HANDLE, ">>$log_file");
228 if(not defined open( LOG_HANDLE, ">>$log_file" )) {
229 print STDERR "cannot open $log_file: $!";
230 return }
231 chomp($msg);
232 if($level <= $verbose){
233 my ($seconds, $minutes, $hours, $monthday, $month,
234 $year, $weekday, $yearday, $sommertime) = localtime(time);
235 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
236 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
237 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
238 my @monthnames = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
239 $month = $monthnames[$month];
240 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
241 $year+=1900;
243 my $log_msg = "$month $monthday $hours:$minutes:$seconds $prg $msg\n";
244 print LOG_HANDLE $log_msg;
245 if( $foreground ) {
246 print STDERR $log_msg;
247 }
248 }
249 close( LOG_HANDLE );
250 }
251 #log into syslog
252 # my ($msg, $level, $facility) = @_;
253 # if(not defined $msg) {return}
254 # if(not defined $level) {$level = "info"}
255 # if(not defined $facility) {$facility = "LOG_DAEMON"}
256 # openlog($0, "pid,cons,", $facility);
257 # syslog($level, $msg);
258 # closelog;
259 # return;
260 }
263 #=== FUNCTION ================================================================
264 # NAME: get_interfaces
265 # PARAMETERS: none
266 # RETURNS: (list of interfaces)
267 # DESCRIPTION: Uses proc fs (/proc/net/dev) to get list of interfaces.
268 #===============================================================================
269 sub get_interfaces {
270 my @result;
271 my $PROC_NET_DEV= ('/proc/net/dev');
273 open(PROC_NET_DEV, "<$PROC_NET_DEV")
274 or die "Could not open $PROC_NET_DEV";
276 my @ifs = <PROC_NET_DEV>;
278 close(PROC_NET_DEV);
280 # Eat first two line
281 shift @ifs;
282 shift @ifs;
284 chomp @ifs;
285 foreach my $line(@ifs) {
286 my $if= (split /:/, $line)[0];
287 $if =~ s/^\s+//;
288 push @result, $if;
289 }
291 return @result;
292 }
294 #=== FUNCTION ================================================================
295 # NAME: get_mac
296 # PARAMETERS: interface name (i.e. eth0)
297 # RETURNS: (mac address)
298 # DESCRIPTION: Uses ioctl to get mac address directly from system.
299 #===============================================================================
300 sub get_mac {
301 my $ifreq= shift;
302 my $result;
303 if ($ifreq && length($ifreq) > 0) {
304 if($ifreq eq "all") {
305 if(defined($server_ip)) {
306 $result = &get_local_mac_for_remote_ip($server_ip);
307 }
308 elsif ($client_mac_address && length($client_mac_address) > 0 && !($client_mac_address eq "00:00:00:00:00:00")){
309 $result = &client_mac_address;
310 }
311 else {
312 $result = "00:00:00:00:00:00";
313 }
314 } else {
315 my $SIOCGIFHWADDR= 0x8927; # man 2 ioctl_list
317 # A configured MAC Address should always override a guessed value
318 if ($client_mac_address and length($client_mac_address) > 0 and not($client_mac_address eq "00:00:00:00:00:00")) {
319 $result= $client_mac_address;
320 }
321 else {
322 socket SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('ip')
323 or die "socket: $!";
325 if(ioctl SOCKET, $SIOCGIFHWADDR, $ifreq) {
326 my ($if, $mac)= unpack 'h36 H12', $ifreq;
328 if (length($mac) > 0) {
329 $mac=~ m/^([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])$/;
330 $mac= sprintf("%s:%s:%s:%s:%s:%s", $1, $2, $3, $4, $5, $6);
331 $result = $mac;
332 }
333 }
334 }
335 }
336 }
337 return $result;
338 }
341 #=== FUNCTION ================================================================
342 # NAME: get_interface_for_ip
343 # PARAMETERS: ip address (i.e. 192.168.0.1)
344 # RETURNS: array: list of interfaces if ip=0.0.0.0, matching interface if found, undef else
345 # DESCRIPTION: Uses proc fs (/proc/net/dev) to get list of interfaces.
346 #===============================================================================
347 sub get_interface_for_ip {
348 my $result;
349 my $ip= shift;
350 if ($ip && length($ip) > 0) {
351 my @ifs= &get_interfaces();
352 if($ip eq "0.0.0.0") {
353 $result = "all";
354 } else {
355 foreach (@ifs) {
356 my $if=$_;
357 if(get_ip($if) eq $ip) {
358 $result = $if;
359 last;
360 }
361 }
362 }
363 }
364 return $result;
365 }
368 #=== FUNCTION ================================================================
369 # NAME: get_ip
370 # PARAMETERS: interface name (i.e. eth0)
371 # RETURNS: (ip address)
372 # DESCRIPTION: Uses ioctl to get ip address directly from system.
373 #===============================================================================
374 sub get_ip {
375 my $ifreq= shift;
376 my $result= "";
377 my $SIOCGIFADDR= 0x8915; # man 2 ioctl_list
378 my $proto= getprotobyname('ip');
380 socket SOCKET, PF_INET, SOCK_DGRAM, $proto
381 or die "socket: $!";
383 if(ioctl SOCKET, $SIOCGIFADDR, $ifreq) {
384 my ($if, $sin) = unpack 'a16 a16', $ifreq;
385 my ($port, $addr) = sockaddr_in $sin;
386 my $ip = inet_ntoa $addr;
388 if ($ip && length($ip) > 0) {
389 $result = $ip;
390 }
391 }
393 return $result;
394 }
397 #=== FUNCTION ================================================================
398 # NAME: get_local_mac_for_remote_ip
399 # PARAMETERS: none (takes server_ip from global variable)
400 # RETURNS: (ip address from interface that is used for communication)
401 # DESCRIPTION: Uses ioctl to get routing table from system, checks which entry
402 # matches (defaultroute last).
403 #===============================================================================
404 sub get_local_mac_for_remote_ip {
405 my $server_ip= shift;
406 my $result= "00:00:00:00:00:00";
408 if($server_ip =~ /^(\d\d?\d?\.){3}\d\d?\d?$/) {
409 my $PROC_NET_ROUTE= ('/proc/net/route');
411 open(PROC_NET_ROUTE, "<$PROC_NET_ROUTE")
412 or die "Could not open $PROC_NET_ROUTE";
414 my @ifs = <PROC_NET_ROUTE>;
416 close(PROC_NET_ROUTE);
418 # Eat header line
419 shift @ifs;
420 chomp @ifs;
421 foreach my $line(@ifs) {
422 my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
423 my $destination;
424 my $mask;
425 my ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Destination);
426 $destination= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
427 ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Mask);
428 $mask= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
429 if(new NetAddr::IP($server_ip)->within(new NetAddr::IP($destination, $mask))) {
430 # destination matches route, save mac and exit
431 $result= &get_mac($Iface);
432 last;
433 }
434 }
435 } else {
436 daemon_log("get_local_mac_for_remote_ip was called with a non-ip parameter: $server_ip", 1);
437 }
438 return $result;
439 }
441 sub get_local_ip_for_remote_ip {
442 my $server_ip= shift;
443 my $result="0.0.0.0";
445 if($server_ip =~ /^(\d\d?\d?\.){3}\d\d?\d?$/) {
446 if($server_ip eq "127.0.0.1") {
447 $result="127.0.0.1";
448 } else {
449 my $PROC_NET_ROUTE= ('/proc/net/route');
451 open(PROC_NET_ROUTE, "<$PROC_NET_ROUTE")
452 or die "Could not open $PROC_NET_ROUTE";
454 my @ifs = <PROC_NET_ROUTE>;
456 close(PROC_NET_ROUTE);
458 # Eat header line
459 shift @ifs;
460 chomp @ifs;
461 foreach my $line(@ifs) {
462 my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
463 my $destination;
464 my $mask;
465 my ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Destination);
466 $destination= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
467 ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Mask);
468 $mask= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
469 if(new NetAddr::IP($server_ip)->within(new NetAddr::IP($destination, $mask))) {
470 # destination matches route, save mac and exit
471 $result= &get_ip($Iface);
472 last;
473 }
474 }
475 }
476 } else {
477 daemon_log("get_local_ip_for_remote_ip was called with a non-ip parameter: $server_ip", 1);
478 }
479 return $result;
480 }
482 sub new_ldap_config {
483 my ($msg_hash) = @_ ;
484 my $element;
485 my @ldap_uris;
486 my $ldap_base;
487 my @ldap_options;
488 my @pam_options;
489 my @nss_options;
490 my $goto_admin;
491 my $goto_secret;
492 my $admin_base= "";
493 my $department= "";
494 my $release= "";
495 my $unit_tag;
497 # Transform input into array
498 while ( my ($key, $value) = each(%$msg_hash) ) {
499 if ($key =~ /^(source|target|header)$/) {
500 next;
501 }
503 foreach $element (@$value) {
504 if ($key =~ /^ldap_uri$/) {
505 push (@ldap_uris, $element);
506 next;
507 }
508 if ($key =~ /^ldap_base$/) {
509 $ldap_base= $element;
510 next;
511 }
512 if ($key =~ /^goto_admin$/) {
513 $goto_admin= $element;
514 next;
515 }
516 if ($key =~ /^goto_secret$/) {
517 $goto_secret= $element;
518 next;
519 }
520 if ($key =~ /^ldap_cfg$/) {
521 push (@ldap_options, "$element");
522 next;
523 }
524 if ($key =~ /^pam_cfg$/) {
525 push (@pam_options, "$element");
526 next;
527 }
528 if ($key =~ /^nss_cfg$/) {
529 push (@nss_options, "$element");
530 next;
531 }
532 if ($key =~ /^admin_base$/) {
533 $admin_base= $element;
534 next;
535 }
536 if ($key =~ /^department$/) {
537 $department= $element;
538 next;
539 }
540 if ($key =~ /^unit_tag$/) {
541 $unit_tag= $element;
542 next;
543 }
544 if ($key =~ /^release$/) {
545 $release= $element;
546 next;
547 }
548 }
549 }
551 # Unit tagging enabled?
552 if (defined $unit_tag){
553 push (@pam_options, "pam_filter gosaUnitTag=$unit_tag");
554 push (@nss_options, "nss_base_passwd $admin_base?sub?gosaUnitTag=$unit_tag");
555 push (@nss_options, "nss_base_group $admin_base?sub?gosaUnitTag=$unit_tag");
556 }
558 # Setup ldap.conf
559 my $file1;
560 my $file2;
561 open(file1, "> $ldap_config");
562 print file1 "# This file was automatically generated by gosa-si-client. Do not change.\n";
563 print file1 "URI";
564 foreach $element (@ldap_uris) {
565 print file1 " $element";
566 }
567 print file1 "\nBASE $ldap_base\n";
568 foreach $element (@ldap_options) {
569 print file1 "$element\n";
570 }
571 close (file1);
572 daemon_log("wrote $ldap_config", 5);
574 # Setup pam_ldap.conf / libnss_ldap.conf
575 open(file1, "> $pam_config");
576 open(file2, "> $nss_config");
577 print file1 "# This file was automatically generated by gosa-si-client. Do not change.\n";
578 print file2 "# This file was automatically generated by gosa-si-client. Do not change.\n";
579 print file1 "uri";
580 print file2 "uri";
581 foreach $element (@ldap_uris) {
582 print file1 " $element";
583 print file2 " $element";
584 }
585 print file1 "\nbase $ldap_base\n";
586 print file2 "\nbase $ldap_base\n";
587 foreach $element (@pam_options) {
588 print file1 "$element\n";
589 }
590 foreach $element (@nss_options) {
591 print file2 "$element\n";
592 }
593 close (file2);
594 daemon_log("wrote $nss_config", 5);
595 close (file1);
596 daemon_log("wrote $pam_config", 5);
598 # Create goto.secrets if told so - for compatibility reasons
599 if (defined $goto_admin){
600 open(file1, "> /etc/goto/secret");
601 close(file1);
602 chown(0,0, "/etc/goto/secret");
603 chmod(0600, "/etc/goto/secret");
604 open(file1, "> /etc/goto/secret");
605 print file1 "GOTOADMIN=\"$goto_admin\"\nGOTOSECRET=\"$goto_secret\"\n";
606 close(file1);
607 daemon_log("wrote /etc/goto/secret", 5);
608 }
610 # Write shell based config
611 my $cfg_name= dirname($ldap_config)."/ldap-shell.conf";
613 # Get first LDAP server
614 my $ldap_server= $ldap_uris[0];
615 $ldap_server=~ s/^ldap:\/\/([^:]+).*$/$1/;
617 open(file1, "> $cfg_name");
618 print file1 "LDAP_BASE=\"$ldap_base\"\n";
619 print file1 "LDAP_SERVER=\"$ldap_server\"\n";
620 print file1 "ADMIN_BASE=\"$admin_base\"\n";
621 print file1 "DEPARTMENT=\"$department\"\n";
622 print file1 "RELEASE=\"$release\"\n";
623 print file1 "UNIT_TAG=\"".(defined $unit_tag ? "$unit_tag" : "")."\"\n";
624 print file1 "UNIT_TAG_FILTER=\"".(defined $unit_tag ? "(gosaUnitTag=$unit_tag)" : "")."\"\n";
625 close(file1);
626 daemon_log("wrote $cfg_name", 5);
628 return;
630 }
633 sub generate_hw_digest {
634 my $hw_data;
635 foreach my $line (split /\n/, `cat /proc/bus/pci/devices`) {
636 $hw_data.= sprintf "%s", $line =~ /[^\s]+\s([^\s]+)\s.*/;
637 }
638 return(md5_base64($hw_data));
639 }
642 sub create_passwd {
643 my $new_passwd = "";
644 for(my $i=0; $i<31; $i++) {
645 $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
646 }
648 return $new_passwd;
649 }
652 sub create_ciphering {
653 my ($passwd) = @_;
654 if((!defined($passwd)) || length($passwd)==0) {
655 $passwd = "";
656 }
657 $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
658 my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
659 my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
660 $my_cipher->set_iv($iv);
661 return $my_cipher;
662 }
665 sub encrypt_msg {
666 my ($msg, $key) = @_;
667 my $my_cipher = &create_ciphering($key);
668 {
669 use bytes;
670 $msg = "\0"x(16-length($msg)%16).$msg;
671 }
672 $msg = $my_cipher->encrypt($msg);
673 chomp($msg = &encode_base64($msg));
674 # there are no newlines allowed inside msg
675 $msg=~ s/\n//g;
676 return $msg;
677 }
680 sub decrypt_msg {
682 my ($msg, $key) = @_ ;
683 $msg = &decode_base64($msg);
684 my $my_cipher = &create_ciphering($key);
685 $msg = $my_cipher->decrypt($msg);
686 $msg =~ s/\0*//g;
687 return $msg;
688 }
691 sub get_server_addresses {
692 my $domain= shift;
693 my @result;
695 my $error = 0;
696 my $res = Net::DNS::Resolver->new;
697 my $query = $res->send("_gosa-si._tcp.".$domain, "SRV");
698 my @hits;
700 if ($query) {
701 foreach my $rr ($query->answer) {
702 push(@hits, $rr->target.":".$rr->port);
703 }
704 }
705 else {
706 #warn "query failed: ", $res->errorstring, "\n";
707 $error++;
708 }
710 if( $error == 0 ) {
711 foreach my $hit (@hits) {
712 my ($hit_name, $hit_port) = split(/:/, $hit);
714 my $address_query = $res->send($hit_name);
715 if( 1 == length($address_query->answer) ) {
716 foreach my $rr ($address_query->answer) {
717 push(@result, $rr->address.":".$hit_port);
718 }
719 }
720 }
721 }
723 # my $dig_cmd= 'dig +nocomments srv _gosa-si._tcp.'.$domain;
724 #
725 # my $output= `$dig_cmd 2>&1`;
726 # open (PIPE, "$dig_cmd 2>&1 |");
727 # while(<PIPE>) {
728 # chomp $_;
729 # # If it's not a comment
730 # if($_ =~ m/^[^;]/) {
731 # my @matches= split /\s+/;
732 #
733 # # Push hostname with port
734 # if($matches[3] eq 'SRV') {
735 # push @result, $matches[7].':'.$matches[6];
736 # } elsif ($matches[3] eq 'A') {
737 # my $i=0;
738 #
739 # # Substitute the hostname with the ip address of the matching A record
740 # foreach my $host (@result) {
741 # if ((split /\:/, $host)[0] eq $matches[0]) {
742 # $result[$i]= $matches[4].':'.(split /\:/, $host)[1];
743 # }
744 # $i++;
745 # }
746 # }
747 # }
748 # }
749 # close(PIPE);
750 return @result;
751 }
754 ##=== FUNCTION ================================================================
755 ## NAME: create_ciphering
756 ## PARAMETERS: passwd - string - used to create ciphering
757 ## RETURNS: cipher - object
758 ## DESCRIPTION: creates a Crypt::Rijndael::MODE_CBC object with passwd as key
759 ##===============================================================================
760 #sub create_ciphering {
761 # my ($passwd) = @_;
762 # $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
763 # my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
764 #
765 # #daemon_log("iv: $iv", 7);
766 # #daemon_log("key: $passwd", 7);
767 # my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
768 # $my_cipher->set_iv($iv);
769 # return $my_cipher;
770 #}
771 #
772 #
773 #sub create_ciphering {
774 # my ($passwd) = @_;
775 # $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
776 # my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
777 # my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
778 # $my_cipher->set_iv($iv);
779 # return $my_cipher;
780 #}
781 #
782 #
783 #sub encrypt_msg {
784 # my ($msg, $key) = @_;
785 # my $my_cipher = &create_ciphering($key);
786 # {
787 # use bytes;
788 # $msg = "\0"x(16-length($msg)%16).$msg;
789 # }
790 # $msg = $my_cipher->encrypt($msg);
791 # chomp($msg = &encode_base64($msg));
792 # # there are no newlines allowed inside msg
793 # $msg=~ s/\n//g;
794 # return $msg;
795 #}
796 #
797 #
798 #sub decrypt_msg {
799 # my ($msg, $key) = @_ ;
800 # $msg = &decode_base64($msg);
801 # my $my_cipher = &create_ciphering($key);
802 # $msg = $my_cipher->decrypt($msg);
803 # $msg =~ s/\0*//g;
804 # return $msg;
805 #}
808 #=== FUNCTION ================================================================
809 # NAME: send_msg_hash_to_target
810 # PARAMETERS: msg_hash - hash - xml_hash created with function create_xml_hash
811 # PeerAddr string - socket address to send msg
812 # PeerPort string - socket port, if not included in socket address
813 # RETURNS: nothing
814 # DESCRIPTION: ????
815 #===============================================================================
816 sub send_msg_hash_to_target {
817 my ($msg_hash, $address, $encrypt_key) = @_ ;
818 my $msg = &create_xml_string($msg_hash);
819 my $header = @{$msg_hash->{'header'}}[0];
820 my $error = &send_msg_to_target($msg, $address, $encrypt_key, $header);
822 return $error;
823 }
826 sub send_msg_to_target {
827 my ($msg, $address, $encrypt_key, $msg_header) = @_ ;
828 my $error = 0;
830 if( $msg_header ) {
831 $msg_header = "'$msg_header'-";
832 }
833 else {
834 $msg_header = "";
835 }
837 # encrypt xml msg
838 my $crypted_msg = &encrypt_msg($msg, $encrypt_key);
840 # opensocket
841 my $socket = &open_socket($address);
842 if( !$socket ) {
843 daemon_log("cannot send ".$msg_header."msg to $address , host not reachable", 1);
844 $error++;
845 }
847 if( $error == 0 ) {
848 # send xml msg
849 print $socket $crypted_msg."\n";
851 daemon_log("send ".$msg_header."msg to $address", 1);
852 daemon_log("message:\n$msg", 8);
854 }
856 # close socket in any case
857 if( $socket ) {
858 close $socket;
859 }
861 return $error;
862 }
865 sub write_to_file {
866 my ($string, $file) = @_;
867 my $error = 0;
869 if( not defined $file || not -f $file ) {
870 &main::daemon_log("ERROR: $prg: check '-f file' failed: $file", 1);
871 $error++;
872 }
873 if( not defined $string || 0 == length($string)) {
874 &main::daemon_log("ERROR: $prg: empty string to write to file '$file'", 1);
875 $error++;
876 }
878 if( $error == 0 ) {
880 chomp($string);
882 open(FILE, ">> $file");
883 print FILE $string."\n";
884 close(FILE);
885 }
887 return;
888 }
891 sub open_socket {
892 my ($PeerAddr, $PeerPort) = @_ ;
893 if(defined($PeerPort)){
894 $PeerAddr = $PeerAddr.":".$PeerPort;
895 }
896 my $socket;
897 $socket = new IO::Socket::INET(PeerAddr => $PeerAddr,
898 Porto => "tcp",
899 Type => SOCK_STREAM,
900 Timeout => 5,
901 );
902 if(not defined $socket) {
903 return;
904 }
905 &daemon_log("open_socket: $PeerAddr", 7);
906 return $socket;
907 }
910 #=== FUNCTION ================================================================
911 # NAME: register_at_server
912 # PARAMETERS:
913 # RETURNS:
914 # DESCRIPTION:
915 #===============================================================================
916 sub register_at_gosa_si_server {
917 my ($kernel) = $_[KERNEL];
918 my $try_to_register = 0;
920 if( not $REGISTERED ) {
921 # create new passwd and ciphering object for client-server communication
922 $server_key = &create_passwd();
924 my $events = join( ", ", keys %{$event_hash} );
925 while(1) {
927 if( $try_to_register >= @servers ) {
928 last;
929 }
931 # fetch first gosa-si-server from @servers
932 my $server = shift(@servers);
934 # append shifted gosa-si-server at the end of @servers, so looking for servers never stop if
935 # a registration never occured
936 push( @servers, $server );
938 # Check if our ip is resolvable - if not: don't try to register
939 my $ip= &get_local_ip_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
940 my $resolver= Net::DNS::Resolver->new;
941 my $dnsresult= $resolver->search($ip);
942 my $dnsname="";
943 if(!defined($dnsresult)) {
944 &write_to_file("goto-error-dns:$ip", $fai_logpath);
945 exit(1);
946 } else {
947 $dnsname=$dnsresult->{answer}[0]->{ptrdname};
948 }
950 # create registration msg
951 my $local_ip = &get_local_ip_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
952 my $local_mac = &get_local_mac_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
953 my $register_hash = &create_xml_hash("here_i_am", $local_ip.":".$client_port, $server);
954 &add_content2xml_hash($register_hash, "new_passwd", $server_key);
955 &add_content2xml_hash($register_hash, "mac_address", $local_mac);
956 &add_content2xml_hash($register_hash, "events", $events);
957 &add_content2xml_hash($register_hash, "gotoHardwareChecksum", $gotoHardwareChecksum);
959 # send xml hash to server with general server passwd
960 my $res = &send_msg_hash_to_target($register_hash, $server, $default_server_key);
961 if($res == 0) {
962 # reset try_to_register
963 $try_to_register = 0;
965 # Set fixed client address
966 $client_ip= &get_local_ip_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
967 $client_address= "$client_ip:$client_port";
969 # Write the MAC address to file
970 if(stat($opts_file)) {
971 unlink($opts_file);
972 }
973 my $opts_file_FH;
974 my $hostname= $dnsname;
975 $hostname =~ s/\..*$//;
976 open($opts_file_FH, ">$opts_file");
977 print $opts_file_FH "MAC=\"$local_mac\"\n";
978 print $opts_file_FH "IPADDRESS=\"$client_ip\"\n";
979 print $opts_file_FH "HOSTNAME=\"$hostname\"\n";
980 print $opts_file_FH "FQDN=\"$dnsname\"\n";
981 close($opts_file_FH);
982 last;
983 } else {
984 $try_to_register++;
985 # wait 1 sec until trying to register again
986 sleep(1);
987 next;
988 }
989 }
991 if( $try_to_register >= @servers ) {
992 &write_to_file("gosa-si-no-server-available", $fai_logpath);
993 $kernel->delay_set('register_at_gosa_si_server', $delay_set_time);
994 }
995 else {
996 daemon_log("waiting for msg 'register_at_gosa_si_server'",1);
997 $kernel->delay_set('register_at_gosa_si_server', $delay_set_time);
998 # clear old settings and set it again
999 $kernel->delay_set('trigger_new_key', $server_key_lifetime);
1000 }
1001 }
1002 return;
1003 }
1006 sub check_key_and_xml_validity {
1007 my ($crypted_msg, $module_key) = @_;
1008 #print STDERR "crypted_msg:$crypted_msg\n";
1009 #print STDERR "modul_key:$module_key\n";
1011 my $msg;
1012 my $msg_hash;
1013 eval{
1014 $msg = &decrypt_msg($crypted_msg, $module_key);
1015 &main::daemon_log("decrypted_msg: \n$msg", 8);
1017 $msg_hash = $xml->XMLin($msg, ForceArray=>1);
1019 ##############
1020 # check header
1021 my $header_l = $msg_hash->{'header'};
1022 if( 1 != @{$header_l} ) {
1023 die 'no or more headers specified';
1024 }
1025 my $header = @{$header_l}[0];
1026 if( 0 == length $header) {
1027 die 'header has length 0';
1028 }
1030 ##############
1031 # check source
1032 my $source_l = $msg_hash->{'source'};
1033 if( 1 != @{$source_l} ) {
1034 die 'no or more than 1 sources specified';
1035 }
1036 my $source = @{$source_l}[0];
1037 if( 0 == length $source) {
1038 die 'source has length 0';
1039 }
1040 unless( $source =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ) {
1041 die "source '$source' is neither a complete ip-address with port nor 'GOSA'";
1042 }
1044 ##############
1045 # check target
1046 my $target_l = $msg_hash->{'target'};
1047 if( 1 != @{$target_l} ) {
1048 die 'no or more than 1 targets specified ';
1049 }
1050 my $target = @{$target_l}[0];
1051 if( 0 == length $target) {
1052 die 'target has length 0 ';
1053 }
1054 unless( $target =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ){
1055 die "source is neither a complete ip-address with port nor 'GOSA'";
1056 }
1057 };
1058 if($@) {
1059 &main::daemon_log("WARNING: do not understand the message or msg is not gosa-si envelope conform:", 5);
1060 &main::daemon_log("$@", 8);
1061 $msg = undef;
1062 $msg_hash = undef;
1063 }
1065 return ($msg, $msg_hash);
1066 }
1069 sub check_outgoing_xml_validity {
1070 my ($msg) = @_;
1072 my $msg_hash;
1073 eval{
1074 $msg_hash = $xml->XMLin($msg, ForceArray=>1);
1076 ##############
1077 # check header
1078 my $header_l = $msg_hash->{'header'};
1079 if( 1 != @{$header_l} ) {
1080 die 'no or more than one headers specified';
1081 }
1082 my $header = @{$header_l}[0];
1083 if( 0 == length $header) {
1084 die 'header has length 0';
1085 }
1087 ##############
1088 # check source
1089 my $source_l = $msg_hash->{'source'};
1090 if( 1 != @{$source_l} ) {
1091 die 'no or more than 1 sources specified';
1092 }
1093 my $source = @{$source_l}[0];
1094 if( 0 == length $source) {
1095 die 'source has length 0';
1096 }
1097 unless( $source =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ||
1098 $source =~ /^GOSA$/i ) {
1099 die "source '$source' is neither a complete ip-address with port";
1100 }
1102 ##############
1103 # check target
1104 my $target_l = $msg_hash->{'target'};
1105 if( 1 != @{$target_l} ) {
1106 die "no or more than one targets specified";
1107 }
1108 foreach my $target (@$target_l) {
1109 if( 0 == length $target) {
1110 die "target has length 0";
1111 }
1112 unless( $target =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ) {
1113 die "target '$target' is not a complete ip-address with port or a valid target name";
1114 }
1115 }
1116 };
1117 if($@) {
1118 daemon_log("WARNING: outgoing msg is not gosa-si envelope conform", 5);
1119 daemon_log("$@ $msg", 8);
1120 $msg_hash = undef;
1121 }
1122 return ($msg_hash);
1123 }
1126 sub import_events {
1128 if (not -e $event_dir) {
1129 daemon_log("ERROR: cannot find directory or directory is not readable: $event_dir", 1);
1130 }
1131 opendir (DIR, $event_dir) or die "ERROR while loading gosa-si-events from directory $event_dir : $!\n";
1133 while (defined (my $event = readdir (DIR))) {
1134 if( $event eq "." || $event eq ".." ) { next; }
1136 eval{ require $event; };
1137 if( $@ ) {
1138 daemon_log("ERROR: import of event module '$event' failed", 1);
1139 daemon_log("$@", 8);
1140 next;
1141 }
1143 $event =~ /(\S*?).pm$/;
1144 my $event_module = $1;
1145 my $events_l = eval( $1."::get_events()") ;
1146 foreach my $event_name (@{$events_l}) {
1147 $event_hash->{$event_name} = $event_module;
1148 }
1150 }
1152 my @all_events = keys %$event_hash;
1153 my $all_events_string = join(", ", @all_events);
1155 daemon_log("INFO: imported events: $all_events_string", 5);
1156 }
1158 sub trigger_new_key {
1159 my ($kernel) = $_[KERNEL] ;
1161 my $msg = "<xml><header>new_key</header><source>$client_address</source><target>$client_address</target></xml>";
1162 &send_msg_to_target($msg, $client_address, $server_key, 'new_key');
1164 $kernel->delay_set('trigger_new_key', $server_key_lifetime);
1166 }
1169 sub generic_file_reset {
1170 my ( $heap, $wheel_id ) = @_[ HEAP, ARG0 ];
1172 my $service = $heap->{services}->{$wheel_id};
1173 daemon_log("INFO: '$service' watching reset", 5);
1174 return;
1175 }
1177 sub generic_file_error {
1178 my ( $heap, $operation, $errno, $error_string, $wheel_id ) =
1179 @_[ HEAP, ARG0, ARG1, ARG2, ARG3 ];
1181 my $service = $heap->{services}->{$wheel_id};
1182 daemon_log("ERROR: '$service' watcher $operation error $errno: $error_string", 1);
1183 daemon_log("ERROR: shutting down '$service' file watcher", 1);
1185 delete $heap->{services}->{$wheel_id};
1186 delete $heap->{watchers}->{$wheel_id};
1187 return;
1188 }
1190 sub fifo_got_record {
1191 my $file_record = $_[ARG0];
1192 my $header;
1193 my $content = "";
1195 $file_record =~ /^(\S+)[ ]?([\s\S]+)?$/;
1196 if( defined $1 ) {
1197 $header = $1;
1198 } else {
1199 return;
1200 }
1202 if( defined $2 ) {
1203 $content = $2;
1204 }
1206 my $clmsg_hash = &create_xml_hash("CLMSG_$header", $client_address, $server_address, $content);
1207 &add_content2xml_hash($clmsg_hash, "macaddress", $client_mac_address);
1208 my $clmsg = &create_xml_string($clmsg_hash);
1209 &send_msg_to_target($clmsg, $server_address, $server_key);
1210 return;
1211 }
1214 sub _start {
1215 my ($kernel, $heap) = @_[KERNEL, HEAP];
1216 $kernel->alias_set('client_session');
1218 # force a registration at a gosa-si-server
1219 $kernel->yield('register_at_gosa_si_server');
1221 # install all file watcher defined
1222 while( my($file_name, $file) = each %files_to_watch ) {
1223 my $file_watcher = POE::Wheel::FollowTail->new(
1224 Filename => $file,
1225 InputEvent => $file_name."_record",
1226 ResetEvent => "file_reset",
1227 ErrorEvent => "file_error",
1228 );
1229 $heap->{services}->{ $file_watcher->ID } = $file_name;
1230 $heap->{watchers}->{ $file_watcher->ID } = $file_watcher;
1231 }
1232 }
1235 sub server_input {
1236 my ($kernel, $heap, $input, $wheel) = @_[KERNEL, HEAP, ARG0, ARG1];
1237 my $error = 0;
1238 my $answer;
1240 daemon_log("Incoming msg:\n$input\n", 8);
1242 my ($msg, $msg_hash) = &check_key_and_xml_validity($input, $server_key);
1243 if( (!$msg) || (!$msg_hash) ) {
1244 daemon_log("Deciphering of incoming msg failed", 5);
1245 $error++;
1246 }
1249 ######################
1250 # process incoming msg
1251 if( $error == 0 ) {
1252 my $header = @{$msg_hash->{header}}[0];
1253 my $source = @{$msg_hash->{source}}[0];
1255 if( exists $event_hash->{$header} ) {
1256 # a event exists with the header as name
1257 daemon_log("found event '$header' at event-module '".$event_hash->{$header}."'", 5);
1258 no strict 'refs';
1259 $answer = &{$event_hash->{$header}."::$header"}($msg, $msg_hash);
1260 }
1261 else {
1262 daemon_log("WARNING: no event '$header' found in event modules under $event_dir", 1);
1263 }
1264 }
1266 ########
1267 # answer
1268 if( $answer ) {
1270 #check gosa-si envelope validity
1271 my $answer_hash = &check_outgoing_xml_validity($answer);
1273 if( $answer_hash ) {
1274 # answer is valid
1276 # preprocessing
1277 if( $answer =~ "<header>registered</header>") {
1278 # set registered flag to true to stop sending further registered msgs
1279 $REGISTERED = 1;
1280 }
1281 else {
1282 &send_msg_to_target($answer, $server_address, $server_key);
1283 }
1285 # postprocessing
1286 if( $answer =~ "<header>new_key</header>") {
1287 # set new key to global variable
1288 $answer =~ /<new_key>(\S*?)<\/new_key>/;
1289 my $new_key = $1;
1290 $server_key = $new_key;
1291 }
1292 }
1294 }
1296 return;
1297 }
1299 #==== MAIN = main ==============================================================
1300 # parse commandline options
1301 Getopt::Long::Configure( "bundling" );
1302 GetOptions("h|help" => \&usage,
1303 "c|config=s" => \$cfg_file,
1304 "f|foreground" => \$foreground,
1305 "v|verbose+" => \$verbose,
1306 );
1308 # read and set config parameters
1309 &check_cmdline_param ;
1310 &read_configfile($cfg_file, %cfg_defaults);
1311 &check_pid;
1314 # forward error messages to logfile
1315 if ( ! $foreground ) {
1316 open STDIN, '/dev/null' or die "Can’t read /dev/null: $!";
1317 open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
1318 open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
1319 }
1321 # Just fork, if we are not in foreground mode
1322 if( ! $foreground ) {
1323 chdir '/' or die "Can't chdir to /: $!";
1324 $pid = fork;
1325 setsid or die "Can't start a new session: $!";
1326 umask 0;
1327 }
1328 else {
1329 $pid = $$;
1330 }
1332 # Do something useful - put our PID into the pid_file
1333 if( 0 != $pid ) {
1334 open( LOCK_FILE, ">$pid_file" );
1335 print LOCK_FILE "$pid\n";
1336 close( LOCK_FILE );
1337 if( !$foreground ) {
1338 exit( 0 )
1339 };
1340 }
1342 daemon_log(" ", 1);
1343 daemon_log("$prg started!", 1);
1345 # delete old DBsqlite lock files
1346 system('rm -f /tmp/gosa_si_lock*gosa-si-client*');
1348 # detect ip and mac address and complete host address
1349 #if( inet_aton($client_ip) ){
1350 #print STDERR "ip: $client_ip\n";
1351 # $client_ip = inet_ntoa(inet_aton($client_ip));
1352 #print STDERR "ip: $client_ip\n";
1353 #}
1354 $client_address = $client_ip.":".$client_port;
1355 my $network_interface= &get_interface_for_ip($client_ip);
1356 $client_mac_address= &get_mac($network_interface);
1357 daemon_log("gosa-si-client ip address detected: $client_ip", 1);
1358 daemon_log("gosa-si-client mac address detected: $client_mac_address", 1);
1361 # import events
1362 &import_events();
1365 # compute hardware checksum
1366 $gotoHardwareChecksum= &generate_hw_digest();
1367 daemon_log("gosa-si-client gotoHardwareChecksum detected: $gotoHardwareChecksum", 1);
1370 # create socket for incoming xml messages
1371 POE::Component::Server::TCP->new(
1372 Alias => 'gosa-si-client',
1373 Port => $client_port,
1374 ClientInput => \&server_input,
1375 );
1376 daemon_log("start socket for incoming xml messages at port '$client_port' ", 1);
1379 # prepare variables
1380 if( inet_aton($server_ip) ){ $server_ip = inet_ntoa(inet_aton($server_ip)); }
1381 ############################################################
1382 # to change
1383 if( $server_ip eq "127.0.1.1" ) { $server_ip = "127.0.0.1" }
1384 ############################################################
1385 if (defined $server_ip && defined $server_port) {
1386 $server_address = $server_ip.":".$server_port;
1387 }
1388 $xml = new XML::Simple();
1389 $default_server_key = $server_key;
1392 # add gosa-si-server address from config file at first position of server list
1393 my $server_check_cfg = Config::IniFiles->new( -file => $cfg_file );
1394 my $server_check = $server_check_cfg->val( "server", "ip");
1395 if( defined $server_check ) {
1396 unshift(@servers, $server_address);
1397 my $servers_string = join(", ", @servers);
1398 daemon_log("found servers in configuration file: $servers_string", 5);
1399 }
1400 else {
1401 if ( !$server_domain) {
1402 daemon_log("ERROR: please specify a gosa-si-server address or a domain in config file", 1);
1403 kill 2, $$;
1404 }
1405 my @tmp_servers = &get_server_addresses($server_domain);
1406 if( 0 == @tmp_servers ) {
1407 daemon_log("ERROR: no gosa-si-server found in DNS for domain '$server_domain'",1);
1408 daemon_log("ERROR: please specify a gosa-si-server address or a domain in config file", 1);
1409 kill 2, $$;
1410 }
1412 foreach my $server (@tmp_servers) {
1413 unshift(@servers, $server);
1414 }
1415 my $servers_string = join(", ", @servers);
1416 daemon_log("found servers in DNS: $servers_string", 5);
1417 }
1420 # open fifo for non-gosa-si-client-msgs to gosa-si-server
1421 POSIX::mkfifo("$gosa_si_client_fifo", "0600");
1424 POE::Session->create(
1425 inline_states => {
1426 _start => \&_start,
1427 register_at_gosa_si_server => \®ister_at_gosa_si_server,
1428 trigger_new_key => \&trigger_new_key,
1430 # handle records from each defined file differently
1431 fifo_record => \&fifo_got_record,
1433 # handle file resets and errors the same way for each file
1434 file_reset => \&generic_file_reset,
1435 file_error => \&generic_file_error,
1436 }
1437 );
1439 POE::Kernel->run();
1440 exit;