contrib/daemon/gosa-sd-bus

   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 #===============================================================================
  20
  21 use strict;
  22 use warnings;
  23 use Getopt::Long;
  24 use Config::IniFiles;
  25 use POSIX;
  26 use Time::HiRes qw( gettimeofday );
  27
  28 use IO::Socket::INET;
  29 use Crypt::CBC;
  30 use Digest::MD5  qw(md5 md5_hex md5_base64);
  31 use XML::Simple;
  32 use Data::Dumper;
  33 use Sys::Syslog qw( :DEFAULT setlogsock);
  34 use Cwd;
  35 use File::Spec;
  36 use IPC::Shareable qw( :lock);
  37 IPC::Shareable->clean_up_all;
  38
  39 my ($cfg_file, $default_cfg_file, %cfg_defaults, $foreground, $verbose);
  40 my ($bus_activ, $bus_passwd, $bus_ip, $bus_port, $bus_address, $bus, $bus_mac_address);
  41 my ($pid_file, $procid, $pid, $log_file, $my_own_address);
  42 my (%free_child, %busy_child, $child_max, $child_min, %child_alive_time, $child_timeout);
  43 my ($xml, $bus_cipher, $known_daemons, $shmkh);
  44
  45 $foreground = 0 ;
  46 $known_daemons = {};
  47 $shmkh = tie($known_daemons, 'IPC::Shareable', undef, {create => 1,
  48                                                             exclusive => 1,
  49                                                             mode => 0666,
  50                                                             destroy => 1,
  51                                                             });
  52 %cfg_defaults =
  53 ("general" =>
  54     {"log_file" => [\$log_file, "/var/run/".$0.".log"],
  55     "pid_file" => [\$pid_file, "/var/run/".$0.".pid"],
  56     "child_max" => [\$child_max, 10],
  57     "child_min" => [\$child_min, 3],
  58     "child_timeout" => [\$child_timeout, 180],
  59
  60     },
  61 "bus" =>
  62     {"bus_activ" => [\$bus_activ, "on"],
  63     "bus_passwd" => [\$bus_passwd, "tester"],
  64     "bus_port" => [\$bus_port, "10001"],
  65     }
  66     );
  67
  68 #===  FUNCTION  ================================================================
  69 #         NAME:  read_configfile
  70 #   PARAMETERS:  cfg_file - string -
  71 #      RETURNS:  nothing
  72 #  DESCRIPTION:  read cfg_file and set variables
  73 #===============================================================================
  74 sub read_configfile {
  75     my $cfg;
  76     if( defined( $cfg_file) && ( length($cfg_file) > 0 )) {
  77         if( -r $cfg_file ) {
  78             $cfg = Config::IniFiles->new( -file => $cfg_file );
  79         } else {
  80             print STDERR "Couldn't read config file!";
  81         }
  82     } else {
  83         $cfg = Config::IniFiles->new() ;
  84     }
  85     foreach my $section (keys %cfg_defaults) {
  86         foreach my $param (keys %{$cfg_defaults{ $section }}) {
  87             my $pinfo = $cfg_defaults{ $section }{ $param };
  88             ${@$pinfo[ 0 ]} = $cfg->val( $section, $param, @$pinfo[ 1 ] );
  89         }
  90     }
  91 }
  92
  93 #===  FUNCTION  ================================================================
  94 #         NAME:  logging
  95 #   PARAMETERS:  level - string - default 'info'
  96 #                msg - string -
  97 #                facility - string - default 'LOG_DAEMON'
  98 #      RETURNS:  nothing
  99 #  DESCRIPTION:  function for logging
 100 #===============================================================================
 101 sub daemon_log {
 102     my( $msg, $level ) = @_;
 103     if(not defined $msg) { return }
 104     if(not defined $level) { $level = 1 }
 105     if(defined $log_file){
 106         open(LOG_HANDLE, ">>$log_file");
 107         if(not defined open( LOG_HANDLE, ">>$log_file" )) {
 108             print STDERR "cannot open $log_file: $!";
 109             return }
 110         chomp($msg);
 111         if($level <= $verbose){
 112             print LOG_HANDLE $msg."\n";
 113             if(defined $foreground) { print $msg."\n" }
 114         }
 115     }
 116     close( LOG_HANDLE );
 117 #    my ($msg, $level, $facility) = @_;
 118 #    if(not defined $msg) {return}
 119 #    if(not defined $level) {$level = "info"}
 120 #    if(not defined $facility) {$facility = "LOG_DAEMON"}
 121 #    openlog($0, "pid,cons,", $facility);
 122 #    syslog($level, $msg);
 123 #    closelog;
 124 #    return;
 125 }
 126
 127 #===  FUNCTION  ================================================================
 128 #         NAME:  check_cmdline_param
 129 #   PARAMETERS:  nothing
 130 #      RETURNS:  nothing
 131 #  DESCRIPTION:  validates commandline parameter
 132 #===============================================================================
 133 sub check_cmdline_param () {
 134     my $err_config;
 135     my $err_counter = 0;
 136     if( not defined( $cfg_file)) {
 137         my $cwd = getcwd;
 138         my $name = "gosa-sd-bus.cfg";
 139         $cfg_file = File::Spec->catfile( $cwd, $name );
 140         print STDERR "no conf file specified\n   try to use default: $cfg_file\n";
 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 }
 149
 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     }
 174
 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 }
 197
 198
 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]
 208
 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 }
 216
 217
 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;
 235
 236
 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 }
 261
 262
 263
 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 }
 279
 280
 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         }
 299
 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     }
 311
 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);
 324
 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     }
 335
 336     # no free child, try to fork another one
 337     if($free_len + $busy_len < $child_max) {
 338
 339         daemon_log("not enough children, create a new one\n",5);
 340
 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);
 348
 349         ############
 350         # fork child
 351         ############
 352         my $child_pid = fork();
 353
 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;
 362
 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                 }
 378
 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                     }
 389
 390                     # forward the job msg to another function
 391                     &process_incoming_msg($msg);
 392                     daemon_log("processing of msg finished", 5);
 393
 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);
 401
 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                     );
 413
 414             $child = \%child_hash;
 415             $busy_child{$$child{'pid'}} = $child;
 416             return $child;
 417         }
 418     }
 419 }
 420
 421
 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);
 437
 438     daemon_log("msg from host:\n\t$host", 1);
 439     daemon_log("crypted_msg:\n\t$crypted_msg", 7);
 440
 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     }
 448
 449     my $l = @valid_keys;
 450     daemon_log("number of valid daemons: $l\n", 7);
 451
 452     my ($msg, $msg_hash);
 453     my $msg_flag = 0;
 454
 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     }
 474
 475     if($msg_flag >= $l)  {
 476         daemon_log("\nERROR: do not understand the message:\n\t$msg" , 1);
 477         return;
 478     }
 479
 480     my $header = &get_content_from_xml_hash($msg_hash, "header");
 481     my $target = &get_content_from_xml_hash($msg_hash, "target");
 482
 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);
 486
 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;
 500
 501         if ($len_targets == 0){
 502             # no targets specified
 503
 504             daemon_log("ERROR: no target specified for msg $header", 1);
 505
 506         } elsif ($targets[0] eq "*"){
 507             # all deamons in known_daemons are targets
 508
 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             }
 518
 519         } else {
 520             # a list of targets is specified
 521
 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                     }
 537
 538                 }
 539             }
 540         }
 541     }
 542
 543     &print_known_daemons_hash();
 544     return;
 545 }
 546
 547
 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 #}
 558
 559
 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 }
 573
 574
 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("$passwd" x 32, 0, 32);
 584     daemon_log("create_ciphering: new passwd: $passwd", 7);
 585
 586     my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
 587
 588     my $my_cipher = Crypt::CBC->new(-key=>$passwd ,
 589                                     -cipher => 'Rijndael',
 590                                     -iv => $iv,
 591                                     -header => "none",
 592                                     );
 593     return $my_cipher;
 594 }
 595
 596
 597 #===  FUNCTION  ================================================================
 598 #         NAME:  encrypt_msg
 599 #   PARAMETERS:  msg - string - message to encrypt
 600 #                my_cipher - ref - reference to a Crypt::Rijndael object
 601 #      RETURNS:  crypted_msg - string - crypted message
 602 #  DESCRIPTION:  crypts the incoming message with the Crypt::Rijndael module
 603 #===============================================================================
 604 sub encrypt_msg {
 605     my ($msg, $my_cipher) = @_;
 606     if(not defined $my_cipher) { print "no cipher object\n"; }
 607
 608     my $crypted_msg = $my_cipher->encrypt($msg);
 609
 610     return $crypted_msg;
 611 }
 612
 613
 614 #===  FUNCTION  ================================================================
 615 #         NAME:  decrypt_msg
 616 #   PARAMETERS:  crypted_msg - string - message to decrypt
 617 #                my_cipher - ref - reference to a Crypt::Rijndael object
 618 #      RETURNS:  msg - string - decrypted message
 619 #  DESCRIPTION:  decrypts the incoming message with the Crypt::Rijndael module
 620 #===============================================================================
 621 sub decrypt_msg {
 622     my ($crypted_msg, $my_cipher) = @_ ;
 623     my $msg = $my_cipher->decrypt($crypted_msg);
 624     return $msg;
 625 }
 626
 627
 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) = @_ ;
 639
 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     }
 643
 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 }
 655
 656
 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 }
 669
 670
 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 }
 688
 689
 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 }
 706
 707
 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 }
 732
 733
 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) = @_;
 742     my $result = "";
 743     my $len = 16;
 744     while($len == 16){
 745         my $char;
 746         $len = sysread($socket, $char, 16);
 747         if($len != 16) { last }
 748         if($len != 16) { last }
 749         $result .= $char;
 750     }
 751     return $result;
 752 }
 753
 754
 755 #===  FUNCTION  ================================================================
 756 #         NAME:  send_msg_hash2address
 757 #   PARAMETERS:  msg_hash - hash - xml_hash created with function create_xml_hash
 758 #                PeerAddr string - socket address to send msg
 759 #                PeerPort string - socket port, if not included in socket address
 760 #      RETURNS:  nothing
 761 #  DESCRIPTION:  ????
 762 #===============================================================================
 763 sub send_msg_hash2address {
 764     my ($msg_hash, $address) = @_ ;
 765
 766     # fetch header for logging
 767     my $header = &get_content_from_xml_hash($msg_hash, "header");
 768
 769     # generate xml string
 770     my $msg_xml = &create_xml_string($msg_hash);
 771
 772     # fetch the appropriated passwd from hash
 773     my $passwd = $known_daemons->{$address}->{passwd};
 774
 775     # create a ciphering object
 776     my $act_cipher = &create_ciphering($passwd);
 777
 778     # encrypt xml msg
 779     my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
 780
 781     # open socket
 782     my $socket = &open_socket($address);
 783     if(not defined $socket){
 784         daemon_log("ERROR: cannot send '$header'-msg to $address , server not reachable", 1);
 785         return;
 786     }
 787
 788     # send xml msg
 789     print $socket $crypted_msg."\n";
 790
 791     close $socket;
 792     daemon_log("send '$header'-msg to $address", 5);
 793     daemon_log("crypted_msg:\n\t$crypted_msg", 7);
 794     return;
 795 }
 796
 797
 798 #===  FUNCTION  ================================================================
 799 #         NAME:  send_msg_hash2all
 800 #   PARAMETERS:  msg_hash - hash - xml_hash created with function create_xml_hash
 801 #      RETURNS:  nothing
 802 #  DESCRIPTION:  send msg_hash to all registered daemons
 803 #===============================================================================
 804 sub send_msg_hash2all {
 805     my ($msg_hash) = @_;
 806
 807     # fetch header for logging
 808     my $header = &get_content_from_xml_hash($msg_hash, "header");
 809
 810     # generate xml string
 811     my $msg_xml = &create_xml_string($msg_hash);
 812
 813     # fetch a list of all target addresses
 814     my @targets = keys(%$known_daemons);
 815
 816     # itterates through the list an send each the msg
 817     foreach my $target (@targets) {
 818         if($target eq $bus_address) {next};   # do not send msg to bus
 819
 820         # fetch the appropriated passwd
 821         my $passwd = $known_daemons->{$target}->{passwd};
 822
 823         # create ciphering object
 824         my $act_cipher = &create_ciphering($passwd);
 825
 826         # encrypt xml msg
 827         my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
 828
 829         # open socket
 830         my $socket = &open_socket($target);
 831         if(not defined $socket){
 832             daemon_log("ERROR: cannot open socket to $target , server not reachable", 1);
 833             &update_known_daemons_entry(hostname=>$target, status=>"down");
 834             next;
 835         }
 836
 837         # send xml msg
 838         print $socket $crypted_msg."\n";
 839
 840         close $socket;
 841         daemon_log("send '$header'-msg to $target", 5);
 842         daemon_log("crypted_msg:\n\t$crypted_msg", 7);
 843     }
 844     return;
 845 }
 846
 847
 848 #===  FUNCTION  ================================================================
 849 #         NAME:  here_i_am
 850 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 851 #      RETURNS:  nothing
 852 #  DESCRIPTION:  process the incoming msg 'here_i_am'
 853 #===============================================================================
 854 sub here_i_am {
 855     my ($msg_hash) = @_ ;
 856     my $source = &get_content_from_xml_hash($msg_hash, "source");
 857
 858     my $new_passwd = &create_passwd();
 859
 860     # create known_daemons entry
 861     &create_known_daemons_entry($source);
 862     &update_known_daemons_entry(hostname=>$source, status=>"registered", passwd=>$bus_passwd);
 863
 864     # create outgoing msg
 865     my $out_hash = &create_xml_hash("new_passwd", "$bus_ip:$bus_port", $source, $new_passwd);
 866     &send_msg_hash2address($out_hash, $source);
 867
 868     # change passwd, reason
 869     # &send_msg_hash2address takes $known_daemons->{"$source"}->{passwd} to cipher msg
 870     &update_known_daemons_entry(hostname=>$source, status=>"new_passwd", passwd=>$new_passwd);
 871
 872     return;
 873 }
 874
 875
 876 #===  FUNCTION  ================================================================
 877 #         NAME:  confirm_new_passwd
 878 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 879 #      RETURNS:  nothing
 880 #  DESCRIPTION:  process this incoming message
 881 #===============================================================================
 882 sub confirm_new_passwd {
 883     my ($msg_hash) = @_ ;
 884     my $source = &get_content_from_xml_hash($msg_hash, "source");
 885     &update_known_daemons_entry(hostname=>$source, status=>"confirmed_new_passwd");
 886     return;
 887 }
 888
 889
 890 #===  FUNCTION  ================================================================
 891 #         NAME:  ping
 892 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 893 #      RETURNS:  nothing
 894 #  DESCRIPTION:  process this incoming message
 895 #===============================================================================
 896 sub ping {
 897     my ($msg_hash) = @_ ;
 898     my $source = &get_content_from_xml_hash($msg_hash, "source");
 899     &update_known_daemons_entry(hostname=>$source, status=>"ping");
 900     my $out_hash = &create_xml_hash("got_ping", $bus_address, $source);
 901     &send_msg_hash2address($out_hash, $source);
 902     return;
 903 }
 904
 905
 906 #===  FUNCTION  ================================================================
 907 #         NAME:  make ping
 908 #   PARAMETERS:  address - string - address which should be pinged
 909 #      RETURNS:  nothing
 910 #  DESCRIPTION:  send ping message to address
 911 #===============================================================================
 912 sub make_ping {
 913     my ($address) = @_;
 914     daemon_log("ping:$address\n", 1);
 915     my $out_hash = &create_xml_hash("ping", "$bus_ip:$bus_port", $address);
 916     &send_msg_hash2address($out_hash, $address);
 917     return;
 918 }
 919
 920
 921 #===  FUNCTION  ================================================================
 922 #         NAME:  got_ping
 923 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 924 #      RETURNS:  nothing
 925 #  DESCRIPTION:  process this incoming message
 926 #===============================================================================
 927 sub got_ping {
 928     my ($msg_hash) = @_;
 929     my $source = &get_content_from_xml_hash($msg_hash, "source");
 930     &update_known_daemons_entry(hostname=>$source, status=>"got_ping");
 931     return;
 932 }
 933
 934
 935 #===  FUNCTION  ================================================================
 936 #         NAME:  new_client
 937 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 938 #      RETURNS:  nothing
 939 #  DESCRIPTION:  process this incoming message
 940 #===============================================================================
 941 sub new_client {
 942     my ($msg_hash) = @_ ;
 943     my $source = &get_content_from_xml_hash($msg_hash, "source");
 944     my $header = &get_content_from_xml_hash($msg_hash, "header");
 945     my $new_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
 946
 947     &update_known_daemons_entry(hostname=>$source, client=>$new_client);
 948     return;
 949 }
 950
 951
 952 #===  FUNCTION  ================================================================
 953 #         NAME:  delete_client
 954 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 955 #      RETURNS:  nothing
 956 #  DESCRIPTION:  process this incoming message
 957 #===============================================================================
 958 sub delete_client {
 959     my ($msg_hash) = @_ ;
 960     my $source = &get_content_from_xml_hash($msg_hash, "source");
 961     my $header = &get_content_from_xml_hash($msg_hash, "header");
 962     my $del_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
 963
 964     print Dumper $msg_hash;
 965
 966     if (not exists $known_daemons->{$source}->{$del_client}) {
 967         daemon_log
 968     }
 969     delete $known_daemons->{$source}->{$del_client};
 970
 971     return;
 972 }
 973
 974
 975 #===  FUNCTION  ================================================================
 976 #         NAME:  print_known_daemons_hash
 977 #   PARAMETERS:  nothing
 978 #      RETURNS:  nothing
 979 #  DESCRIPTION:  nome est omen
 980 #===============================================================================
 981 sub print_known_daemons_hash {
 982     my ($tmp) = @_;
 983     print "####################################\n";
 984     print "# status of known_daemons\n";
 985     my $hosts;
 986     my $host_hash;
 987     $shmkh->shlock(LOCK_EX);
 988     my @hosts = keys %$known_daemons;
 989     foreach my $host (@hosts) {
 990         my $status = $known_daemons->{$host}->{status} ;
 991         my $passwd = $known_daemons->{$host}->{passwd};
 992         my $timestamp = $known_daemons->{$host}->{timestamp};
 993         my @clients = keys %{$known_daemons->{$host}->{clients}};
 994         my $client_string = join(", ", @clients);
 995         print "$host\n";
 996         print "\tstatus:    $status\n";
 997         print "\tpasswd:    $passwd\n";
 998         print "\ttimestamp: $timestamp\n";
 999         print "\tclients:   $client_string\n";
1000
1001     }
1002     $shmkh->shunlock(LOCK_EX);
1003     print "####################################\n\n";
1004     return;
1005 }
1006
1007
1008 #===  FUNCTION  ================================================================
1009 #         NAME:  create_known_daemons_entry
1010 #   PARAMETERS:  hostname - string - ip address and port of host
1011 #      RETURNS:  nothing
1012 #  DESCRIPTION:  nome est omen
1013 #===============================================================================
1014 sub create_known_daemons_entry {
1015     my ($hostname) = @_;
1016     $shmkh->shlock(LOCK_EX);
1017     $known_daemons->{$hostname} = {};
1018     $known_daemons->{$hostname}->{status} = "none";
1019     $known_daemons->{$hostname}->{passwd} = "none";
1020     $known_daemons->{$hostname}->{timestamp} = "none";
1021     $known_daemons->{$hostname}->{clients} = {};
1022     $shmkh->shunlock(LOCK_EX);
1023     return;
1024 }
1025
1026
1027 #===  FUNCTION  ================================================================
1028 #         NAME:  update_known_daemons_entry
1029 #   PARAMETERS:  hostname - string - ip address and port of host (required)
1030 #                status - string - (optional)
1031 #                passwd - string - (optional)
1032 #                client - string - ip address and port of client (optional)
1033 #      RETURNS:  nothing
1034 #  DESCRIPTION:  nome est omen and updates each time the timestamp of hostname
1035 #===============================================================================
1036 sub update_known_daemons_entry {
1037     my $arg = {
1038         hostname => undef, status => undef, passwd => undef,
1039         client => undef,
1040         @_ };
1041     my $hostname = $arg->{hostname};
1042     my $status = $arg->{status};
1043     my $passwd = $arg->{passwd};
1044     my $client = $arg->{client};
1045
1046     if (not defined $hostname) {
1047         daemon_log("ERROR: function add_content2known_daemons is not invoked with requiered parameter 'hostname'", 1);
1048         return;
1049     }
1050
1051     my ($seconds, $minutes, $hours, $monthday, $month,
1052     $year, $weekday, $yearday, $sommertime) = localtime(time);
1053     $hours = $hours < 10 ? $hours = "0".$hours : $hours;
1054     $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
1055     $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
1056     $month+=1;
1057     $month = $month < 10 ? $month = "0".$month : $month;
1058     $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
1059     $year+=1900;
1060     my $t = "$year$month$monthday$hours$minutes$seconds";
1061
1062     $shmkh->shlock(LOCK_EX);
1063     if (defined $status) {
1064         $known_daemons->{$hostname}->{status} = $status;
1065     }
1066     if (defined $passwd) {
1067         $known_daemons->{$hostname}->{passwd} = $passwd;
1068     }
1069     if (defined $client) {
1070         $known_daemons->{$hostname}->{clients}->{$client} = "";
1071     }
1072     $known_daemons->{$hostname}->{timestamp} = $t;
1073     $shmkh->shunlock(LOCK_EX);
1074     return;
1075 }
1076
1077
1078 #==== MAIN = main ==============================================================
1079
1080 #  parse commandline options
1081 Getopt::Long::Configure( "bundling" );
1082 GetOptions("h|help" => \&usage,
1083            "c|config=s" => \$cfg_file,
1084            "f|foreground" => \$foreground,
1085            "v|verbose+" => \$verbose,
1086            );
1087
1088 #  read and set config parameters
1089 &check_cmdline_param ;
1090 &read_configfile;
1091 &check_pid;
1092
1093 $SIG{CHLD} = 'IGNORE';
1094
1095 # restart daemon log file
1096 if(-e $log_file ) { unlink $log_file }
1097 daemon_log("$0 started!");
1098
1099 # Just fork, if we"re not in foreground mode
1100 if( ! $foreground ) { $pid = fork(); }
1101 else { $pid = $$; }
1102
1103 # Do something useful - put our PID into the pid_file
1104 if( 0 != $pid ) {
1105     open( LOCK_FILE, ">$pid_file" );
1106     print LOCK_FILE "$pid\n";
1107     close( LOCK_FILE );
1108     if( !$foreground ) { exit( 0 ) };
1109 }
1110
1111 # detect own ip and mac address
1112 ($bus_ip, $bus_mac_address) = &get_ip_and_mac();
1113 if (not defined $bus_ip) {
1114     die "EXIT: ip address of $0 could not be detected";
1115 }
1116 daemon_log("bus ip address detected: $bus_ip", 1);
1117 daemon_log("bus mac address detected: $bus_mac_address", 1);
1118
1119
1120 # setup xml parser
1121 $xml = new XML::Simple();
1122
1123 # create cipher object
1124 $bus_cipher = &create_ciphering($bus_passwd);
1125 $bus_address = "$bus_ip:$bus_port";
1126
1127 # create reading and writing vectors
1128 my $rbits = my $wbits = my $ebits = "";
1129
1130 # open the bus socket
1131 if($bus_activ eq "on") {
1132     $bus = IO::Socket::INET->new(LocalPort => $bus_port,
1133             Type => SOCK_STREAM,
1134             Reuse => 1,
1135             Listen => 20,
1136             ) or die "kann kein TCP-Server an Port $bus_port sein: $@\n";
1137     vec($rbits, fileno $bus, 1) = 1;
1138     vec($wbits, fileno $bus, 1) = 1;
1139     print "start bus at $bus_ip:$bus_port\n";
1140 }
1141
1142 # add bus to known_daemons
1143 &create_known_daemons_entry($bus_address);
1144 &update_known_daemons_entry(hostname=>$bus_address, status=>"bus", passwd=>$bus_passwd);
1145
1146
1147 while(1) {
1148     my $nf = select($rbits, $wbits, undef, undef);
1149     # error handling
1150     if($nf < 0 ) {
1151     }
1152
1153     # something is coming in
1154     if(vec $rbits, fileno $bus, 1 ) {
1155         my $client = $bus->accept();
1156         my $other_end = getpeername($client);
1157         if(not defined $other_end) {
1158             daemon_log("Gegenstelle konnte nicht identifiziert werden: $!\n");
1159         } else {
1160             my ($port, $iaddr) = unpack_sockaddr_in($other_end);
1161             my $actual_ip = inet_ntoa($iaddr);
1162             daemon_log("\naccept client from $actual_ip\n", 5);
1163             my $in_msg = &read_from_socket($client);
1164             if(defined $in_msg){
1165                 &activating_child($in_msg, $actual_ip);
1166             } else {
1167                 daemon_log("cannot read from $actual_ip\n",1);
1168             }
1169         }
1170         close($client);
1171     }
1172
1173 }
1174
1175