contrib/daemon/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 = "gosa-sd-bus.cfg";
 140         $cfg_file = File::Spec->catfile( $cwd, $name );
 141         print STDERR "no conf file specified\n   try to use default: $cfg_file\n";
 142     }
 143     if( $err_counter > 0 ) {
 144         &usage( "", 1 );
 145         if( defined( $err_config)) { print STDERR "$err_config\n"}
 146         print STDERR "\n";
 147         exit( -1 );
 148     }
 149 }
 150
 151 #===  FUNCTION  ================================================================
 152 #         NAME:  check_pid
 153 #   PARAMETERS:  nothing
 154 #      RETURNS:  nothing
 155 #  DESCRIPTION:  handels pid processing
 156 #===============================================================================
 157 sub check_pid {
 158     $pid = -1;
 159     # Check, if we are already running
 160     if( open(LOCK_FILE, "<$pid_file") ) {
 161         $pid = <LOCK_FILE>;
 162         if( defined $pid ) {
 163             chomp( $pid );
 164             if( -f "/proc/$pid/stat" ) {
 165                 my($stat) = `cat /proc/$pid/stat` =~ m/$pid \((.+)\).*/;
 166                 if( $0 eq $stat ) {
 167                     close( LOCK_FILE );
 168                     exit -1;
 169                 }
 170             }
 171         }
 172         close( LOCK_FILE );
 173         unlink( $pid_file );
 174     }
 175
 176     # create a syslog msg if it is not to possible to open PID file
 177     if (not sysopen(LOCK_FILE, $pid_file, O_WRONLY|O_CREAT|O_EXCL, 0644)) {
 178         my($msg) = "Couldn't obtain lockfile '$pid_file' ";
 179         if (open(LOCK_FILE, '<', $pid_file)
 180                 && ($pid = <LOCK_FILE>))
 181         {
 182             chomp($pid);
 183             $msg .= "(PID $pid)\n";
 184         } else {
 185             $msg .= "(unable to read PID)\n";
 186         }
 187         if( ! ($foreground) ) {
 188             openlog( $0, "cons,pid", "daemon" );
 189             syslog( "warning", $msg );
 190             closelog();
 191         }
 192         else {
 193             print( STDERR " $msg " );
 194         }
 195         exit( -1 );
 196     }
 197 }
 198
 199
 200 #===  FUNCTION  ================================================================
 201 #         NAME:  usage
 202 #   PARAMETERS:  nothing
 203 #      RETURNS:  nothing
 204 #  DESCRIPTION:  print out usage text to STDERR
 205 #===============================================================================
 206 sub usage {
 207     print STDERR << "EOF" ;
 208 usage: $0 [-hvf] [-c config]
 209
 210     -h        : this (help) message
 211     -c <file> : config file
 212     -f        : foreground, process will not be forked to background
 213     -v        : be verbose (multiple to increase verbosity)
 214 EOF
 215     print "\n" ;
 216 }
 217
 218
 219 #===  FUNCTION  ================================================================
 220 #         NAME:  sig_int_handler
 221 #   PARAMETERS:  signal - string - signal arose from system
 222 #      RETURNS:  noting
 223 #  DESCRIPTION:  handels tasks to be done befor signal becomes active
 224 #===============================================================================
 225 sub sig_int_handler {
 226     my ($signal) = @_;
 227     if($bus){
 228         close($bus);
 229         print "$bus closed\n";
 230     }
 231     print "$signal\n";
 232     IPC::Shareable->clean_up;
 233     exit(1);
 234 }
 235 $SIG{INT} = \&sig_int_handler;
 236
 237
 238 #===  FUNCTION  ================================================================
 239 #         NAME:  get_ip_and_mac
 240 #   PARAMETERS:  nothing
 241 #      RETURNS:  (ip, mac)
 242 #  DESCRIPTION:  executes /sbin/ifconfig and parses the output, the first occurence
 243 #                of a inet address is returned as well as the mac address in the line
 244 #                above the inet address
 245 #===============================================================================
 246 sub get_ip_and_mac {
 247     my $ip = "0.0.0.0.0"; # Defualt-IP
 248     my $mac_address = "00:00:00:00:00:00";  # Default-MAC
 249     my @ifconfig = qx(/sbin/ifconfig);
 250     foreach(@ifconfig) {
 251         if (/Hardware Adresse (\S{2}):(\S{2}):(\S{2}):(\S{2}):(\S{2}):(\S{2})/) {
 252             $mac_address = "$1:$2:$3:$4:$5:$6";
 253             next;
 254         }
 255         if (/inet Adresse:(\d+).(\d+).(\d+).(\d+)/) {
 256             $ip = "$1.$2.$3.$4";
 257             last;
 258         }
 259     }
 260     return ($ip, $mac_address);
 261 }
 262
 263
 264
 265 #===  FUNCTION  ================================================================
 266 #         NAME:  activating_child
 267 #   PARAMETERS:  msg - string - incoming message
 268 #                host - string - host from which the incomming message comes
 269 #      RETURNS:  nothing
 270 #  DESCRIPTION:  handels the distribution of incoming messages to working childs
 271 #===============================================================================
 272 sub activating_child {
 273     my ($msg, $host) = @_;
 274     my $child = &get_processing_child();
 275     my $pipe_wr = $$child{'pipe_wr'};
 276     daemon_log("activating: childpid: $$child{'pid'}", 5);
 277     print $pipe_wr $msg.".".$host."\n";
 278     return;
 279 }
 280
 281
 282 #===  FUNCTION  ================================================================
 283 #         NAME:  get_processing_child
 284 #   PARAMETERS:  nothing
 285 #      RETURNS:  child - hash - holding the process id and the references to the pipe
 286 #                               handles pipe_wr and pipe_rd
 287 #  DESCRIPTION:  handels the forking, reactivating and keeping alive tasks
 288 #===============================================================================
 289 sub get_processing_child {
 290     my $child;
 291     # checking %busy_child{pipe_wr} if msg is 'done', then set child from busy to free
 292     while(my ($key, $val) = each(%busy_child)) {
 293         # check wether process still exists
 294         my $exitus_pid = waitpid($key, WNOHANG);
 295         if($exitus_pid != 0) {
 296             delete $busy_child{$key};
 297             daemon_log( "prozess:$key wurde aus busy_child entfernt\n", 5);
 298             next;
 299         }
 300
 301         # check wether process sitll works
 302         my $fh = $$val{'pipe_rd'};
 303         $fh->blocking(0);
 304         my $child_answer;
 305         if(not $child_answer = <$fh>) { next }
 306         chomp($child_answer);
 307         if($child_answer eq "done") {
 308             delete $busy_child{$key};
 309             $free_child{$key} = $val;
 310         }
 311     }
 312
 313     while(my ($key, $val) = each(%free_child)) {
 314         my $exitus_pid = waitpid($key, WNOHANG);
 315         if($exitus_pid != 0) {
 316             delete $free_child{$key};
 317             daemon_log( "prozess:$key wurde aus free_child entfernt\n", 5);
 318         }
 319         daemon_log("free child:$key\n", 5);
 320     }
 321     # check @free_child and @busy_child
 322     my $free_len = scalar(keys(%free_child));
 323     my $busy_len = scalar(keys(%busy_child));
 324     daemon_log("free children $free_len, busy children $busy_len\n",5);
 325
 326     # if there is a free child, let the child work
 327     if($free_len > 0){
 328         my @keys = keys(%free_child);
 329         $child = $free_child{$keys[0]};
 330         if(defined $child) {
 331             $busy_child{$$child{'pid'}} = $child ;
 332             delete $free_child{$$child{'pid'}};
 333         }
 334         return $child;
 335     }
 336
 337     # no free child, try to fork another one
 338     if($free_len + $busy_len < $child_max) {
 339
 340         daemon_log("not enough children, create a new one\n",5);
 341
 342         # New pipes for communication
 343         my( $PARENT_wr, $PARENT_rd );
 344         my( $CHILD_wr, $CHILD_rd );
 345         pipe( $CHILD_rd,  $PARENT_wr );
 346         pipe( $PARENT_rd, $CHILD_wr  );
 347         $PARENT_wr->autoflush(1);
 348         $CHILD_wr->autoflush(1);
 349
 350         ############
 351         # fork child
 352         ############
 353         my $child_pid = fork();
 354
 355         #CHILD
 356         if($child_pid == 0) {
 357             # Close unused pipes
 358             close( $CHILD_rd );
 359             close( $CHILD_wr );
 360             while( 1 ) {
 361                 my $rbits = "";
 362                 vec( $rbits, fileno $PARENT_rd , 1 ) = 1;
 363
 364                 # waiting child_timeout for jobs to do
 365                 my $nf = select($rbits, undef, undef, $child_timeout);
 366                 if($nf < 0 ) {
 367                     # if $nf < 1, error handling
 368                     die "select(): $!\n";
 369                 } elsif (! $nf) {
 370                     # if already child_min childs are alive, then leave loop
 371                     $free_len = scalar(keys(%free_child));
 372                     $busy_len = scalar(keys(%busy_child));
 373                     if($free_len + $busy_len >= $child_min) {
 374                         last;
 375                     } else {
 376                         redo;
 377                     }
 378                 }
 379
 380                 # a job for a child arise
 381                 if ( vec $rbits, fileno $PARENT_rd, 1 ) {
 382                     # read everything from pipe
 383                     my $msg = "";
 384                     $PARENT_rd->blocking(0);
 385                     while(1) {
 386                         my $read = <$PARENT_rd>;
 387                         if(not defined $read) { last}
 388                         $msg .= $read;
 389                     }
 390
 391                     # forward the job msg to another function
 392                     &process_incoming_msg($msg);
 393                     daemon_log("processing of msg finished", 5);
 394
 395                     # important!!! wait until child says 'done', until then child is set from busy to free
 396                     print $PARENT_wr "done";
 397                     redo;
 398                 }
 399             }
 400             # childs leaving the loop are allowed to die
 401             exit(0);
 402
 403         #PARENT
 404         } else {
 405             # Close unused pipes
 406             close( $PARENT_rd );
 407             close( $PARENT_wr );
 408             # add child to child alive hash
 409             my %child_hash = (
 410                     'pid' => $child_pid,
 411                     'pipe_wr' => $CHILD_wr,
 412                     'pipe_rd' => $CHILD_rd,
 413                     );
 414
 415             $child = \%child_hash;
 416             $busy_child{$$child{'pid'}} = $child;
 417             return $child;
 418         }
 419     }
 420 }
 421
 422
 423 #===  FUNCTION  ================================================================
 424 #         NAME:  process_incoming_msg
 425 #   PARAMETERS:  crypted_msg - string - incoming crypted message
 426 #      RETURNS:  nothing
 427 #  DESCRIPTION:  handels the proceeded distribution to the appropriated functions
 428 #===============================================================================
 429 sub process_incoming_msg {
 430     my ($crypted_msg) = @_;
 431     if(not defined $crypted_msg) {
 432         daemon_log("function 'process_incoming_msg': got no msg", 7);
 433         return;
 434     }
 435     $crypted_msg =~ /^([\s\S]*?)\.(\d{1,3}?)\.(\d{1,3}?)\.(\d{1,3}?)\.(\d{1,3}?)$/;
 436     $crypted_msg = $1;
 437     my $host = sprintf("%s.%s.%s.%s", $2, $3, $4, $5);
 438
 439     daemon_log("msg from host:\n\t$host", 1);
 440     daemon_log("crypted_msg:\n\t$crypted_msg", 7);
 441
 442     my @valid_keys;
 443     my @daemon_keys = keys %$known_daemons;
 444     foreach my $daemon_key (@daemon_keys) {
 445         if($daemon_key =~ "^$daemon_key") {
 446             push(@valid_keys, $daemon_key);
 447         }
 448     }
 449
 450     my $l = @valid_keys;
 451     daemon_log("number of valid daemons: $l\n", 7);
 452
 453     my ($msg, $msg_hash);
 454     my $msg_flag = 0;
 455
 456     # collect addresses from possible incoming clients
 457     foreach my $host_key (@valid_keys) {
 458         eval{
 459             daemon_log( "daemon: $host_key\n", 7);
 460             my $key_passwd = $known_daemons->{$host_key}->{passwd};
 461             daemon_log("daemon_passwd: $key_passwd\n", 7);
 462             my $key_cipher = &create_ciphering($key_passwd);
 463             $msg = &decrypt_msg($crypted_msg, $key_cipher);
 464             daemon_log("daemon decrypted msg:$msg", 7);
 465             $msg_hash = $xml->XMLin($msg, ForceArray=>1);
 466         };
 467         if($@) {
 468             daemon_log("msg processing raise error", 7);
 469             daemon_log("error string: $@", 7);
 470             $msg_flag += 1;
 471         } else {
 472             last;
 473         }
 474     }
 475
 476     if($msg_flag >= $l)  {
 477         daemon_log("\nERROR: do not understand the message:\n$msg" , 1);
 478         return;
 479     }
 480
 481     my $header = &get_content_from_xml_hash($msg_hash, "header");
 482     my $target = &get_content_from_xml_hash($msg_hash, "target");
 483
 484     daemon_log("header from msg:\n\t$header", 1);
 485     daemon_log("msg to process:\n\t$msg", 5);
 486     daemon_log("msg is for: \n\t$target", 7);
 487
 488     if($target eq $bus_address) {
 489         # msg is for bus
 490         if($header eq 'here_i_am'){ &here_i_am($msg_hash)}
 491         elsif($header eq 'confirm_new_passwd'){ &confirm_new_passwd($msg_hash)}
 492         elsif($header eq 'got_ping') { &got_ping($msg_hash)}
 493         elsif($header eq 'ping') { &ping($msg_hash)}
 494         elsif($header eq 'who_has') { &who_has($msg_hash)}
 495         elsif($header eq 'new_client') { &new_client($msg_hash)}
 496         elsif($header eq 'delete_client') { &delete_client($msg_hash)}
 497     } else {
 498         # msg is for any other server
 499         my @targets = @{$msg_hash->{target}};
 500         my $len_targets = @targets;
 501
 502         if ($len_targets == 0){
 503             # no targets specified
 504
 505             daemon_log("ERROR: no target specified for msg $header", 1);
 506
 507         } elsif ($targets[0] eq "*"){
 508             # all deamons in known_daemons are targets
 509
 510             my $target = $targets[0];
 511             my $source = @{$msg_hash->{source}}[0];
 512             my @target_addresses = keys(%$known_daemons);
 513             foreach my $target_address (@target_addresses) {
 514                 if ($target_address eq $source) { next; }
 515                 if ($target_address eq $bus_address) { next ; }
 516                 $msg_hash->{target} = [$target_address];
 517                 &send_msg_hash2address($msg_hash, $target_address);
 518             }
 519
 520         } else {
 521             # a list of targets is specified
 522
 523             my $target_address;
 524             foreach $target_address (@targets) {
 525                 if (exists $known_daemons->{$target_address}) {
 526                     &send_msg_hash2address($msg_hash, $target_address);
 527                 } else {
 528                     my @daemon_addresses = keys %$known_daemons;
 529                     my $daemon_address;
 530                     foreach $daemon_address (@daemon_addresses) {
 531                         if (exists $known_daemons->{$daemon_address}->{clients}->{$target_address}) {
 532                             my $header = &get_content_from_xml_hash($msg_hash, "header");
 533                             &send_msg_hash2address($msg_hash, $daemon_address);
 534                             daemon_log("bus forwards msg $header for client $target_address to server $daemon_address", 3);
 535                             last;
 536                         }
 537                     }
 538
 539                 }
 540             }
 541         }
 542     }
 543
 544     &print_known_daemons_hash();
 545     return;
 546 }
 547
 548
 549 #===  FUNCTION  ================================================================
 550 #         NAME:  get_content_of_known_daemons
 551 #   PARAMETERS:
 552 #      RETURNS:
 553 #  DESCRIPTION:
 554 #===============================================================================
 555 #sub get_content_of_known_daemons {
 556 #    my ($host, $content) = @_;
 557 #    return;
 558 #}
 559
 560
 561 #===  FUNCTION  ================================================================
 562 #         NAME:  create_passwd
 563 #   PARAMETERS:  nothing
 564 #      RETURNS:  new_passwd - string
 565 #  DESCRIPTION:  creates a 32 bit long random passwd out of "a".."z","A".."Z",0..9
 566 #===============================================================================
 567 sub create_passwd {
 568     my $new_passwd = "";
 569     for(my $i=0; $i<31; $i++) {
 570         $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
 571     }
 572     return $new_passwd;
 573 }
 574
 575
 576 #===  FUNCTION  ================================================================
 577 #         NAME:  create_ciphering
 578 #   PARAMETERS:  passwd - string - used to create ciphering
 579 #      RETURNS:  cipher - object
 580 #  DESCRIPTION:  creates a Crypt::Rijndael::MODE_CBC object with passwd as key
 581 #===============================================================================
 582 sub create_ciphering {
 583     my ($passwd) = @_;
 584     $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
 585     my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
 586
 587     #daemon_log("iv: $iv", 7);
 588     #daemon_log("key: $passwd", 7);
 589     my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
 590     $my_cipher->set_iv($iv);
 591     return $my_cipher;
 592 }
 593
 594
 595 #===  FUNCTION  ================================================================
 596 #         NAME:  encrypt_msg
 597 #   PARAMETERS:  msg - string - message to encrypt
 598 #                my_cipher - ref - reference to a Crypt::Rijndael object
 599 #      RETURNS:  crypted_msg - string - crypted message
 600 #  DESCRIPTION:  crypts the incoming message with the Crypt::Rijndael module
 601 #===============================================================================
 602 sub encrypt_msg {
 603     my ($msg, $my_cipher) = @_;
 604     if(not defined $my_cipher) { print "no cipher object\n"; }
 605     $msg = "\0"x(16-length($msg)%16).$msg;
 606     my $crypted_msg = $my_cipher->encrypt($msg);
 607     chomp($crypted_msg = &encode_base64($crypted_msg));
 608     return $crypted_msg;
 609 }
 610
 611
 612 #===  FUNCTION  ================================================================
 613 #         NAME:  decrypt_msg
 614 #   PARAMETERS:  crypted_msg - string - message to decrypt
 615 #                my_cipher - ref - reference to a Crypt::Rijndael object
 616 #      RETURNS:  msg - string - decrypted message
 617 #  DESCRIPTION:  decrypts the incoming message with the Crypt::Rijndael module
 618 #===============================================================================
 619 sub decrypt_msg {
 620     my ($crypted_msg, $my_cipher) = @_ ;
 621     $crypted_msg = &decode_base64($crypted_msg);
 622     my $msg = $my_cipher->decrypt($crypted_msg);
 623     $msg =~ s/^\0*//g;
 624     return $msg;
 625 }
 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
 743     $socket->blocking(1);
 744     my $result = <$socket>;
 745     $socket->blocking(0);
 746     my $part_msg;
 747     while ($part_msg = <$socket>) {
 748         if (not defined $part_msg) { last; }
 749         $result .= $part_msg;
 750     }
 751
 752     #my $result = "";
 753     #my $len = 16;
 754     #while($len == 16){
 755     #    my $char;
 756     #    $len = sysread($socket, $char, 16);
 757     #    if($len != 16) { last }
 758     #    if($len != 16) { last }
 759     #    $result .= $char;
 760     #}
 761     return $result;
 762 }
 763
 764
 765 #===  FUNCTION  ================================================================
 766 #         NAME:  send_msg_hash2address
 767 #   PARAMETERS:  msg_hash - hash - xml_hash created with function create_xml_hash
 768 #                PeerAddr string - socket address to send msg
 769 #                PeerPort string - socket port, if not included in socket address
 770 #      RETURNS:  nothing
 771 #  DESCRIPTION:  ????
 772 #===============================================================================
 773 sub send_msg_hash2address {
 774     my ($msg_hash, $address) = @_ ;
 775
 776     # fetch header for logging
 777     my $header = &get_content_from_xml_hash($msg_hash, "header");
 778
 779     # generate xml string
 780     my $msg_xml = &create_xml_string($msg_hash);
 781
 782     # fetch the appropriated passwd from hash
 783     my $passwd = $known_daemons->{$address}->{passwd};
 784
 785     # create a ciphering object
 786     my $act_cipher = &create_ciphering($passwd);
 787
 788     # encrypt xml msg
 789     my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
 790
 791     # open socket
 792     my $socket = &open_socket($address);
 793     if(not defined $socket){
 794         daemon_log("ERROR: cannot send '$header'-msg to $address , server not reachable", 1);
 795         return;
 796     }
 797
 798     # send xml msg
 799     print $socket $crypted_msg."\n";
 800
 801     close $socket;
 802     daemon_log("send '$header'-msg to $address", 5);
 803     daemon_log("crypted_msg:\n\t$crypted_msg", 7);
 804     return;
 805 }
 806
 807
 808 #===  FUNCTION  ================================================================
 809 #         NAME:  send_msg_hash2all
 810 #   PARAMETERS:  msg_hash - hash - xml_hash created with function create_xml_hash
 811 #      RETURNS:  nothing
 812 #  DESCRIPTION:  send msg_hash to all registered daemons
 813 #===============================================================================
 814 sub send_msg_hash2all {
 815     my ($msg_hash) = @_;
 816
 817     # fetch header for logging
 818     my $header = &get_content_from_xml_hash($msg_hash, "header");
 819
 820     # generate xml string
 821     my $msg_xml = &create_xml_string($msg_hash);
 822
 823     # fetch a list of all target addresses
 824     my @targets = keys(%$known_daemons);
 825
 826     # itterates through the list an send each the msg
 827     foreach my $target (@targets) {
 828         if($target eq $bus_address) {next};   # do not send msg to bus
 829
 830         # fetch the appropriated passwd
 831         my $passwd = $known_daemons->{$target}->{passwd};
 832
 833         # create ciphering object
 834         my $act_cipher = &create_ciphering($passwd);
 835
 836         # encrypt xml msg
 837         my $crypted_msg = &encrypt_msg($msg_xml, $act_cipher);
 838
 839         # open socket
 840         my $socket = &open_socket($target);
 841         if(not defined $socket){
 842             daemon_log("ERROR: cannot open socket to $target , server not reachable", 1);
 843             &update_known_daemons_entry(hostname=>$target, status=>"down");
 844             next;
 845         }
 846
 847         # send xml msg
 848         print $socket $crypted_msg."\n";
 849
 850         close $socket;
 851         daemon_log("send '$header'-msg to $target", 5);
 852         daemon_log("crypted_msg:\n\t$crypted_msg", 7);
 853     }
 854     return;
 855 }
 856
 857
 858 #===  FUNCTION  ================================================================
 859 #         NAME:  here_i_am
 860 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 861 #      RETURNS:  nothing
 862 #  DESCRIPTION:  process the incoming msg 'here_i_am'
 863 #===============================================================================
 864 sub here_i_am {
 865     my ($msg_hash) = @_ ;
 866     my $source = &get_content_from_xml_hash($msg_hash, "source");
 867
 868     my $new_passwd = &create_passwd();
 869
 870     # create known_daemons entry
 871     &create_known_daemons_entry($source);
 872     &update_known_daemons_entry(hostname=>$source, status=>"registered", passwd=>$bus_passwd);
 873
 874     # create outgoing msg
 875     my $out_hash = &create_xml_hash("new_passwd", "$bus_ip:$bus_port", $source, $new_passwd);
 876     &send_msg_hash2address($out_hash, $source);
 877
 878     # change passwd, reason
 879     # &send_msg_hash2address takes $known_daemons->{"$source"}->{passwd} to cipher msg
 880     &update_known_daemons_entry(hostname=>$source, status=>"new_passwd", passwd=>$new_passwd);
 881
 882     return;
 883 }
 884
 885
 886 #===  FUNCTION  ================================================================
 887 #         NAME:  confirm_new_passwd
 888 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 889 #      RETURNS:  nothing
 890 #  DESCRIPTION:  process this incoming message
 891 #===============================================================================
 892 sub confirm_new_passwd {
 893     my ($msg_hash) = @_ ;
 894     my $source = &get_content_from_xml_hash($msg_hash, "source");
 895     &update_known_daemons_entry(hostname=>$source, status=>"confirmed_new_passwd");
 896     return;
 897 }
 898
 899
 900 #===  FUNCTION  ================================================================
 901 #         NAME:  ping
 902 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 903 #      RETURNS:  nothing
 904 #  DESCRIPTION:  process this incoming message
 905 #===============================================================================
 906 sub ping {
 907     my ($msg_hash) = @_ ;
 908     my $source = &get_content_from_xml_hash($msg_hash, "source");
 909     &update_known_daemons_entry(hostname=>$source, status=>"ping");
 910     my $out_hash = &create_xml_hash("got_ping", $bus_address, $source);
 911     &send_msg_hash2address($out_hash, $source);
 912     return;
 913 }
 914
 915
 916 #===  FUNCTION  ================================================================
 917 #         NAME:  make ping
 918 #   PARAMETERS:  address - string - address which should be pinged
 919 #      RETURNS:  nothing
 920 #  DESCRIPTION:  send ping message to address
 921 #===============================================================================
 922 sub make_ping {
 923     my ($address) = @_;
 924     daemon_log("ping:$address\n", 1);
 925     my $out_hash = &create_xml_hash("ping", "$bus_ip:$bus_port", $address);
 926     &send_msg_hash2address($out_hash, $address);
 927     return;
 928 }
 929
 930
 931 #===  FUNCTION  ================================================================
 932 #         NAME:  got_ping
 933 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 934 #      RETURNS:  nothing
 935 #  DESCRIPTION:  process this incoming message
 936 #===============================================================================
 937 sub got_ping {
 938     my ($msg_hash) = @_;
 939     my $source = &get_content_from_xml_hash($msg_hash, "source");
 940     &update_known_daemons_entry(hostname=>$source, status=>"got_ping");
 941     return;
 942 }
 943
 944
 945 #===  FUNCTION  ================================================================
 946 #         NAME:  new_client
 947 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 948 #      RETURNS:  nothing
 949 #  DESCRIPTION:  process this incoming message
 950 #===============================================================================
 951 sub new_client {
 952     my ($msg_hash) = @_ ;
 953     my $source = &get_content_from_xml_hash($msg_hash, "source");
 954     my $header = &get_content_from_xml_hash($msg_hash, "header");
 955     my $new_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
 956
 957     &update_known_daemons_entry(hostname=>$source, client=>$new_client);
 958     return;
 959 }
 960
 961
 962 #===  FUNCTION  ================================================================
 963 #         NAME:  delete_client
 964 #   PARAMETERS:  msg_hash - hash - hash from function create_xml_hash
 965 #      RETURNS:  nothing
 966 #  DESCRIPTION:  process this incoming message
 967 #===============================================================================
 968 sub delete_client {
 969     my ($msg_hash) = @_ ;
 970     my $source = &get_content_from_xml_hash($msg_hash, "source");
 971     my $header = &get_content_from_xml_hash($msg_hash, "header");
 972     my $del_client = (&get_content_from_xml_hash($msg_hash, $header))[0];
 973
 974     if (not exists $known_daemons->{$source}->{$del_client}) {
 975         daemon_log
 976     }
 977     delete $known_daemons->{$source}->{$del_client};
 978
 979     return;
 980 }
 981
 982
 983 #===  FUNCTION  ================================================================
 984 #         NAME:  print_known_daemons_hash
 985 #   PARAMETERS:  nothing
 986 #      RETURNS:  nothing
 987 #  DESCRIPTION:  nome est omen
 988 #===============================================================================
 989 sub print_known_daemons_hash {
 990     my ($tmp) = @_;
 991     print "####################################\n";
 992     print "# status of known_daemons\n";
 993     my $hosts;
 994     my $host_hash;
 995     $shmkh->shlock(LOCK_EX);
 996     my @hosts = keys %$known_daemons;
 997     foreach my $host (@hosts) {
 998         my $status = $known_daemons->{$host}->{status} ;
 999         my $passwd = $known_daemons->{$host}->{passwd};
1000         my $timestamp = $known_daemons->{$host}->{timestamp};
1001         my @clients = keys %{$known_daemons->{$host}->{clients}};
1002         my $client_string = join(", ", @clients);
1003         print "$host\n";
1004         print "\tstatus:    $status\n";
1005         print "\tpasswd:    $passwd\n";
1006         print "\ttimestamp: $timestamp\n";
1007         print "\tclients:   $client_string\n";
1008
1009     }
1010     $shmkh->shunlock(LOCK_EX);
1011     print "####################################\n\n";
1012     return;
1013 }
1014
1015
1016 #===  FUNCTION  ================================================================
1017 #         NAME:  create_known_daemons_entry
1018 #   PARAMETERS:  hostname - string - ip address and port of host
1019 #      RETURNS:  nothing
1020 #  DESCRIPTION:  nome est omen
1021 #===============================================================================
1022 sub create_known_daemons_entry {
1023     my ($hostname) = @_;
1024     $shmkh->shlock(LOCK_EX);
1025     $known_daemons->{$hostname} = {};
1026     $known_daemons->{$hostname}->{status} = "none";
1027     $known_daemons->{$hostname}->{passwd} = "none";
1028     $known_daemons->{$hostname}->{timestamp} = "none";
1029     $known_daemons->{$hostname}->{clients} = {};
1030     $shmkh->shunlock(LOCK_EX);
1031     return;
1032 }
1033
1034
1035 #===  FUNCTION  ================================================================
1036 #         NAME:  update_known_daemons_entry
1037 #   PARAMETERS:  hostname - string - ip address and port of host (required)
1038 #                status - string - (optional)
1039 #                passwd - string - (optional)
1040 #                client - string - ip address and port of client (optional)
1041 #      RETURNS:  nothing
1042 #  DESCRIPTION:  nome est omen and updates each time the timestamp of hostname
1043 #===============================================================================
1044 sub update_known_daemons_entry {
1045     my $arg = {
1046         hostname => undef, status => undef, passwd => undef,
1047         client => undef,
1048         @_ };
1049     my $hostname = $arg->{hostname};
1050     my $status = $arg->{status};
1051     my $passwd = $arg->{passwd};
1052     my $client = $arg->{client};
1053
1054     if (not defined $hostname) {
1055         daemon_log("ERROR: function add_content2known_daemons is not invoked with requiered parameter 'hostname'", 1);
1056         return;
1057     }
1058
1059     my ($seconds, $minutes, $hours, $monthday, $month,
1060     $year, $weekday, $yearday, $sommertime) = localtime(time);
1061     $hours = $hours < 10 ? $hours = "0".$hours : $hours;
1062     $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
1063     $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
1064     $month+=1;
1065     $month = $month < 10 ? $month = "0".$month : $month;
1066     $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
1067     $year+=1900;
1068     my $t = "$year$month$monthday$hours$minutes$seconds";
1069
1070     $shmkh->shlock(LOCK_EX);
1071     if (defined $status) {
1072         $known_daemons->{$hostname}->{status} = $status;
1073     }
1074     if (defined $passwd) {
1075         $known_daemons->{$hostname}->{passwd} = $passwd;
1076     }
1077     if (defined $client) {
1078         $known_daemons->{$hostname}->{clients}->{$client} = "";
1079     }
1080     $known_daemons->{$hostname}->{timestamp} = $t;
1081     $shmkh->shunlock(LOCK_EX);
1082     return;
1083 }
1084
1085
1086 #==== MAIN = main ==============================================================
1087
1088 #  parse commandline options
1089 Getopt::Long::Configure( "bundling" );
1090 GetOptions("h|help" => \&usage,
1091            "c|config=s" => \$cfg_file,
1092            "f|foreground" => \$foreground,
1093            "v|verbose+" => \$verbose,
1094            );
1095
1096 #  read and set config parameters
1097 &check_cmdline_param ;
1098 &read_configfile;
1099 &check_pid;
1100
1101 $SIG{CHLD} = 'IGNORE';
1102
1103 # restart daemon log file
1104 if(-e $log_file ) { unlink $log_file }
1105 daemon_log("$0 started!");
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     $bus = IO::Socket::INET->new(LocalPort => $bus_port,
1141             Type => SOCK_STREAM,
1142             Reuse => 1,
1143             Listen => 20,
1144             ) or die "kann kein TCP-Server an Port $bus_port sein: $@\n";
1145     vec($rbits, fileno $bus, 1) = 1;
1146     vec($wbits, fileno $bus, 1) = 1;
1147     print "start bus at $bus_ip:$bus_port\n";
1148 }
1149
1150 # add bus to known_daemons
1151 &create_known_daemons_entry($bus_address);
1152 &update_known_daemons_entry(hostname=>$bus_address, status=>"bus", passwd=>$bus_passwd);
1153
1154
1155 while(1) {
1156     my $nf = select($rbits, $wbits, undef, undef);
1157     # error handling
1158     if($nf < 0 ) {
1159     }
1160
1161     # something is coming in
1162     if(vec $rbits, fileno $bus, 1 ) {
1163         my $client = $bus->accept();
1164         my $other_end = getpeername($client);
1165         if(not defined $other_end) {
1166             daemon_log("Gegenstelle konnte nicht identifiziert werden: $!\n");
1167         } else {
1168             my ($port, $iaddr) = unpack_sockaddr_in($other_end);
1169             my $actual_ip = inet_ntoa($iaddr);
1170             daemon_log("\naccept client from $actual_ip\n", 5);
1171             my $in_msg = &read_from_socket($client);
1172             if(defined $in_msg){
1173                 &activating_child($in_msg, $actual_ip);
1174             } else {
1175                 daemon_log("cannot read from $actual_ip\n",1);
1176             }
1177         }
1178         close($client);
1179     }
1180
1181 }
1182
1183