1 #!/usr/bin/perl
2 #===============================================================================
3 #
4 # FILE: gosa-server
5 #
6 # USAGE: ./gosa-server
7 #
8 # DESCRIPTION:
9 #
10 # OPTIONS: ---
11 # REQUIREMENTS: ---
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 IO::Socket::INET;
29 use Crypt::Rijndael;
30 use MIME::Base64;
31 use Digest::MD5 qw(md5 md5_hex md5_base64);
32 use XML::Simple;
33 use Data::Dumper;
34 use Sys::Syslog qw( :DEFAULT setlogsock);
35 use Cwd;
36 use File::Spec;
37 use IPC::Shareable qw( :lock);
38 IPC::Shareable->clean_up_all;
40 my ($cfg_file, $default_cfg_file, %cfg_defaults, $foreground, $verbose);
41 my ($bus_activ, $bus_passwd, $bus_ip, $bus_port, $bus_address, $bus, $bus_mac_address);
42 my ($pid_file, $procid, $pid, $log_file, $my_own_address);
43 my (%free_child, %busy_child, $child_max, $child_min, %child_alive_time, $child_timeout);
44 my ($xml, $bus_cipher, $known_daemons, $shmkh);
46 $foreground = 0 ;
47 $known_daemons = {};
48 $shmkh = tie($known_daemons, 'IPC::Shareable', undef, {create => 1,
49 exclusive => 1,
50 mode => 0666,
51 destroy => 1,
52 });
53 %cfg_defaults =
54 ("general" =>
55 {"log_file" => [\$log_file, "/var/run/".$0.".log"],
56 "pid_file" => [\$pid_file, "/var/run/".$0.".pid"],
57 "child_max" => [\$child_max, 10],
58 "child_min" => [\$child_min, 3],
59 "child_timeout" => [\$child_timeout, 180],
61 },
62 "bus" =>
63 {"bus_activ" => [\$bus_activ, "on"],
64 "bus_passwd" => [\$bus_passwd, ""],
65 "bus_port" => [\$bus_port, "20080"],
66 }
67 );
69 #=== FUNCTION ================================================================
70 # NAME: read_configfile
71 # PARAMETERS: cfg_file - string -
72 # RETURNS: nothing
73 # DESCRIPTION: read cfg_file and set variables
74 #===============================================================================
75 sub read_configfile {
76 my $cfg;
77 if( defined( $cfg_file) && ( length($cfg_file) > 0 )) {
78 if( -r $cfg_file ) {
79 $cfg = Config::IniFiles->new( -file => $cfg_file );
80 } else {
81 print STDERR "Couldn't read config file!";
82 }
83 } else {
84 $cfg = Config::IniFiles->new() ;
85 }
86 foreach my $section (keys %cfg_defaults) {
87 foreach my $param (keys %{$cfg_defaults{ $section }}) {
88 my $pinfo = $cfg_defaults{ $section }{ $param };
89 ${@$pinfo[ 0 ]} = $cfg->val( $section, $param, @$pinfo[ 1 ] );
90 }
91 }
92 }
94 #=== FUNCTION ================================================================
95 # NAME: logging
96 # PARAMETERS: level - string - default 'info'
97 # msg - string -
98 # facility - string - default 'LOG_DAEMON'
99 # RETURNS: nothing
100 # DESCRIPTION: function for logging
101 #===============================================================================
102 sub daemon_log {
103 my( $msg, $level ) = @_;
104 if(not defined $msg) { return }
105 if(not defined $level) { $level = 1 }
106 if(defined $log_file){
107 open(LOG_HANDLE, ">>$log_file");
108 if(not defined open( LOG_HANDLE, ">>$log_file" )) {
109 print STDERR "cannot open $log_file: $!";
110 return }
111 chomp($msg);
112 if($level <= $verbose){
113 print LOG_HANDLE $msg."\n";
114 if(defined $foreground) { print $msg."\n" }
115 }
116 }
117 close( LOG_HANDLE );
118 # my ($msg, $level, $facility) = @_;
119 # if(not defined $msg) {return}
120 # if(not defined $level) {$level = "info"}
121 # if(not defined $facility) {$facility = "LOG_DAEMON"}
122 # openlog($0, "pid,cons,", $facility);
123 # syslog($level, $msg);
124 # closelog;
125 # return;
126 }
128 #=== FUNCTION ================================================================
129 # NAME: check_cmdline_param
130 # PARAMETERS: nothing
131 # RETURNS: nothing
132 # DESCRIPTION: validates commandline parameter
133 #===============================================================================
134 sub check_cmdline_param () {
135 my $err_config;
136 my $err_counter = 0;
137 if( not defined( $cfg_file)) {
138 my $cwd = getcwd;
139 my $name = "/etc/gosa/gosa-si-bus.conf";
140 $cfg_file = File::Spec->catfile( $cwd, $name );
141 print STDERR "no conf file specified\n try to use default: $cfg_file\n";
142 }
143 if( $err_counter > 0 ) {
144 &usage( "", 1 );
145 if( defined( $err_config)) { print STDERR "$err_config\n"}
146 print STDERR "\n";
147 exit( -1 );
148 }
149 }
151 #=== FUNCTION ================================================================
152 # NAME: check_pid
153 # PARAMETERS: nothing
154 # RETURNS: nothing
155 # DESCRIPTION: handels pid processing
156 #===============================================================================
157 sub check_pid {
158 $pid = -1;
159 # Check, if we are already running
160 if( open(LOCK_FILE, "<$pid_file") ) {
161 $pid = <LOCK_FILE>;
162 if( defined $pid ) {
163 chomp( $pid );
164 if( -f "/proc/$pid/stat" ) {
165 my($stat) = `cat /proc/$pid/stat` =~ m/$pid \((.+)\).*/;
166 if( $0 eq $stat ) {
167 close( LOCK_FILE );
168 exit -1;
169 }
170 }
171 }
172 close( LOCK_FILE );
173 unlink( $pid_file );
174 }
176 # create a syslog msg if it is not to possible to open PID file
177 if (not sysopen(LOCK_FILE, $pid_file, O_WRONLY|O_CREAT|O_EXCL, 0644)) {
178 my($msg) = "Couldn't obtain lockfile '$pid_file' ";
179 if (open(LOCK_FILE, '<', $pid_file)
180 && ($pid = <LOCK_FILE>))
181 {
182 chomp($pid);
183 $msg .= "(PID $pid)\n";
184 } else {
185 $msg .= "(unable to read PID)\n";
186 }
187 if( ! ($foreground) ) {
188 openlog( $0, "cons,pid", "daemon" );
189 syslog( "warning", $msg );
190 closelog();
191 }
192 else {
193 print( STDERR " $msg " );
194 }
195 exit( -1 );
196 }
197 }
200 #=== FUNCTION ================================================================
201 # NAME: usage
202 # PARAMETERS: nothing
203 # RETURNS: nothing
204 # DESCRIPTION: print out usage text to STDERR
205 #===============================================================================
206 sub usage {
207 print STDERR << "EOF" ;
208 usage: $0 [-hvf] [-c config]
210 -h : this (help) message
211 -c <file> : config file
212 -f : foreground, process will not be forked to background
213 -v : be verbose (multiple to increase verbosity)
214 EOF
215 print "\n" ;
216 }
219 #=== FUNCTION ================================================================
220 # NAME: sig_int_handler
221 # PARAMETERS: signal - string - signal arose from system
222 # RETURNS: noting
223 # DESCRIPTION: handels tasks to be done befor signal becomes active
224 #===============================================================================
225 sub sig_int_handler {
226 my ($signal) = @_;
227 if($bus){
228 close($bus);
229 print "$bus closed\n";
230 }
231 print "$signal\n";
232 IPC::Shareable->clean_up;
233 exit(1);
234 }
235 $SIG{INT} = \&sig_int_handler;
238 #=== FUNCTION ================================================================
239 # NAME: get_ip_and_mac
240 # PARAMETERS: nothing
241 # RETURNS: (ip, mac)
242 # DESCRIPTION: executes /sbin/ifconfig and parses the output, the first occurence
243 # of a inet address is returned as well as the mac address in the line
244 # above the inet address
245 #===============================================================================
246 sub get_ip_and_mac {
247 my $ip = "0.0.0.0.0"; # Defualt-IP
248 my $mac_address = "00:00:00:00:00:00"; # Default-MAC
249 my @ifconfig = qx(/sbin/ifconfig);
250 foreach(@ifconfig) {
251 if (/Hardware Adresse (\S{2}):(\S{2}):(\S{2}):(\S{2}):(\S{2}):(\S{2})/) {
252 $mac_address = "$1:$2:$3:$4:$5:$6";
253 next;
254 }
255 if (/inet Adresse:(\d+).(\d+).(\d+).(\d+)/) {
256 $ip = "$1.$2.$3.$4";
257 last;
258 }
259 }
260 return ($ip, $mac_address);
261 }
265 #=== FUNCTION ================================================================
266 # NAME: activating_child
267 # PARAMETERS: msg - string - incoming message
268 # host - string - host from which the incomming message comes
269 # RETURNS: nothing
270 # DESCRIPTION: handels the distribution of incoming messages to working childs
271 #===============================================================================
272 sub activating_child {
273 my ($msg, $host) = @_;
274 my $child = &get_processing_child();
275 my $pipe_wr = $$child{'pipe_wr'};
276 daemon_log("activating: childpid: $$child{'pid'}", 5);
277 print $pipe_wr $msg.".".$host."\n";
278 return;
279 }
282 #=== FUNCTION ================================================================
283 # NAME: get_processing_child
284 # PARAMETERS: nothing
285 # RETURNS: child - hash - holding the process id and the references to the pipe
286 # handles pipe_wr and pipe_rd
287 # DESCRIPTION: handels the forking, reactivating and keeping alive tasks
288 #===============================================================================
289 sub get_processing_child {
290 my $child;
291 # checking %busy_child{pipe_wr} if msg is 'done', then set child from busy to free
292 while(my ($key, $val) = each(%busy_child)) {
293 # check wether process still exists
294 my $exitus_pid = waitpid($key, WNOHANG);
295 if($exitus_pid != 0) {
296 delete $busy_child{$key};
297 daemon_log( "prozess:$key wurde aus busy_child entfernt\n", 5);
298 next;
299 }
301 # check wether process sitll works
302 my $fh = $$val{'pipe_rd'};
303 $fh->blocking(0);
304 my $child_answer;
305 if(not $child_answer = <$fh>) { next }
306 chomp($child_answer);
307 if($child_answer eq "done") {
308 delete $busy_child{$key};
309 $free_child{$key} = $val;
310 }
311 }
313 while(my ($key, $val) = each(%free_child)) {
314 my $exitus_pid = waitpid($key, WNOHANG);
315 if($exitus_pid != 0) {
316 delete $free_child{$key};
317 daemon_log( "prozess:$key wurde aus free_child entfernt\n", 5);
318 }
319 daemon_log("free child:$key\n", 5);
320 }
321 # check @free_child and @busy_child
322 my $free_len = scalar(keys(%free_child));
323 my $busy_len = scalar(keys(%busy_child));
324 daemon_log("free children $free_len, busy children $busy_len\n",5);
326 # if there is a free child, let the child work
327 if($free_len > 0){
328 my @keys = keys(%free_child);
329 $child = $free_child{$keys[0]};
330 if(defined $child) {
331 $busy_child{$$child{'pid'}} = $child ;
332 delete $free_child{$$child{'pid'}};
333 }
334 return $child;
335 }
337 # no free child, try to fork another one
338 if($free_len + $busy_len < $child_max) {
340 daemon_log("not enough children, create a new one\n",5);
342 # New pipes for communication
343 my( $PARENT_wr, $PARENT_rd );
344 my( $CHILD_wr, $CHILD_rd );
345 pipe( $CHILD_rd, $PARENT_wr );
346 pipe( $PARENT_rd, $CHILD_wr );
347 $PARENT_wr->autoflush(1);
348 $CHILD_wr->autoflush(1);
350 ############
351 # fork child
352 ############
353 my $child_pid = fork();
355 #CHILD
356 if($child_pid == 0) {
357 # Close unused pipes
358 close( $CHILD_rd );
359 close( $CHILD_wr );
360 while( 1 ) {
361 my $rbits = "";
362 vec( $rbits, fileno $PARENT_rd , 1 ) = 1;
364 # waiting child_timeout for jobs to do
365 my $nf = select($rbits, undef, undef, $child_timeout);
366 if($nf < 0 ) {
367 # if $nf < 1, error handling
368 die "select(): $!\n";
369 } elsif (! $nf) {
370 # if already child_min childs are alive, then leave loop
371 $free_len = scalar(keys(%free_child));
372 $busy_len = scalar(keys(%busy_child));
373 if($free_len + $busy_len >= $child_min) {
374 last;
375 } else {
376 redo;
377 }
378 }
380 # a job for a child arise
381 if ( vec $rbits, fileno $PARENT_rd, 1 ) {
382 # read everything from pipe
383 my $msg = "";
384 $PARENT_rd->blocking(0);
385 while(1) {
386 my $read = <$PARENT_rd>;
387 if(not defined $read) { last}
388 $msg .= $read;
389 }
391 # forward the job msg to another function
392 &process_incoming_msg($msg);
393 daemon_log("processing of msg finished", 5);
395 # important!!! wait until child says 'done', until then child is set from busy to free
396 print $PARENT_wr "done";
397 redo;
398 }
399 }
400 # childs leaving the loop are allowed to die
401 exit(0);
403 #PARENT
404 } else {
405 # Close unused pipes
406 close( $PARENT_rd );
407 close( $PARENT_wr );
408 # add child to child alive hash
409 my %child_hash = (
410 'pid' => $child_pid,
411 'pipe_wr' => $CHILD_wr,
412 'pipe_rd' => $CHILD_rd,
413 );
415 $child = \%child_hash;
416 $busy_child{$$child{'pid'}} = $child;
417 return $child;
418 }
419 }
420 }
423 #=== FUNCTION ================================================================
424 # NAME: process_incoming_msg
425 # PARAMETERS: crypted_msg - string - incoming crypted message
426 # RETURNS: nothing
427 # DESCRIPTION: handels the proceeded distribution to the appropriated functions
428 #===============================================================================
429 sub process_incoming_msg {
430 my ($crypted_msg) = @_;
431 if(not defined $crypted_msg) {
432 daemon_log("function 'process_incoming_msg': got no msg", 7);
433 return;
434 }
435 $crypted_msg =~ /^([\s\S]*?)\.(\d{1,3}?)\.(\d{1,3}?)\.(\d{1,3}?)\.(\d{1,3}?)$/;
436 $crypted_msg = $1;
437 my $host = sprintf("%s.%s.%s.%s", $2, $3, $4, $5);
439 daemon_log("msg from host:\n\t$host", 1);
440 daemon_log("crypted_msg:\n\t$crypted_msg", 7);
442 my @valid_keys;
443 my @daemon_keys = keys %$known_daemons;
444 foreach my $daemon_key (@daemon_keys) {
445 if($daemon_key =~ "^$daemon_key") {
446 push(@valid_keys, $daemon_key);
447 }
448 }
450 my $l = @valid_keys;
451 daemon_log("number of valid daemons: $l\n", 7);
453 my ($msg, $msg_hash);
454 my $msg_flag = 0;
456 # collect addresses from possible incoming clients
457 foreach my $host_key (@valid_keys) {
458 eval{
459 daemon_log( "daemon: $host_key\n", 7);
460 my $key_passwd = $known_daemons->{$host_key}->{passwd};
461 daemon_log("daemon_passwd: $key_passwd\n", 7);
462 my $key_cipher = &create_ciphering($key_passwd);
463 $msg = &decrypt_msg($crypted_msg, $key_cipher);
464 daemon_log("daemon decrypted msg:$msg", 7);
465 $msg_hash = $xml->XMLin($msg, ForceArray=>1);
466 };
467 if($@) {
468 daemon_log("msg processing raise error", 7);
469 daemon_log("error string: $@", 7);
470 $msg_flag += 1;
471 } else {
472 last;
473 }
474 }
476 if($msg_flag >= $l) {
477 daemon_log("\nERROR: do not understand the message:\n$msg" , 1);
478 return;
479 }
481 my $header = &get_content_from_xml_hash($msg_hash, "header");
482 my $target = &get_content_from_xml_hash($msg_hash, "target");
484 daemon_log("header from msg:\n\t$header", 1);
485 daemon_log("msg to process:\n\t$msg", 5);
486 daemon_log("msg is for: \n\t$target", 7);
488 if($target eq $bus_address) {
489 # msg is for bus
490 if($header eq 'here_i_am'){ &here_i_am($msg_hash)}
491 elsif($header eq 'confirm_new_passwd'){ &confirm_new_passwd($msg_hash)}
492 elsif($header eq 'got_ping') { &got_ping($msg_hash)}
493 elsif($header eq 'ping') { &ping($msg_hash)}
494 elsif($header eq 'who_has') { &who_has($msg_hash)}
495 elsif($header eq 'new_client') { &new_client($msg_hash)}
496 elsif($header eq 'delete_client') { &delete_client($msg_hash)}
497 } else {
498 # msg is for any other server
499 my @targets = @{$msg_hash->{target}};
500 my $len_targets = @targets;
502 if ($len_targets == 0){
503 # no targets specified
505 daemon_log("ERROR: no target specified for msg $header", 1);
507 } elsif ($targets[0] eq "*"){
508 # all deamons in known_daemons are targets
510 my $target = $targets[0];
511 my $source = @{$msg_hash->{source}}[0];
512 my @target_addresses = keys(%$known_daemons);
513 foreach my $target_address (@target_addresses) {
514 if ($target_address eq $source) { next; }
515 if ($target_address eq $bus_address) { next ; }
516 $msg_hash->{target} = [$target_address];
517 &send_msg_hash2address($msg_hash, $target_address);
518 }
520 } else {
521 # a list of targets is specified
523 my $target_address;
524 foreach $target_address (@targets) {
525 if (exists $known_daemons->{$target_address}) {
526 &send_msg_hash2address($msg_hash, $target_address);
527 } else {
528 my @daemon_addresses = keys %$known_daemons;
529 my $daemon_address;
530 foreach $daemon_address (@daemon_addresses) {
531 if (exists $known_daemons->{$daemon_address}->{clients}->{$target_address}) {
532 my $header = &get_content_from_xml_hash($msg_hash, "header");
533 &send_msg_hash2address($msg_hash, $daemon_address);
534 daemon_log("bus forwards msg $header for client $target_address to server $daemon_address", 3);
535 last;
536 }
537 }
539 }
540 }
541 }
542 }
544 &print_known_daemons_hash();
545 return;
546 }
549 #=== FUNCTION ================================================================
550 # NAME: get_content_of_known_daemons
551 # PARAMETERS:
552 # RETURNS:
553 # DESCRIPTION:
554 #===============================================================================
555 #sub get_content_of_known_daemons {
556 # my ($host, $content) = @_;
557 # return;
558 #}
561 #=== FUNCTION ================================================================
562 # NAME: create_passwd
563 # PARAMETERS: nothing
564 # RETURNS: new_passwd - string
565 # DESCRIPTION: creates a 32 bit long random passwd out of "a".."z","A".."Z",0..9
566 #===============================================================================
567 sub create_passwd {
568 my $new_passwd = "";
569 for(my $i=0; $i<31; $i++) {
570 $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
571 }
572 return $new_passwd;
573 }
576 #=== FUNCTION ================================================================
577 # NAME: create_ciphering
578 # PARAMETERS: passwd - string - used to create ciphering
579 # RETURNS: cipher - object
580 # DESCRIPTION: creates a Crypt::Rijndael::MODE_CBC object with passwd as key
581 #===============================================================================
582 sub create_ciphering {
583 my ($passwd) = @_;
584 $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
585 my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
587 #daemon_log("iv: $iv", 7);
588 #daemon_log("key: $passwd", 7);
589 my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
590 $my_cipher->set_iv($iv);
591 return $my_cipher;
592 }
595 #=== FUNCTION ================================================================
596 # NAME: encrypt_msg
597 # PARAMETERS: msg - string - message to encrypt
598 # my_cipher - ref - reference to a Crypt::Rijndael object
599 # RETURNS: crypted_msg - string - crypted message
600 # DESCRIPTION: crypts the incoming message with the Crypt::Rijndael module
601 #===============================================================================
602 sub encrypt_msg {
603 my ($msg, $my_cipher) = @_;
604 if(not defined $my_cipher) { print "no cipher object\n"; }
605 $msg = "\0"x(16-length($msg)%16).$msg;
606 my $crypted_msg = $my_cipher->encrypt($msg);
607 chomp($crypted_msg = &encode_base64($crypted_msg));
608 return $crypted_msg;
609 }
612 #=== FUNCTION ================================================================
613 # NAME: decrypt_msg
614 # PARAMETERS: crypted_msg - string - message to decrypt
615 # my_cipher - ref - reference to a Crypt::Rijndael object
616 # RETURNS: msg - string - decrypted message
617 # DESCRIPTION: decrypts the incoming message with the Crypt::Rijndael module
618 #===============================================================================
619 sub decrypt_msg {
620 my ($crypted_msg, $my_cipher) = @_ ;
621 $crypted_msg = &decode_base64($crypted_msg);
622 my $msg = $my_cipher->decrypt($crypted_msg);
623 $msg =~ s/^\0*//g;
624 return $msg;
625 }
628 #=== FUNCTION ================================================================
629 # NAME: create_xml_hash
630 # PARAMETERS: header - string - message header (required)
631 # source - string - where the message come from (required)
632 # target - string - where the message should go to (required)
633 # [header_value] - string - something usefull (optional)
634 # RETURNS: hash - hash - nomen est omen
635 # DESCRIPTION: creates a key-value hash, all values are stored in a array
636 #===============================================================================
637 sub create_xml_hash {
638 my ($header, $source, $target, $header_value) = @_ ;
640 if (not defined $header || not defined $source || not defined $target) {
641 daemon_log("ERROR: create_xml_hash function is invoked with uncompleted parameters", 7);
642 }
644 my $hash = {
645 header => [$header],
646 source => [$source],
647 target => [$target],
648 $header => [$header_value],
649 };
650 #daemon_log("create_xml_hash:", 7),
651 #chomp(my $tmp = Dumper $hash);
652 #daemon_log("\t$tmp\n", 7);
653 return $hash
654 }
657 #=== FUNCTION ================================================================
658 # NAME: create_xml_string
659 # PARAMETERS: xml_hash - hash - hash from function create_xml_hash
660 # RETURNS: xml_string - string - xml string representation of the hash
661 # DESCRIPTION: transform the hash to a string using XML::Simple module
662 #===============================================================================
663 sub create_xml_string {
664 my ($xml_hash) = @_ ;
665 my $xml_string = $xml->XMLout($xml_hash, RootName => 'xml');
666 $xml_string =~ s/[\n]+//g;
667 return $xml_string;
668 }
671 #=== FUNCTION ================================================================
672 # NAME: add_content2xml_hash
673 # PARAMETERS: xml_ref - ref - reference to a hash from function create_xml_hash
674 # element - string - key for the hash
675 # content - string - value for the hash
676 # RETURNS: nothing
677 # DESCRIPTION: add key-value pair to xml_ref, if key alread exists, then append value to list
678 #===============================================================================
679 sub add_content2xml_hash {
680 my ($xml_ref, $element, $content) = @_;
681 if(not exists $$xml_ref{$element} ) {
682 $$xml_ref{$element} = [];
683 }
684 my $tmp = $$xml_ref{$element};
685 push(@$tmp, $content);
686 return;
687 }
690 #=== FUNCTION ================================================================
691 # NAME: get_content_from_xml_hash
692 # PARAMETERS: xml_ref - ref - reference of the xml hash
693 # element - string - key of the value you want
694 # RETURNS: value - string - if key is either header, target or source
695 # value - list - for all other keys in xml hash
696 # DESCRIPTION:
697 #===============================================================================
698 sub get_content_from_xml_hash {
699 my ($xml_ref, $element) = @_;
700 my $result = $xml_ref->{$element};
701 if( $element eq "header" || $element eq "target" || $element eq "source") {
702 return @$result[0];
703 }
704 return @$result;
705 }
708 #=== FUNCTION ================================================================
709 # NAME: open_socket
710 # PARAMETERS: PeerAddr - string - something like 192.168.1.1 or 192.168.1.1:10000
711 # [PeerPort] - string - necessary if port not appended by PeerAddr
712 # RETURNS: socket - IO::Socket::INET
713 # DESCRIPTION: open a socket to PeerAddr
714 #===============================================================================
715 sub open_socket {
716 my ($PeerAddr, $PeerPort) = @_ ;
717 if(defined($PeerPort)){
718 $PeerAddr = $PeerAddr.":".$PeerPort;
719 }
720 my $socket;
721 $socket = new IO::Socket::INET(PeerAddr => $PeerAddr ,
722 Porto => "tcp" ,
723 Type => SOCK_STREAM,
724 Reuse => 1,
725 Timeout => 5,
726 );
727 if(not defined $socket) {
728 return;
729 }
730 return $socket;
731 }
734 #=== FUNCTION ================================================================
735 # NAME: read_from_socket
736 # PARAMETERS: socket - fh - filehandel to read from
737 # RETURNS: result - string - readed characters from socket
738 # DESCRIPTION: reads data from socket in 16 byte steps
739 #===============================================================================
740 sub read_from_socket {
741 my ($socket) = @_;
743 $socket->blocking(1);
744 my $result = <$socket>;
745 $socket->blocking(0);
746 my $part_msg;
747 while ($part_msg = <$socket>) {
748 if (not defined $part_msg) { last; }
749 $result .= $part_msg;
750 }
752 #my $result = "";
753 #my $len = 16;
754 #while($len == 16){
755 # my $char;
756 # $len = sysread($socket, $char, 16);
757 # if($len != 16) { last }
758 # if($len != 16) { last }
759 # $result .= $char;
760 #}
761 return $result;
762 }
765 #=== FUNCTION ================================================================
766 # NAME: send_msg_hash2address
767 # PARAMETERS: msg_hash - hash - xml_hash created with function create_xml_hash
768 # PeerAddr string - socket address to send msg
769 # PeerPort string - socket port, if not included in socket address
770 # RETURNS: nothing
771 # DESCRIPTION: ????
772 #===============================================================================
773 sub send_msg_hash2address {
774 my ($msg_hash, $address) = @_ ;
776 # fetch header for logging
777 my $header = &get_content_from_xml_hash($msg_hash, "header");
779 # generate xml string
780 my $msg_xml = &create_xml_string($msg_hash);
782 # fetch the appropriated passwd from hash
783 my $passwd = $known_daemons->{$address}->{passwd};
785 # create a ciphering object
786 my $act_cipher = &create_ciphering($passwd);
788 # encrypt xml msg
789 my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
791 # open socket
792 my $socket = &open_socket($address);
793 if(not defined $socket){
794 daemon_log("ERROR: cannot send '$header'-msg to $address , server not reachable", 1);
795 return;
796 }
798 # send xml msg
799 print $socket $crypted_msg."\n";
801 close $socket;
802 daemon_log("send '$header'-msg to $address", 5);
803 daemon_log("crypted_msg:\n\t$crypted_msg", 7);
804 return;
805 }
808 #=== FUNCTION ================================================================
809 # NAME: send_msg_hash2all
810 # PARAMETERS: msg_hash - hash - xml_hash created with function create_xml_hash
811 # RETURNS: nothing
812 # DESCRIPTION: send msg_hash to all registered daemons
813 #===============================================================================
814 sub send_msg_hash2all {
815 my ($msg_hash) = @_;
817 # fetch header for logging
818 my $header = &get_content_from_xml_hash($msg_hash, "header");
820 # generate xml string
821 my $msg_xml = &create_xml_string($msg_hash);
823 # fetch a list of all target addresses
824 my @targets = keys(%$known_daemons);
826 # itterates through the list an send each the msg
827 foreach my $target (@targets) {
828 if($target eq $bus_address) {next}; # do not send msg to bus
830 # fetch the appropriated passwd
831 my $passwd = $known_daemons->{$target}->{passwd};
833 # create ciphering object
834 my $act_cipher = &create_ciphering($passwd);
836 # encrypt xml msg
837 my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
839 # open socket
840 my $socket = &open_socket($target);
841 if(not defined $socket){
842 daemon_log("ERROR: cannot open socket to $target , server not reachable", 1);
843 &update_known_daemons_entry(hostname=>$target, status=>"down");
844 next;
845 }
847 # send xml msg
848 print $socket $crypted_msg."\n";
850 close $socket;
851 daemon_log("send '$header'-msg to $target", 5);
852 daemon_log("crypted_msg:\n\t$crypted_msg", 7);
853 }
854 return;
855 }
858 #=== FUNCTION ================================================================
859 # NAME: here_i_am
860 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
861 # RETURNS: nothing
862 # DESCRIPTION: process the incoming msg 'here_i_am'
863 #===============================================================================
864 sub here_i_am {
865 my ($msg_hash) = @_ ;
866 my $source = &get_content_from_xml_hash($msg_hash, "source");
868 my $new_passwd = &create_passwd();
870 # create known_daemons entry
871 &create_known_daemons_entry($source);
872 &update_known_daemons_entry(hostname=>$source, status=>"registered", passwd=>$bus_passwd);
874 # create outgoing msg
875 my $out_hash = &create_xml_hash("new_passwd", "$bus_ip:$bus_port", $source, $new_passwd);
876 &send_msg_hash2address($out_hash, $source);
878 # change passwd, reason
879 # &send_msg_hash2address takes $known_daemons->{"$source"}->{passwd} to cipher msg
880 &update_known_daemons_entry(hostname=>$source, status=>"new_passwd", passwd=>$new_passwd);
882 return;
883 }
886 #=== FUNCTION ================================================================
887 # NAME: confirm_new_passwd
888 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
889 # RETURNS: nothing
890 # DESCRIPTION: process this incoming message
891 #===============================================================================
892 sub confirm_new_passwd {
893 my ($msg_hash) = @_ ;
894 my $source = &get_content_from_xml_hash($msg_hash, "source");
895 &update_known_daemons_entry(hostname=>$source, status=>"confirmed_new_passwd");
896 return;
897 }
900 #=== FUNCTION ================================================================
901 # NAME: ping
902 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
903 # RETURNS: nothing
904 # DESCRIPTION: process this incoming message
905 #===============================================================================
906 sub ping {
907 my ($msg_hash) = @_ ;
908 my $source = &get_content_from_xml_hash($msg_hash, "source");
909 &update_known_daemons_entry(hostname=>$source, status=>"ping");
910 my $out_hash = &create_xml_hash("got_ping", $bus_address, $source);
911 &send_msg_hash2address($out_hash, $source);
912 return;
913 }
916 #=== FUNCTION ================================================================
917 # NAME: make ping
918 # PARAMETERS: address - string - address which should be pinged
919 # RETURNS: nothing
920 # DESCRIPTION: send ping message to address
921 #===============================================================================
922 sub make_ping {
923 my ($address) = @_;
924 daemon_log("ping:$address\n", 1);
925 my $out_hash = &create_xml_hash("ping", "$bus_ip:$bus_port", $address);
926 &send_msg_hash2address($out_hash, $address);
927 return;
928 }
931 #=== FUNCTION ================================================================
932 # NAME: got_ping
933 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
934 # RETURNS: nothing
935 # DESCRIPTION: process this incoming message
936 #===============================================================================
937 sub got_ping {
938 my ($msg_hash) = @_;
939 my $source = &get_content_from_xml_hash($msg_hash, "source");
940 &update_known_daemons_entry(hostname=>$source, status=>"got_ping");
941 return;
942 }
945 #=== FUNCTION ================================================================
946 # NAME: new_client
947 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
948 # RETURNS: nothing
949 # DESCRIPTION: process this incoming message
950 #===============================================================================
951 sub new_client {
952 my ($msg_hash) = @_ ;
953 my $source = &get_content_from_xml_hash($msg_hash, "source");
954 my $header = &get_content_from_xml_hash($msg_hash, "header");
955 my $new_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
957 &update_known_daemons_entry(hostname=>$source, client=>$new_client);
958 return;
959 }
962 #=== FUNCTION ================================================================
963 # NAME: delete_client
964 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
965 # RETURNS: nothing
966 # DESCRIPTION: process this incoming message
967 #===============================================================================
968 sub delete_client {
969 my ($msg_hash) = @_ ;
970 my $source = &get_content_from_xml_hash($msg_hash, "source");
971 my $header = &get_content_from_xml_hash($msg_hash, "header");
972 my $del_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
974 if (not exists $known_daemons->{$source}->{$del_client}) {
975 daemon_log
976 }
977 delete $known_daemons->{$source}->{$del_client};
979 return;
980 }
983 #=== FUNCTION ================================================================
984 # NAME: print_known_daemons_hash
985 # PARAMETERS: nothing
986 # RETURNS: nothing
987 # DESCRIPTION: nome est omen
988 #===============================================================================
989 sub print_known_daemons_hash {
990 my ($tmp) = @_;
991 print "####################################\n";
992 print "# status of known_daemons\n";
993 my $hosts;
994 my $host_hash;
995 $shmkh->shlock(LOCK_EX);
996 my @hosts = keys %$known_daemons;
997 foreach my $host (@hosts) {
998 my $status = $known_daemons->{$host}->{status} ;
999 my $passwd = $known_daemons->{$host}->{passwd};
1000 my $timestamp = $known_daemons->{$host}->{timestamp};
1001 my @clients = keys %{$known_daemons->{$host}->{clients}};
1002 my $client_string = join(", ", @clients);
1003 print "$host\n";
1004 print "\tstatus: $status\n";
1005 print "\tpasswd: $passwd\n";
1006 print "\ttimestamp: $timestamp\n";
1007 print "\tclients: $client_string\n";
1009 }
1010 $shmkh->shunlock(LOCK_EX);
1011 print "####################################\n\n";
1012 return;
1013 }
1016 #=== FUNCTION ================================================================
1017 # NAME: create_known_daemons_entry
1018 # PARAMETERS: hostname - string - ip address and port of host
1019 # RETURNS: nothing
1020 # DESCRIPTION: nome est omen
1021 #===============================================================================
1022 sub create_known_daemons_entry {
1023 my ($hostname) = @_;
1024 $shmkh->shlock(LOCK_EX);
1025 $known_daemons->{$hostname} = {};
1026 $known_daemons->{$hostname}->{status} = "none";
1027 $known_daemons->{$hostname}->{passwd} = "none";
1028 $known_daemons->{$hostname}->{timestamp} = "none";
1029 $known_daemons->{$hostname}->{clients} = {};
1030 $shmkh->shunlock(LOCK_EX);
1031 return;
1032 }
1035 #=== FUNCTION ================================================================
1036 # NAME: update_known_daemons_entry
1037 # PARAMETERS: hostname - string - ip address and port of host (required)
1038 # status - string - (optional)
1039 # passwd - string - (optional)
1040 # client - string - ip address and port of client (optional)
1041 # RETURNS: nothing
1042 # DESCRIPTION: nome est omen and updates each time the timestamp of hostname
1043 #===============================================================================
1044 sub update_known_daemons_entry {
1045 my $arg = {
1046 hostname => undef, status => undef, passwd => undef,
1047 client => undef,
1048 @_ };
1049 my $hostname = $arg->{hostname};
1050 my $status = $arg->{status};
1051 my $passwd = $arg->{passwd};
1052 my $client = $arg->{client};
1054 if (not defined $hostname) {
1055 daemon_log("ERROR: function add_content2known_daemons is not invoked with requiered parameter 'hostname'", 1);
1056 return;
1057 }
1059 my ($seconds, $minutes, $hours, $monthday, $month,
1060 $year, $weekday, $yearday, $sommertime) = localtime(time);
1061 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
1062 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
1063 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
1064 $month+=1;
1065 $month = $month < 10 ? $month = "0".$month : $month;
1066 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
1067 $year+=1900;
1068 my $t = "$year$month$monthday$hours$minutes$seconds";
1070 $shmkh->shlock(LOCK_EX);
1071 if (defined $status) {
1072 $known_daemons->{$hostname}->{status} = $status;
1073 }
1074 if (defined $passwd) {
1075 $known_daemons->{$hostname}->{passwd} = $passwd;
1076 }
1077 if (defined $client) {
1078 $known_daemons->{$hostname}->{clients}->{$client} = "";
1079 }
1080 $known_daemons->{$hostname}->{timestamp} = $t;
1081 $shmkh->shunlock(LOCK_EX);
1082 return;
1083 }
1086 #==== MAIN = main ==============================================================
1088 # parse commandline options
1089 Getopt::Long::Configure( "bundling" );
1090 GetOptions("h|help" => \&usage,
1091 "c|config=s" => \$cfg_file,
1092 "f|foreground" => \$foreground,
1093 "v|verbose+" => \$verbose,
1094 );
1096 # read and set config parameters
1097 &check_cmdline_param ;
1098 &read_configfile;
1099 &check_pid;
1101 $SIG{CHLD} = 'IGNORE';
1103 # restart daemon log file
1104 if(-e $log_file ) { unlink $log_file }
1105 daemon_log("$0 started!");
1107 # Just fork, if we"re not in foreground mode
1108 if( ! $foreground ) { $pid = fork(); }
1109 else { $pid = $$; }
1111 # Do something useful - put our PID into the pid_file
1112 if( 0 != $pid ) {
1113 open( LOCK_FILE, ">$pid_file" );
1114 print LOCK_FILE "$pid\n";
1115 close( LOCK_FILE );
1116 if( !$foreground ) { exit( 0 ) };
1117 }
1119 # detect own ip and mac address
1120 ($bus_ip, $bus_mac_address) = &get_ip_and_mac();
1121 if (not defined $bus_ip) {
1122 die "EXIT: ip address of $0 could not be detected";
1123 }
1124 daemon_log("bus ip address detected: $bus_ip", 1);
1125 daemon_log("bus mac address detected: $bus_mac_address", 1);
1128 # setup xml parser
1129 $xml = new XML::Simple();
1131 # create cipher object
1132 $bus_cipher = &create_ciphering($bus_passwd);
1133 $bus_address = "$bus_ip:$bus_port";
1135 # create reading and writing vectors
1136 my $rbits = my $wbits = my $ebits = "";
1138 # open the bus socket
1139 if($bus_activ eq "on") {
1140 $bus = IO::Socket::INET->new(LocalPort => $bus_port,
1141 Type => SOCK_STREAM,
1142 Reuse => 1,
1143 Listen => 20,
1144 ) or die "kann kein TCP-Server an Port $bus_port sein: $@\n";
1145 vec($rbits, fileno $bus, 1) = 1;
1146 vec($wbits, fileno $bus, 1) = 1;
1147 print "start bus at $bus_ip:$bus_port\n";
1148 }
1150 # add bus to known_daemons
1151 &create_known_daemons_entry($bus_address);
1152 &update_known_daemons_entry(hostname=>$bus_address, status=>"bus", passwd=>$bus_passwd);
1155 while(1) {
1156 my $nf = select($rbits, $wbits, undef, undef);
1157 # error handling
1158 if($nf < 0 ) {
1159 }
1161 # something is coming in
1162 if(vec $rbits, fileno $bus, 1 ) {
1163 my $client = $bus->accept();
1164 my $other_end = getpeername($client);
1165 if(not defined $other_end) {
1166 daemon_log("Gegenstelle konnte nicht identifiziert werden: $!\n");
1167 } else {
1168 my ($port, $iaddr) = unpack_sockaddr_in($other_end);
1169 my $actual_ip = inet_ntoa($iaddr);
1170 daemon_log("\naccept client from $actual_ip\n", 5);
1171 my $in_msg = &read_from_socket($client);
1172 if(defined $in_msg){
1173 &activating_child($in_msg, $actual_ip);
1174 } else {
1175 daemon_log("cannot read from $actual_ip\n",1);
1176 }
1177 }
1178 close($client);
1179 }
1181 }