09581e67795d309aea6568ddeebcfb56f6fdc12a
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-si/bus.conf";
140 $cfg_file = File::Spec->catfile( $cwd, $name );
141 }
142 if( $err_counter > 0 ) {
143 &usage( "", 1 );
144 if( defined( $err_config)) { print STDERR "$err_config\n"}
145 print STDERR "\n";
146 exit( -1 );
147 }
148 }
150 #=== FUNCTION ================================================================
151 # NAME: check_pid
152 # PARAMETERS: nothing
153 # RETURNS: nothing
154 # DESCRIPTION: handels pid processing
155 #===============================================================================
156 sub check_pid {
157 $pid = -1;
158 # Check, if we are already running
159 if( open(LOCK_FILE, "<$pid_file") ) {
160 $pid = <LOCK_FILE>;
161 if( defined $pid ) {
162 chomp( $pid );
163 if( -f "/proc/$pid/stat" ) {
164 my($stat) = `cat /proc/$pid/stat` =~ m/$pid \((.+)\).*/;
165 if( $0 eq $stat ) {
166 close( LOCK_FILE );
167 exit -1;
168 }
169 }
170 }
171 close( LOCK_FILE );
172 unlink( $pid_file );
173 }
175 # create a syslog msg if it is not to possible to open PID file
176 if (not sysopen(LOCK_FILE, $pid_file, O_WRONLY|O_CREAT|O_EXCL, 0644)) {
177 my($msg) = "Couldn't obtain lockfile '$pid_file' ";
178 if (open(LOCK_FILE, '<', $pid_file)
179 && ($pid = <LOCK_FILE>))
180 {
181 chomp($pid);
182 $msg .= "(PID $pid)\n";
183 } else {
184 $msg .= "(unable to read PID)\n";
185 }
186 if( ! ($foreground) ) {
187 openlog( $0, "cons,pid", "daemon" );
188 syslog( "warning", $msg );
189 closelog();
190 }
191 else {
192 print( STDERR " $msg " );
193 }
194 exit( -1 );
195 }
196 }
199 #=== FUNCTION ================================================================
200 # NAME: usage
201 # PARAMETERS: nothing
202 # RETURNS: nothing
203 # DESCRIPTION: print out usage text to STDERR
204 #===============================================================================
205 sub usage {
206 print STDERR << "EOF" ;
207 usage: $0 [-hvf] [-c config]
209 -h : this (help) message
210 -c <file> : config file
211 -f : foreground, process will not be forked to background
212 -v : be verbose (multiple to increase verbosity)
213 EOF
214 print "\n" ;
215 }
218 #=== FUNCTION ================================================================
219 # NAME: sig_int_handler
220 # PARAMETERS: signal - string - signal arose from system
221 # RETURNS: noting
222 # DESCRIPTION: handels tasks to be done befor signal becomes active
223 #===============================================================================
224 sub sig_int_handler {
225 my ($signal) = @_;
226 if($bus){
227 close($bus);
228 print "$bus closed\n";
229 }
230 print "$signal\n";
231 IPC::Shareable->clean_up;
232 exit(1);
233 }
234 $SIG{INT} = \&sig_int_handler;
237 #=== FUNCTION ================================================================
238 # NAME: get_ip_and_mac
239 # PARAMETERS: nothing
240 # RETURNS: (ip, mac)
241 # DESCRIPTION: executes /sbin/ifconfig and parses the output, the first occurence
242 # of a inet address is returned as well as the mac address in the line
243 # above the inet address
244 #===============================================================================
245 sub get_ip_and_mac {
246 my $ip = "0.0.0.0.0"; # Defualt-IP
247 my $mac_address = "00:00:00:00:00:00"; # Default-MAC
248 my @ifconfig = qx(/sbin/ifconfig);
249 foreach(@ifconfig) {
250 if (/Hardware Adresse (\S{2}):(\S{2}):(\S{2}):(\S{2}):(\S{2}):(\S{2})/) {
251 $mac_address = "$1:$2:$3:$4:$5:$6";
252 next;
253 }
254 if (/inet Adresse:(\d+).(\d+).(\d+).(\d+)/) {
255 $ip = "$1.$2.$3.$4";
256 last;
257 }
258 }
259 return ($ip, $mac_address);
260 }
264 #=== FUNCTION ================================================================
265 # NAME: activating_child
266 # PARAMETERS: msg - string - incoming message
267 # host - string - host from which the incomming message comes
268 # RETURNS: nothing
269 # DESCRIPTION: handels the distribution of incoming messages to working childs
270 #===============================================================================
271 sub activating_child {
272 my ($msg, $host) = @_;
273 my $child = &get_processing_child();
274 my $pipe_wr = $$child{'pipe_wr'};
275 daemon_log("activating: childpid: $$child{'pid'}", 5);
276 print $pipe_wr $msg.".".$host."\n";
277 return;
278 }
281 #=== FUNCTION ================================================================
282 # NAME: get_processing_child
283 # PARAMETERS: nothing
284 # RETURNS: child - hash - holding the process id and the references to the pipe
285 # handles pipe_wr and pipe_rd
286 # DESCRIPTION: handels the forking, reactivating and keeping alive tasks
287 #===============================================================================
288 sub get_processing_child {
289 my $child;
290 # checking %busy_child{pipe_wr} if msg is 'done', then set child from busy to free
291 while(my ($key, $val) = each(%busy_child)) {
292 # check wether process still exists
293 my $exitus_pid = waitpid($key, WNOHANG);
294 if($exitus_pid != 0) {
295 delete $busy_child{$key};
296 daemon_log( "prozess:$key wurde aus busy_child entfernt\n", 5);
297 next;
298 }
300 # check wether process sitll works
301 my $fh = $$val{'pipe_rd'};
302 $fh->blocking(0);
303 my $child_answer;
304 if(not $child_answer = <$fh>) { next }
305 chomp($child_answer);
306 if($child_answer eq "done") {
307 delete $busy_child{$key};
308 $free_child{$key} = $val;
309 }
310 }
312 while(my ($key, $val) = each(%free_child)) {
313 my $exitus_pid = waitpid($key, WNOHANG);
314 if($exitus_pid != 0) {
315 delete $free_child{$key};
316 daemon_log( "prozess:$key wurde aus free_child entfernt\n", 5);
317 }
318 daemon_log("free child:$key\n", 5);
319 }
320 # check @free_child and @busy_child
321 my $free_len = scalar(keys(%free_child));
322 my $busy_len = scalar(keys(%busy_child));
323 daemon_log("free children $free_len, busy children $busy_len\n",5);
325 # if there is a free child, let the child work
326 if($free_len > 0){
327 my @keys = keys(%free_child);
328 $child = $free_child{$keys[0]};
329 if(defined $child) {
330 $busy_child{$$child{'pid'}} = $child ;
331 delete $free_child{$$child{'pid'}};
332 }
333 return $child;
334 }
336 # no free child, try to fork another one
337 if($free_len + $busy_len < $child_max) {
339 daemon_log("not enough children, create a new one\n",5);
341 # New pipes for communication
342 my( $PARENT_wr, $PARENT_rd );
343 my( $CHILD_wr, $CHILD_rd );
344 pipe( $CHILD_rd, $PARENT_wr );
345 pipe( $PARENT_rd, $CHILD_wr );
346 $PARENT_wr->autoflush(1);
347 $CHILD_wr->autoflush(1);
349 ############
350 # fork child
351 ############
352 my $child_pid = fork();
354 #CHILD
355 if($child_pid == 0) {
356 # Close unused pipes
357 close( $CHILD_rd );
358 close( $CHILD_wr );
359 while( 1 ) {
360 my $rbits = "";
361 vec( $rbits, fileno $PARENT_rd , 1 ) = 1;
363 # waiting child_timeout for jobs to do
364 my $nf = select($rbits, undef, undef, $child_timeout);
365 if($nf < 0 ) {
366 # if $nf < 1, error handling
367 die "select(): $!\n";
368 } elsif (! $nf) {
369 # if already child_min childs are alive, then leave loop
370 $free_len = scalar(keys(%free_child));
371 $busy_len = scalar(keys(%busy_child));
372 if($free_len + $busy_len >= $child_min) {
373 last;
374 } else {
375 redo;
376 }
377 }
379 # a job for a child arise
380 if ( vec $rbits, fileno $PARENT_rd, 1 ) {
381 # read everything from pipe
382 my $msg = "";
383 $PARENT_rd->blocking(0);
384 while(1) {
385 my $read = <$PARENT_rd>;
386 if(not defined $read) { last}
387 $msg .= $read;
388 }
390 # forward the job msg to another function
391 &process_incoming_msg($msg);
392 daemon_log("processing of msg finished", 5);
394 # important!!! wait until child says 'done', until then child is set from busy to free
395 print $PARENT_wr "done";
396 redo;
397 }
398 }
399 # childs leaving the loop are allowed to die
400 exit(0);
402 #PARENT
403 } else {
404 # Close unused pipes
405 close( $PARENT_rd );
406 close( $PARENT_wr );
407 # add child to child alive hash
408 my %child_hash = (
409 'pid' => $child_pid,
410 'pipe_wr' => $CHILD_wr,
411 'pipe_rd' => $CHILD_rd,
412 );
414 $child = \%child_hash;
415 $busy_child{$$child{'pid'}} = $child;
416 return $child;
417 }
418 }
419 }
422 #=== FUNCTION ================================================================
423 # NAME: process_incoming_msg
424 # PARAMETERS: crypted_msg - string - incoming crypted message
425 # RETURNS: nothing
426 # DESCRIPTION: handels the proceeded distribution to the appropriated functions
427 #===============================================================================
428 sub process_incoming_msg {
429 my ($crypted_msg) = @_;
430 if(not defined $crypted_msg) {
431 daemon_log("function 'process_incoming_msg': got no msg", 7);
432 return;
433 }
434 $crypted_msg =~ /^([\s\S]*?)\.(\d{1,3}?)\.(\d{1,3}?)\.(\d{1,3}?)\.(\d{1,3}?)$/;
435 $crypted_msg = $1;
436 my $host = sprintf("%s.%s.%s.%s", $2, $3, $4, $5);
438 daemon_log("msg from host:\n\t$host", 1);
439 daemon_log("crypted_msg:\n\t$crypted_msg", 7);
441 my @valid_keys;
442 my @daemon_keys = keys %$known_daemons;
443 foreach my $daemon_key (@daemon_keys) {
444 if($daemon_key =~ "^$daemon_key") {
445 push(@valid_keys, $daemon_key);
446 }
447 }
449 my $l = @valid_keys;
450 daemon_log("number of valid daemons: $l\n", 7);
452 my ($msg, $msg_hash);
453 my $msg_flag = 0;
455 # collect addresses from possible incoming clients
456 foreach my $host_key (@valid_keys) {
457 eval{
458 daemon_log( "daemon: $host_key\n", 7);
459 my $key_passwd = $known_daemons->{$host_key}->{passwd};
460 daemon_log("daemon_passwd: $key_passwd\n", 7);
461 my $key_cipher = &create_ciphering($key_passwd);
462 $msg = &decrypt_msg($crypted_msg, $key_cipher);
463 daemon_log("daemon decrypted msg:$msg", 7);
464 $msg_hash = $xml->XMLin($msg, ForceArray=>1);
465 };
466 if($@) {
467 daemon_log("msg processing raise error", 7);
468 daemon_log("error string: $@", 7);
469 $msg_flag += 1;
470 } else {
471 last;
472 }
473 }
475 if($msg_flag >= $l) {
476 daemon_log("\nERROR: do not understand the message:\n$msg" , 1);
477 return;
478 }
480 my $header = &get_content_from_xml_hash($msg_hash, "header");
481 my $target = &get_content_from_xml_hash($msg_hash, "target");
483 daemon_log("header from msg:\n\t$header", 1);
484 daemon_log("msg to process:\n\t$msg", 5);
485 daemon_log("msg is for: \n\t$target", 7);
487 if($target eq $bus_address) {
488 # msg is for bus
489 if($header eq 'here_i_am'){ &here_i_am($msg_hash)}
490 elsif($header eq 'confirm_new_passwd'){ &confirm_new_passwd($msg_hash)}
491 elsif($header eq 'got_ping') { &got_ping($msg_hash)}
492 elsif($header eq 'ping') { &ping($msg_hash)}
493 elsif($header eq 'who_has') { &who_has($msg_hash)}
494 elsif($header eq 'new_client') { &new_client($msg_hash)}
495 elsif($header eq 'delete_client') { &delete_client($msg_hash)}
496 } else {
497 # msg is for any other server
498 my @targets = @{$msg_hash->{target}};
499 my $len_targets = @targets;
501 if ($len_targets == 0){
502 # no targets specified
504 daemon_log("ERROR: no target specified for msg $header", 1);
506 } elsif ($targets[0] eq "*"){
507 # all deamons in known_daemons are targets
509 my $target = $targets[0];
510 my $source = @{$msg_hash->{source}}[0];
511 my @target_addresses = keys(%$known_daemons);
512 foreach my $target_address (@target_addresses) {
513 if ($target_address eq $source) { next; }
514 if ($target_address eq $bus_address) { next ; }
515 $msg_hash->{target} = [$target_address];
516 &send_msg_hash2address($msg_hash, $target_address);
517 }
519 } else {
520 # a list of targets is specified
522 my $target_address;
523 foreach $target_address (@targets) {
524 if (exists $known_daemons->{$target_address}) {
525 &send_msg_hash2address($msg_hash, $target_address);
526 } else {
527 my @daemon_addresses = keys %$known_daemons;
528 my $daemon_address;
529 foreach $daemon_address (@daemon_addresses) {
530 if (exists $known_daemons->{$daemon_address}->{clients}->{$target_address}) {
531 my $header = &get_content_from_xml_hash($msg_hash, "header");
532 &send_msg_hash2address($msg_hash, $daemon_address);
533 daemon_log("bus forwards msg $header for client $target_address to server $daemon_address", 3);
534 last;
535 }
536 }
538 }
539 }
540 }
541 }
543 &print_known_daemons_hash();
544 return;
545 }
548 #=== FUNCTION ================================================================
549 # NAME: get_content_of_known_daemons
550 # PARAMETERS:
551 # RETURNS:
552 # DESCRIPTION:
553 #===============================================================================
554 #sub get_content_of_known_daemons {
555 # my ($host, $content) = @_;
556 # return;
557 #}
560 #=== FUNCTION ================================================================
561 # NAME: create_passwd
562 # PARAMETERS: nothing
563 # RETURNS: new_passwd - string
564 # DESCRIPTION: creates a 32 bit long random passwd out of "a".."z","A".."Z",0..9
565 #===============================================================================
566 sub create_passwd {
567 my $new_passwd = "";
568 for(my $i=0; $i<31; $i++) {
569 $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
570 }
571 return $new_passwd;
572 }
575 #=== FUNCTION ================================================================
576 # NAME: create_ciphering
577 # PARAMETERS: passwd - string - used to create ciphering
578 # RETURNS: cipher - object
579 # DESCRIPTION: creates a Crypt::Rijndael::MODE_CBC object with passwd as key
580 #===============================================================================
581 sub create_ciphering {
582 my ($passwd) = @_;
583 $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
584 my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
586 #daemon_log("iv: $iv", 7);
587 #daemon_log("key: $passwd", 7);
588 my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
589 $my_cipher->set_iv($iv);
590 return $my_cipher;
591 }
594 #=== FUNCTION ================================================================
595 # NAME: encrypt_msg
596 # PARAMETERS: msg - string - message to encrypt
597 # my_cipher - ref - reference to a Crypt::Rijndael object
598 # RETURNS: crypted_msg - string - crypted message
599 # DESCRIPTION: crypts the incoming message with the Crypt::Rijndael module
600 #===============================================================================
601 sub encrypt_msg {
602 my ($msg, $my_cipher) = @_;
603 if(not defined $my_cipher) { print "no cipher object\n"; }
604 $msg = "\0"x(16-length($msg)%16).$msg;
605 my $crypted_msg = $my_cipher->encrypt($msg);
606 chomp($crypted_msg = &encode_base64($crypted_msg));
607 return $crypted_msg;
608 }
611 #=== FUNCTION ================================================================
612 # NAME: decrypt_msg
613 # PARAMETERS: crypted_msg - string - message to decrypt
614 # my_cipher - ref - reference to a Crypt::Rijndael object
615 # RETURNS: msg - string - decrypted message
616 # DESCRIPTION: decrypts the incoming message with the Crypt::Rijndael module
617 #===============================================================================
618 sub decrypt_msg {
619 my ($crypted_msg, $my_cipher) = @_ ;
620 $crypted_msg = &decode_base64($crypted_msg);
621 my $msg = $my_cipher->decrypt($crypted_msg);
622 $msg =~ s/^\0*//g;
623 return $msg;
624 }
627 #=== FUNCTION ================================================================
628 # NAME: create_xml_hash
629 # PARAMETERS: header - string - message header (required)
630 # source - string - where the message come from (required)
631 # target - string - where the message should go to (required)
632 # [header_value] - string - something usefull (optional)
633 # RETURNS: hash - hash - nomen est omen
634 # DESCRIPTION: creates a key-value hash, all values are stored in a array
635 #===============================================================================
636 sub create_xml_hash {
637 my ($header, $source, $target, $header_value) = @_ ;
639 if (not defined $header || not defined $source || not defined $target) {
640 daemon_log("ERROR: create_xml_hash function is invoked with uncompleted parameters", 7);
641 }
643 my $hash = {
644 header => [$header],
645 source => [$source],
646 target => [$target],
647 $header => [$header_value],
648 };
649 #daemon_log("create_xml_hash:", 7),
650 #chomp(my $tmp = Dumper $hash);
651 #daemon_log("\t$tmp\n", 7);
652 return $hash
653 }
656 #=== FUNCTION ================================================================
657 # NAME: create_xml_string
658 # PARAMETERS: xml_hash - hash - hash from function create_xml_hash
659 # RETURNS: xml_string - string - xml string representation of the hash
660 # DESCRIPTION: transform the hash to a string using XML::Simple module
661 #===============================================================================
662 sub create_xml_string {
663 my ($xml_hash) = @_ ;
664 my $xml_string = $xml->XMLout($xml_hash, RootName => 'xml');
665 $xml_string =~ s/[\n]+//g;
666 return $xml_string;
667 }
670 #=== FUNCTION ================================================================
671 # NAME: add_content2xml_hash
672 # PARAMETERS: xml_ref - ref - reference to a hash from function create_xml_hash
673 # element - string - key for the hash
674 # content - string - value for the hash
675 # RETURNS: nothing
676 # DESCRIPTION: add key-value pair to xml_ref, if key alread exists, then append value to list
677 #===============================================================================
678 sub add_content2xml_hash {
679 my ($xml_ref, $element, $content) = @_;
680 if(not exists $$xml_ref{$element} ) {
681 $$xml_ref{$element} = [];
682 }
683 my $tmp = $$xml_ref{$element};
684 push(@$tmp, $content);
685 return;
686 }
689 #=== FUNCTION ================================================================
690 # NAME: get_content_from_xml_hash
691 # PARAMETERS: xml_ref - ref - reference of the xml hash
692 # element - string - key of the value you want
693 # RETURNS: value - string - if key is either header, target or source
694 # value - list - for all other keys in xml hash
695 # DESCRIPTION:
696 #===============================================================================
697 sub get_content_from_xml_hash {
698 my ($xml_ref, $element) = @_;
699 my $result = $xml_ref->{$element};
700 if( $element eq "header" || $element eq "target" || $element eq "source") {
701 return @$result[0];
702 }
703 return @$result;
704 }
707 #=== FUNCTION ================================================================
708 # NAME: open_socket
709 # PARAMETERS: PeerAddr - string - something like 192.168.1.1 or 192.168.1.1:10000
710 # [PeerPort] - string - necessary if port not appended by PeerAddr
711 # RETURNS: socket - IO::Socket::INET
712 # DESCRIPTION: open a socket to PeerAddr
713 #===============================================================================
714 sub open_socket {
715 my ($PeerAddr, $PeerPort) = @_ ;
716 if(defined($PeerPort)){
717 $PeerAddr = $PeerAddr.":".$PeerPort;
718 }
719 my $socket;
720 $socket = new IO::Socket::INET(PeerAddr => $PeerAddr ,
721 Porto => "tcp" ,
722 Type => SOCK_STREAM,
723 Reuse => 1,
724 Timeout => 5,
725 );
726 if(not defined $socket) {
727 return;
728 }
729 return $socket;
730 }
733 #=== FUNCTION ================================================================
734 # NAME: read_from_socket
735 # PARAMETERS: socket - fh - filehandel to read from
736 # RETURNS: result - string - readed characters from socket
737 # DESCRIPTION: reads data from socket in 16 byte steps
738 #===============================================================================
739 sub read_from_socket {
740 my ($socket) = @_;
742 $socket->blocking(1);
743 my $result = <$socket>;
744 $socket->blocking(0);
745 my $part_msg;
746 while ($part_msg = <$socket>) {
747 if (not defined $part_msg) { last; }
748 $result .= $part_msg;
749 }
751 #my $result = "";
752 #my $len = 16;
753 #while($len == 16){
754 # my $char;
755 # $len = sysread($socket, $char, 16);
756 # if($len != 16) { last }
757 # if($len != 16) { last }
758 # $result .= $char;
759 #}
760 return $result;
761 }
764 #=== FUNCTION ================================================================
765 # NAME: send_msg_hash2address
766 # PARAMETERS: msg_hash - hash - xml_hash created with function create_xml_hash
767 # PeerAddr string - socket address to send msg
768 # PeerPort string - socket port, if not included in socket address
769 # RETURNS: nothing
770 # DESCRIPTION: ????
771 #===============================================================================
772 sub send_msg_hash2address {
773 my ($msg_hash, $address) = @_ ;
775 # fetch header for logging
776 my $header = &get_content_from_xml_hash($msg_hash, "header");
778 # generate xml string
779 my $msg_xml = &create_xml_string($msg_hash);
781 # fetch the appropriated passwd from hash
782 my $passwd = $known_daemons->{$address}->{passwd};
784 # create a ciphering object
785 my $act_cipher = &create_ciphering($passwd);
787 # encrypt xml msg
788 my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
790 # open socket
791 my $socket = &open_socket($address);
792 if(not defined $socket){
793 daemon_log("ERROR: cannot send '$header'-msg to $address , server not reachable", 1);
794 return;
795 }
797 # send xml msg
798 print $socket $crypted_msg."\n";
800 close $socket;
801 daemon_log("send '$header'-msg to $address", 5);
802 daemon_log("crypted_msg:\n\t$crypted_msg", 7);
803 return;
804 }
807 #=== FUNCTION ================================================================
808 # NAME: send_msg_hash2all
809 # PARAMETERS: msg_hash - hash - xml_hash created with function create_xml_hash
810 # RETURNS: nothing
811 # DESCRIPTION: send msg_hash to all registered daemons
812 #===============================================================================
813 sub send_msg_hash2all {
814 my ($msg_hash) = @_;
816 # fetch header for logging
817 my $header = &get_content_from_xml_hash($msg_hash, "header");
819 # generate xml string
820 my $msg_xml = &create_xml_string($msg_hash);
822 # fetch a list of all target addresses
823 my @targets = keys(%$known_daemons);
825 # itterates through the list an send each the msg
826 foreach my $target (@targets) {
827 if($target eq $bus_address) {next}; # do not send msg to bus
829 # fetch the appropriated passwd
830 my $passwd = $known_daemons->{$target}->{passwd};
832 # create ciphering object
833 my $act_cipher = &create_ciphering($passwd);
835 # encrypt xml msg
836 my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
838 # open socket
839 my $socket = &open_socket($target);
840 if(not defined $socket){
841 daemon_log("ERROR: cannot open socket to $target , server not reachable", 1);
842 &update_known_daemons_entry(hostname=>$target, status=>"down");
843 next;
844 }
846 # send xml msg
847 print $socket $crypted_msg."\n";
849 close $socket;
850 daemon_log("send '$header'-msg to $target", 5);
851 daemon_log("crypted_msg:\n\t$crypted_msg", 7);
852 }
853 return;
854 }
857 #=== FUNCTION ================================================================
858 # NAME: here_i_am
859 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
860 # RETURNS: nothing
861 # DESCRIPTION: process the incoming msg 'here_i_am'
862 #===============================================================================
863 sub here_i_am {
864 my ($msg_hash) = @_ ;
865 my $source = &get_content_from_xml_hash($msg_hash, "source");
867 my $new_passwd = &create_passwd();
869 # create known_daemons entry
870 &create_known_daemons_entry($source);
871 &update_known_daemons_entry(hostname=>$source, status=>"registered", passwd=>$bus_passwd);
873 # create outgoing msg
874 my $out_hash = &create_xml_hash("new_passwd", "$bus_ip:$bus_port", $source, $new_passwd);
875 &send_msg_hash2address($out_hash, $source);
877 # change passwd, reason
878 # &send_msg_hash2address takes $known_daemons->{"$source"}->{passwd} to cipher msg
879 &update_known_daemons_entry(hostname=>$source, status=>"new_passwd", passwd=>$new_passwd);
881 return;
882 }
885 #=== FUNCTION ================================================================
886 # NAME: confirm_new_passwd
887 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
888 # RETURNS: nothing
889 # DESCRIPTION: process this incoming message
890 #===============================================================================
891 sub confirm_new_passwd {
892 my ($msg_hash) = @_ ;
893 my $source = &get_content_from_xml_hash($msg_hash, "source");
894 &update_known_daemons_entry(hostname=>$source, status=>"confirmed_new_passwd");
895 return;
896 }
899 #=== FUNCTION ================================================================
900 # NAME: ping
901 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
902 # RETURNS: nothing
903 # DESCRIPTION: process this incoming message
904 #===============================================================================
905 sub ping {
906 my ($msg_hash) = @_ ;
907 my $source = &get_content_from_xml_hash($msg_hash, "source");
908 &update_known_daemons_entry(hostname=>$source, status=>"ping");
909 my $out_hash = &create_xml_hash("got_ping", $bus_address, $source);
910 &send_msg_hash2address($out_hash, $source);
911 return;
912 }
915 #=== FUNCTION ================================================================
916 # NAME: make ping
917 # PARAMETERS: address - string - address which should be pinged
918 # RETURNS: nothing
919 # DESCRIPTION: send ping message to address
920 #===============================================================================
921 sub make_ping {
922 my ($address) = @_;
923 daemon_log("ping:$address\n", 1);
924 my $out_hash = &create_xml_hash("ping", "$bus_ip:$bus_port", $address);
925 &send_msg_hash2address($out_hash, $address);
926 return;
927 }
930 #=== FUNCTION ================================================================
931 # NAME: got_ping
932 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
933 # RETURNS: nothing
934 # DESCRIPTION: process this incoming message
935 #===============================================================================
936 sub got_ping {
937 my ($msg_hash) = @_;
938 my $source = &get_content_from_xml_hash($msg_hash, "source");
939 &update_known_daemons_entry(hostname=>$source, status=>"got_ping");
940 return;
941 }
944 #=== FUNCTION ================================================================
945 # NAME: new_client
946 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
947 # RETURNS: nothing
948 # DESCRIPTION: process this incoming message
949 #===============================================================================
950 sub new_client {
951 my ($msg_hash) = @_ ;
952 my $source = &get_content_from_xml_hash($msg_hash, "source");
953 my $header = &get_content_from_xml_hash($msg_hash, "header");
954 my $new_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
956 &update_known_daemons_entry(hostname=>$source, client=>$new_client);
957 return;
958 }
961 #=== FUNCTION ================================================================
962 # NAME: delete_client
963 # PARAMETERS: msg_hash - hash - hash from function create_xml_hash
964 # RETURNS: nothing
965 # DESCRIPTION: process this incoming message
966 #===============================================================================
967 sub delete_client {
968 my ($msg_hash) = @_ ;
969 my $source = &get_content_from_xml_hash($msg_hash, "source");
970 my $header = &get_content_from_xml_hash($msg_hash, "header");
971 my $del_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
973 if (not exists $known_daemons->{$source}->{$del_client}) {
974 daemon_log
975 }
976 delete $known_daemons->{$source}->{$del_client};
978 return;
979 }
982 #=== FUNCTION ================================================================
983 # NAME: print_known_daemons_hash
984 # PARAMETERS: nothing
985 # RETURNS: nothing
986 # DESCRIPTION: nome est omen
987 #===============================================================================
988 sub print_known_daemons_hash {
989 my ($tmp) = @_;
990 print "####################################\n";
991 print "# status of known_daemons\n";
992 my $hosts;
993 my $host_hash;
994 $shmkh->shlock(LOCK_EX);
995 my @hosts = keys %$known_daemons;
996 foreach my $host (@hosts) {
997 my $status = $known_daemons->{$host}->{status} ;
998 my $passwd = $known_daemons->{$host}->{passwd};
999 my $timestamp = $known_daemons->{$host}->{timestamp};
1000 my @clients = keys %{$known_daemons->{$host}->{clients}};
1001 my $client_string = join(", ", @clients);
1002 print "$host\n";
1003 print "\tstatus: $status\n";
1004 print "\tpasswd: $passwd\n";
1005 print "\ttimestamp: $timestamp\n";
1006 print "\tclients: $client_string\n";
1008 }
1009 $shmkh->shunlock(LOCK_EX);
1010 print "####################################\n\n";
1011 return;
1012 }
1015 #=== FUNCTION ================================================================
1016 # NAME: create_known_daemons_entry
1017 # PARAMETERS: hostname - string - ip address and port of host
1018 # RETURNS: nothing
1019 # DESCRIPTION: nome est omen
1020 #===============================================================================
1021 sub create_known_daemons_entry {
1022 my ($hostname) = @_;
1023 $shmkh->shlock(LOCK_EX);
1024 $known_daemons->{$hostname} = {};
1025 $known_daemons->{$hostname}->{status} = "none";
1026 $known_daemons->{$hostname}->{passwd} = "none";
1027 $known_daemons->{$hostname}->{timestamp} = "none";
1028 $known_daemons->{$hostname}->{clients} = {};
1029 $shmkh->shunlock(LOCK_EX);
1030 return;
1031 }
1034 #=== FUNCTION ================================================================
1035 # NAME: update_known_daemons_entry
1036 # PARAMETERS: hostname - string - ip address and port of host (required)
1037 # status - string - (optional)
1038 # passwd - string - (optional)
1039 # client - string - ip address and port of client (optional)
1040 # RETURNS: nothing
1041 # DESCRIPTION: nome est omen and updates each time the timestamp of hostname
1042 #===============================================================================
1043 sub update_known_daemons_entry {
1044 my $arg = {
1045 hostname => undef, status => undef, passwd => undef,
1046 client => undef,
1047 @_ };
1048 my $hostname = $arg->{hostname};
1049 my $status = $arg->{status};
1050 my $passwd = $arg->{passwd};
1051 my $client = $arg->{client};
1053 if (not defined $hostname) {
1054 daemon_log("ERROR: function add_content2known_daemons is not invoked with requiered parameter 'hostname'", 1);
1055 return;
1056 }
1058 my ($seconds, $minutes, $hours, $monthday, $month,
1059 $year, $weekday, $yearday, $sommertime) = localtime(time);
1060 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
1061 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
1062 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
1063 $month+=1;
1064 $month = $month < 10 ? $month = "0".$month : $month;
1065 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
1066 $year+=1900;
1067 my $t = "$year$month$monthday$hours$minutes$seconds";
1069 $shmkh->shlock(LOCK_EX);
1070 if (defined $status) {
1071 $known_daemons->{$hostname}->{status} = $status;
1072 }
1073 if (defined $passwd) {
1074 $known_daemons->{$hostname}->{passwd} = $passwd;
1075 }
1076 if (defined $client) {
1077 $known_daemons->{$hostname}->{clients}->{$client} = "";
1078 }
1079 $known_daemons->{$hostname}->{timestamp} = $t;
1080 $shmkh->shunlock(LOCK_EX);
1081 return;
1082 }
1085 #==== MAIN = main ==============================================================
1087 # parse commandline options
1088 Getopt::Long::Configure( "bundling" );
1089 GetOptions("h|help" => \&usage,
1090 "c|config=s" => \$cfg_file,
1091 "f|foreground" => \$foreground,
1092 "v|verbose+" => \$verbose,
1093 );
1095 # read and set config parameters
1096 &check_cmdline_param ;
1097 &read_configfile;
1098 &check_pid;
1100 $SIG{CHLD} = 'IGNORE';
1102 # restart daemon log file
1103 if(-e $log_file ) { unlink $log_file }
1104 daemon_log("$0 started!");
1106 # Just fork, if we"re not in foreground mode
1107 if( ! $foreground ) { $pid = fork(); }
1108 else { $pid = $$; }
1110 # Do something useful - put our PID into the pid_file
1111 if( 0 != $pid ) {
1112 open( LOCK_FILE, ">$pid_file" );
1113 print LOCK_FILE "$pid\n";
1114 close( LOCK_FILE );
1115 if( !$foreground ) { exit( 0 ) };
1116 }
1118 # detect own ip and mac address
1119 ($bus_ip, $bus_mac_address) = &get_ip_and_mac();
1120 if (not defined $bus_ip) {
1121 die "EXIT: ip address of $0 could not be detected";
1122 }
1123 daemon_log("bus ip address detected: $bus_ip", 1);
1124 daemon_log("bus mac address detected: $bus_mac_address", 1);
1127 # setup xml parser
1128 $xml = new XML::Simple();
1130 # create cipher object
1131 $bus_cipher = &create_ciphering($bus_passwd);
1132 $bus_address = "$bus_ip:$bus_port";
1134 # create reading and writing vectors
1135 my $rbits = my $wbits = my $ebits = "";
1137 # open the bus socket
1138 if($bus_activ eq "on") {
1139 $bus = IO::Socket::INET->new(LocalPort => $bus_port,
1140 Type => SOCK_STREAM,
1141 Reuse => 1,
1142 Listen => 20,
1143 ) or die "kann kein TCP-Server an Port $bus_port sein: $@\n";
1144 vec($rbits, fileno $bus, 1) = 1;
1145 vec($wbits, fileno $bus, 1) = 1;
1146 print "start bus at $bus_ip:$bus_port\n";
1147 }
1149 # add bus to known_daemons
1150 &create_known_daemons_entry($bus_address);
1151 &update_known_daemons_entry(hostname=>$bus_address, status=>"bus", passwd=>$bus_passwd);
1154 while(1) {
1155 my $nf = select($rbits, $wbits, undef, undef);
1156 # error handling
1157 if($nf < 0 ) {
1158 }
1160 # something is coming in
1161 if(vec $rbits, fileno $bus, 1 ) {
1162 my $client = $bus->accept();
1163 my $other_end = getpeername($client);
1164 if(not defined $other_end) {
1165 daemon_log("Gegenstelle konnte nicht identifiziert werden: $!\n");
1166 } else {
1167 my ($port, $iaddr) = unpack_sockaddr_in($other_end);
1168 my $actual_ip = inet_ntoa($iaddr);
1169 daemon_log("\naccept client from $actual_ip\n", 5);
1170 my $in_msg = &read_from_socket($client);
1171 if(defined $in_msg){
1172 &activating_child($in_msg, $actual_ip);
1173 } else {
1174 daemon_log("cannot read from $actual_ip\n",1);
1175 }
1176 }
1177 close($client);
1178 }
1180 }