gosa-si/gosa-si-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::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;
  39
  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);
  45
  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],
  60
  61     },
  62 "bus" =>
  63     {"bus_activ" => [\$bus_activ, "on"],
  64     "bus_passwd" => [\$bus_passwd, ""],
  65     "bus_port" => [\$bus_port, "20080"],
  66     }
  67     );
  68
  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 }
  93
  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 }
 127
 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 }
 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: $host", 1);
 439     daemon_log("crypted_msg: $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", 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", 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$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: $header", 1);
 484     daemon_log("msg to process: $msg", 5);
 485     daemon_log("msg is for: $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(md5_hex("$passwd") x 32, 0, 32);
 584     my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
 585
 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 }
 592
 593
 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 }
 609
 610
 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 }
 625
 626
 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) = @_ ;
 638
 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     }
 642
 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 }
 654
 655
 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 }
 668
 669
 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 }
 687
 688
 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 }
 705
 706
 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 }
 731
 732
 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) = @_;
 741
 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     }
 750
 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 }
 762
 763
 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) = @_ ;
 774
 775     # fetch header for logging
 776     my $header = &get_content_from_xml_hash($msg_hash, "header");
 777
 778     # generate xml string
 779     my $msg_xml = &create_xml_string($msg_hash);
 780
 781     # fetch the appropriated passwd from hash
 782     my $passwd = $known_daemons->{$address}->{passwd};
 783
 784     # create a ciphering object
 785     my $act_cipher = &create_ciphering($passwd);
 786
 787     # encrypt xml msg
 788     my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
 789
 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     }
 796
 797     # send xml msg
 798     print $socket $crypted_msg."\n";
 799
 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 }
 805
 806
 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) = @_;
 815
 816     # fetch header for logging
 817     my $header = &get_content_from_xml_hash($msg_hash, "header");
 818
 819     # generate xml string
 820     my $msg_xml = &create_xml_string($msg_hash);
 821
 822     # fetch a list of all target addresses
 823     my @targets = keys(%$known_daemons);
 824
 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
 828
 829         # fetch the appropriated passwd
 830         my $passwd = $known_daemons->{$target}->{passwd};
 831
 832         # create ciphering object
 833         my $act_cipher = &create_ciphering($passwd);
 834
 835         # encrypt xml msg
 836         my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
 837
 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         }
 845
 846         # send xml msg
 847         print $socket $crypted_msg."\n";
 848
 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 }
 855
 856
 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");
 866
 867     my $new_passwd = &create_passwd();
 868
 869     # create known_daemons entry
 870     &create_known_daemons_entry($source);
 871     &update_known_daemons_entry(hostname=>$source, status=>"registered", passwd=>$bus_passwd);
 872
 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);
 876
 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);
 880
 881     return;
 882 }
 883
 884
 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 }
 897
 898
 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 }
 913
 914
 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 }
 928
 929
 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 }
 942
 943
 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];
 955
 956     &update_known_daemons_entry(hostname=>$source, client=>$new_client);
 957     return;
 958 }
 959
 960
 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];
 972
 973     if (not exists $known_daemons->{$source}->{$del_client}) {
 974         daemon_log
 975     }
 976     delete $known_daemons->{$source}->{$del_client};
 977
 978     return;
 979 }
 980
 981
 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";
1007
1008     }
1009     $shmkh->shunlock(LOCK_EX);
1010     print "####################################\n\n";
1011     return;
1012 }
1013
1014
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 }
1032
1033
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};
1052
1053     if (not defined $hostname) {
1054         daemon_log("ERROR: function add_content2known_daemons is not invoked with requiered parameter 'hostname'", 1);
1055         return;
1056     }
1057
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";
1068
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 }
1083
1084
1085 #==== MAIN = main ==============================================================
1086
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            );
1094
1095 #  read and set config parameters
1096 &check_cmdline_param ;
1097 &read_configfile;
1098 &check_pid;
1099
1100 $SIG{CHLD} = 'IGNORE';
1101
1102 # restart daemon log file
1103 if(-e $log_file ) { unlink $log_file }
1104 daemon_log(" ", 1);
1105 daemon_log("$0 started!", 1);
1106
1107 # Just fork, if we"re not in foreground mode
1108 if( ! $foreground ) { $pid = fork(); }
1109 else { $pid = $$; }
1110
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 }
1118
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);
1126
1127
1128 # setup xml parser
1129 $xml = new XML::Simple();
1130
1131 # create cipher object
1132 $bus_cipher = &create_ciphering($bus_passwd);
1133 $bus_address = "$bus_ip:$bus_port";
1134
1135 # create reading and writing vectors
1136 my $rbits = my $wbits = my $ebits = "";
1137
1138 # open the bus socket
1139 if($bus_activ eq "on") {
1140     daemon_log(" ", 1);
1141     $bus = IO::Socket::INET->new(LocalPort => $bus_port,
1142             Type => SOCK_STREAM,
1143             Reuse => 1,
1144             Listen => 20,
1145             ) or die "kann kein TCP-Server an Port $bus_port sein: $@\n";
1146     vec($rbits, fileno $bus, 1) = 1;
1147     vec($wbits, fileno $bus, 1) = 1;
1148     daemon_log ("start bus at $bus_ip:$bus_port", 1);
1149 }
1150
1151 # add bus to known_daemons
1152 &create_known_daemons_entry($bus_address);
1153 &update_known_daemons_entry(hostname=>$bus_address, status=>"bus", passwd=>$bus_passwd);
1154
1155
1156 while(1) {
1157     my $nf = select($rbits, $wbits, undef, undef);
1158     # error handling
1159     if($nf < 0 ) {
1160     }
1161
1162     # something is coming in
1163     if(vec $rbits, fileno $bus, 1 ) {
1164         my $client = $bus->accept();
1165         my $other_end = getpeername($client);
1166         if(not defined $other_end) {
1167             daemon_log("Gegenstelle konnte nicht identifiziert werden: $!\n");
1168         } else {
1169             my ($port, $iaddr) = unpack_sockaddr_in($other_end);
1170             my $actual_ip = inet_ntoa($iaddr);
1171             daemon_log("\naccept client from $actual_ip\n", 5);
1172             my $in_msg = &read_from_socket($client);
1173             if(defined $in_msg){
1174                 &activating_child($in_msg, $actual_ip);
1175             } else {
1176                 daemon_log("cannot read from $actual_ip\n",1);
1177             }
1178         }
1179         close($client);
1180     }
1181
1182 }
1183
1184