[old-projects.git] / muxdaemon / muxdaemon.pl

#!/usr/bin/perl

use Config::General;
use Data::Dumper;
use Getopt::Std;
use IO::Handle;
use POSIX qw(setsid setuid setgid);
use POSIX ":sys_wait_h";


#################
## Global vars ## 
#################

my $confile;
my %conf;
my %running;
my $reload_conf=0;
my $debug=0;
#For each process, uid and gid to set after fork
my %gid;
my %uid;

#For sheduler
#Number of launch, for each daemon
my %launches;
my %ratio_launch_prio;
my %last_schedule;

###############
## Functions ##
###############

sub sigHUP_handler{
   &debug_msg("got SIGHUP\n");
   $reload_conf=1;
}
   

#Read Configuration and init global vars
sub read_conf {
   my $file = shift;
   $config = new Config::General( -file =>"$file", 
	 			  -AllowMultiOptions =>"yes",
	 			  -LowerCaseNames =>"yes",);
   %conf = $config->getall;
   &debug_msg(Dumper(\%conf));
}


sub debug_msg(#){
   my $text=shift;
   print STDERR $text unless ($debug == 0);
}
   

sub init {
   #getopts('hf:', \%opts) or die "Illegal program option. ($0 -h for list)\n";
   #&debug_msg(Dumper(\%opts));

   if ($confile eq ""){
      my $path = `pwd`;
      chomp($path);
      if ($path){
	 $confile="$path/muxdaemon.conf";
      }else{
	 print STDERR "Error : unable to get working directory, $!\n";
	 exit(1);
      }
   }

   if ( not getopts('dhf:', \%opts) or $opts{'h'}) {
      print STDERR "\nThis is mail processing Daemon :\n",
                   "-h          - this help message\n", 
		   "-f <file>   - use <file> as config file\n",
		   "-d          - debug mode\n";
      exit(1);
   }

   if ($opts{'f'}){
      if (-r "$opts{'f'}") {
	 print STDERR "Using $opts{'f'} as config file\n";
	 &read_conf("$opts{'f'}");
      } else {
	 print STDERR "$opts{'f'} : not a valid config file\n";
	 exit(1);
      }
   } else {
      print STDERR "Using $confile as config file\n";
      if (-r "$confile") {
	 &read_conf("$confile");
      } else {
	 print STDERR "No valid configuration file found, aborting\n";
	 exit(1);
      }
   }

   if ($opts{'d'}){
      print STDERR "Running in debug mode ...\n";
      $debug = 1;
   }else{
      $debug = 0;
   }
}

#init useful variables for scheduler
sub init_sched(){
   foreach my $arg (keys %{$conf{'client'}}){
      $launches{"$arg"}=0;
      $ratio_launch_prio{"$arg"}=0;
      $last_schedule{"$arg"}=0;
   }
}

#check configuration file 
sub check_conf{
   &debug_msg("Salut\n");
   print STDERR "Checking configuration file for wrong user/groups, schedules, ....\n";
   foreach my $arg (keys %{$conf{'client'}}){
      #La conf du client courant
      my $hash=${$conf{'client'}}{"$arg"};
      if (${$hash}{'run_as_user'}){
	 my $id = getpwnam("${$hash}{'run_as_user'}");
	 if ($id){
	    $uid{"$arg"} = $id;
	 }else{
	    print STDERR "  Error, user ${$hash}{'run_as_user'} does not exist, please check...\n";
	    exit(1);
	 }
      }
      if (${$hash}{'run_as_group'}){
	 my $id = getgrnam("${$hash}{'run_as_group'}");
	 if ($id){
	    $gid{"$arg"} = $id;
	 }else{
	    print STDERR "  Error, group ${$hash}{'run_as_group'} does not exist, please check...\n";
	    exit(1);
	 }
      }
      if (${$hash}{'allow_many'} eq "yes" and ${$hash}{'min_schedule'}){
	 print STDERR "  Error, allow_many and min_schedule defined for $arg\n";
	 exit(1);
      }
   }
}


#make the program run in daemon mode
sub daemonize {
   print STDERR "Forking ... \n";
   chdir '/' or die "Can't chdir to /: $!";
   open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
   open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
   if ($conf{'error_log'}){
      open STDERR, ">>$conf{'error_log'}" or die "Can't write to $conf{'error_log'}: $!";
   }else{
      open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
   }
   defined(my $pid = fork) or die "Can't fork: $!";
   exit if $pid;
   setsid or die "Can't start a new session: $!";
   #umask 0;
   &debug_msg("Daemon started\n");
}


#returns current load or any good value
sub get_load {
   my $load = `$conf{"ldcmd"}`;
   chomp($load);
   return $load;
}

#Return the list of client for which max_load is => ld
#param : load
sub get_possible_client(#){
   my $ld=shift;
   my @list=();
   
   foreach my $arg (keys %{$conf{'client'}}){
      my $hash = ${$conf{'client'}}{$arg};
      if (${$hash}{'max_load'} >= $ld){
	 push(@list,$arg);
      }
   }
   return \@list;
}
   

#Return the client that should be executed according to priorities
#given in conf file
# Refaire avec calcul du min de launches/prio !
sub get_next(#){
   my $ref=shift;
   my @possible_client = @{$ref};
   #List des proc executes assez souvent
   my $client="";
   my $min_ratio=-1;
   
   foreach my $arg (@possible_client){
      if ($ratio_launch_prio{"$arg"} < $min_ratio or $min_ratio == -1){
	 $min_ratio=$ratio_launch_prio{"$arg"};
	 $client=$arg;
      }
   }

   if ($client){
      #Update ratio for him
      $launches{"$client"}++;
      $ratio_launch_prio{"$client"}=$launches{"$client"}/${${$conf{'client'}}{$client}}{'priority'};
      return $client;
   }else{
      &debug_msg("No client runnable in get_next\n");
      return;
   }
   return;
}

#Elimine les clients pr�sent dans la liste qui sont en cours d'�x�cution et
#qui n'ont pas le allow_many (pour pas les �x�cuter deux fois)
#Elimine aussi les clients qui ont termin� depuis moins que min_schedule
sub trim_possible_client(#){
   my $ref=shift;
   my @out_list;


   foreach my $arg (@$ref){
      if (${${$conf{'client'}}{$arg}}{'allow_many'} eq "no"){
	 #Exec only one
	 if ((time - $last_schedule{$arg}) >= ${${$conf{'client'}}{$arg}}{'min_schedule'}){
	    push(@out_list,$arg) unless grep($_ eq $arg, values %running);
	 }
      }else{
	 push(@out_list,$arg);
      }
   }

   return \@out_list;
}


sub change_uid_gid(#){
   my $client=shift;
   if ($gid{"$client"}){
      &debug_msg("Changing gid to $gid{$client} for $client ...");
      if (POSIX::setgid($gid{"$client"})){
	 &debug_msg("done\n");
      }else{
	 &debug_msg("error, $!\n");
	 exit(1);
      }
   }
   if ($uid{"$client"}){
      &debug_msg("Changing uid to $uid{$client} for $client ...");
      if (POSIX::setuid($uid{"$client"})){
	 &debug_msg("done\n");
      }else{
	 &debug_msg("error, $!\n");
	 exit(1);
      }
   }
}


#Sends mail on the input of the command (pipe)
sub send_data(#){
   my $client = shift;
   my $hash = ${$conf{'client'}}{$client};
   if (${$hash}{'mbox'} =~ /\/$/){ #ok, maildir format
      my $path = "${$hash}{'mbox'}";
      $path =~ s/\/$//igo;
      &debug_msg("Sending datas for ${$hash}{'mbox'}\n");
      my @list=`ls -1 $path/new | head -n ${$hash}{'nb_mails'}`;
      if ($#list >= 0){
	 #Send files, one by one
	 foreach my $fich (@list){
	    chomp($fich);
	    &debug_msg("File : $fich\n");
	    if (my $pid = open(CHILD, "|-")) {
	       CHILD->autoflush(1);
	       if (open(DATA,"<$path/new/$fich")){
		  while (my $line=<DATA>){
		     print CHILD "$line";
		  }
		  close(DATA);
		  &debug_msg("$path/new/$fich -> $path/cur/$fich ... ");
		  if (rename("$path/new/$fich","$path/cur/$fich")){
		     &debug_msg("ok\n");
		  }else{
		     print STDERR "Error moving $path/new/$fich, keeped : $!\n";
		  }
	       }else{
		  print STDERR "Error opening $path/new/$fich : $!\n";
		  exit(1);
	       }
	       close(CHILD);
	    } else {
	       die "cannot fork: $!" unless defined $pid;
	       &change_uid_gid("$client");
	       &debug_msg("Executing ${$hash}{'command'} .... \n");
	       exec("${$hash}{'command'}");
	    }
	 }
      }else{
	 &debug_msg("No mail available\n");
      }
   }else{
      &debug_msg("Mbox format not yet supported.\n");
      exit(1);
   }
}
      
   
sub launch(#){
   my $client=shift;
   #Launch the command of a simple client
   &debug_msg("Son $client, launching ${${$conf{'client'}}{$client}}{'command'}\n");
   #Change uid and gid if needed
   &change_uid_gid("$client");
   exec(${${$conf{'client'}}{$client}}{'command'});
}


sub main_loop {
   
   my $ld;
   my $nchild;

   while (1) {
      
      if ($reload_conf == 1){
	 #We have to load conf again
	 $reload_conf=0;
	 &debug_msg("Reloading configuration .... \n");
	 &debug_msg("  Waiting all child to terminate ...");
	 while ((my $kid=wait) != -1){
	    $nchild--;
	    delete($running{$kid});
	 }
	 &debug_msg("done\n");
	 &debug_msg("  Restarting                     ...");
	 &init;
	 &init_sched;
	 &debug_msg("done\n");
      }
	 
	 
      if ($nchild >= $conf{'max_client'}){
	 #We have to wait for one child (Blocking)"
	 &debug_msg("Waiting for childs to terminate\n");
	 my $kid=wait;
	 if ($kid>0){
	    &debug_msg("Kid=$kid est mort, c'�tait un $running{$kid}\n");
	    $nchild--;
	    delete($running{$kid});
	 }
      }else{
	 #Rip child terminated
	 &debug_msg("Checking dead childs....\n");
	 while ( (my $kid = waitpid(-1, WNOHANG)) > 0 ){
	    &debug_msg("Kid=$kid est mort, c'�tait un $running{$kid}\n");
	    $nchild--;
	    delete($running{$kid});
	 }
	 
	 #Look for a client to execute
	 my $ld = &get_load; 
	 &debug_msg("Load = $ld, processing\n");
	 my $possible_client=&get_possible_client($ld);
	 my @list=@{$possible_client};
	 &debug_msg("Avant Trim :  \n");
	 &debug_msg(Dumper($possible_client));
	 $possible_client=&trim_possible_client($possible_client);
	 &debug_msg("Apr�s Trim : \n");
	 &debug_msg(Dumper($possible_client));
	 my $client=&get_next($possible_client);
	 if ($client){
	    #sleep(1);
	    &debug_msg("$client was chosen, launching\n");
	    $last_schedule{$client} = time ;
	    if (my $pid = fork){
	       #Pere, on marque qu'on l'a lanc�
	       $running{$pid}="$client";
	       $nchild++;
	       &debug_msg("$client launched as PID $pid\n");
	       &debug_msg(Dumper(\%running));
	       &debug_msg(Dumper(\%launches));
	    }else{
	       #Fils
	       if (${${$conf{'client'}}{$client}}{'mbox'}){
		  #We have to send data ourselves
		  &send_data("$client");
	       }else{
		  #We only have to execute a command
		  &launch("$client");
	       }
	       exit(0);
	    }
	 }else{
	    &debug_msg("No client runable\n");
	    sleep($conf{'sleep_poll'});
	 }
	 sleep($conf{'active_poll'});
      }
   }
}


##########
## Main ##
##########

$SIG{HUP}=\&sigHUP_handler;
&init();
&check_conf();
&init_sched();
&daemonize();
&main_loop();
Commit	Line	Data
cdf5b41f JL	1	#!/usr/bin/perl
	2
	3	use Config::General;
	4	use Data::Dumper;
	5	use Getopt::Std;
	6	use IO::Handle;
	7	use POSIX qw(setsid setuid setgid);
	8	use POSIX ":sys_wait_h";
	9
	10
	11	#################
	12	## Global vars ##
	13	#################
	14
	15	my $confile;
	16	my %conf;
	17	my %running;
	18	my $reload_conf=0;
	19	my $debug=0;
	20	#For each process, uid and gid to set after fork
	21	my %gid;
	22	my %uid;
	23
	24	#For sheduler
	25	#Number of launch, for each daemon
	26	my %launches;
	27	my %ratio_launch_prio;
	28	my %last_schedule;
cdf5b41f JL	29
	30	###############
	31	## Functions ##
	32	###############
	33
	34	sub sigHUP_handler{
	35	&debug_msg("got SIGHUP\n");
	36	$reload_conf=1;
	37	}
	38
	39
	40	#Read Configuration and init global vars
	41	sub read_conf {
	42	my $file = shift;
	43	$config = new Config::General( -file =>"$file",
	44	-AllowMultiOptions =>"yes",
	45	-LowerCaseNames =>"yes",);
	46	%conf = $config->getall;
	47	&debug_msg(Dumper(\%conf));
	48	}
	49
	50
	51	sub debug_msg(#){
f566ccb9 JL	52	my $text=shift;
f566ccb9 JL	53	print STDERR $text unless ($debug == 0);
cdf5b41f JL	54	}
	55
	56
	57	sub init {
	58	#getopts('hf:', \%opts) or die "Illegal program option. ($0 -h for list)\n";
	59	#&debug_msg(Dumper(\%opts));
	60
	61	if ($confile eq ""){
	62	my $path = `pwd`;
	63	chomp($path);
	64	if ($path){
	65	$confile="$path/muxdaemon.conf";
	66	}else{
	67	print STDERR "Error : unable to get working directory, $!\n";
	68	exit(1);
	69	}
	70	}
	71
	72	if ( not getopts('dhf:', \%opts) or $opts{'h'}) {
	73	print STDERR "\nThis is mail processing Daemon :\n",
	74	"-h - this help message\n",
	75	"-f <file> - use <file> as config file\n",
	76	"-d - debug mode\n";
	77	exit(1);
	78	}
	79
	80	if ($opts{'f'}){
	81	if (-r "$opts{'f'}") {
	82	print STDERR "Using $opts{'f'} as config file\n";
	83	&read_conf("$opts{'f'}");
	84	} else {
	85	print STDERR "$opts{'f'} : not a valid config file\n";
	86	exit(1);
	87	}
	88	} else {
	89	print STDERR "Using $confile as config file\n";
	90	if (-r "$confile") {
	91	&read_conf("$confile");
	92	} else {
	93	print STDERR "No valid configuration file found, aborting\n";
	94	exit(1);
	95	}
	96	}
	97
	98	if ($opts{'d'}){
f566ccb9	99	print STDERR "Running in debug mode ...\n";
cdf5b41f JL	100	$debug = 1;
	101	}else{
	102	$debug = 0;
	103	}
cdf5b41f JL	104	}
cdf5b41f JL	105
f566ccb9 JL	106	#init useful variables for scheduler
f566ccb9 JL	107	sub init_sched(){
cdf5b41f JL	108	foreach my $arg (keys %{$conf{'client'}}){
	109	$launches{"$arg"}=0;
	110	$ratio_launch_prio{"$arg"}=0;
f566ccb9	111	$last_schedule{"$arg"}=0;
cdf5b41f JL	112	}
	113	}
	114
f566ccb9 JL	115	#check configuration file
	116	sub check_conf{
	117	&debug_msg("Salut\n");
cdf5b41f JL	118	print STDERR "Checking configuration file for wrong user/groups, schedules, ....\n";
	119	foreach my $arg (keys %{$conf{'client'}}){
	120	#La conf du client courant
	121	my $hash=${$conf{'client'}}{"$arg"};
	122	if (${$hash}{'run_as_user'}){
	123	my $id = getpwnam("${$hash}{'run_as_user'}");
	124	if ($id){
	125	$uid{"$arg"} = $id;
	126	}else{
	127	print STDERR " Error, user ${$hash}{'run_as_user'} does not exist, please check...\n";
	128	exit(1);
	129	}
	130	}
	131	if (${$hash}{'run_as_group'}){
	132	my $id = getgrnam("${$hash}{'run_as_group'}");
	133	if ($id){
	134	$gid{"$arg"} = $id;
	135	}else{
	136	print STDERR " Error, group ${$hash}{'run_as_group'} does not exist, please check...\n";
	137	exit(1);
	138	}
	139	}
	140	if (${$hash}{'allow_many'} eq "yes" and ${$hash}{'min_schedule'}){
	141	print STDERR " Error, allow_many and min_schedule defined for $arg\n";
	142	exit(1);
	143	}
	144	}
	145	}
	146
f566ccb9 JL	147
f566ccb9 JL	148	#make the program run in daemon mode
cdf5b41f JL	149	sub daemonize {
	150	print STDERR "Forking ... \n";
	151	chdir '/' or die "Can't chdir to /: $!";
	152	open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
	153	open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
	154	if ($conf{'error_log'}){
	155	open STDERR, ">>$conf{'error_log'}" or die "Can't write to $conf{'error_log'}: $!";
	156	}else{
	157	open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
	158	}
	159	defined(my $pid = fork) or die "Can't fork: $!";
	160	exit if $pid;
	161	setsid or die "Can't start a new session: $!";
f566ccb9	162	#umask 0;
cdf5b41f JL	163	&debug_msg("Daemon started\n");
	164	}
	165
f566ccb9 JL	166
f566ccb9 JL	167	#returns current load or any good value
cdf5b41f JL	168	sub get_load {
cdf5b41f JL	169	my $load = `$conf{"ldcmd"}`;
f566ccb9	170	chomp($load);
cdf5b41f JL	171	return $load;
	172	}
	173
	174	#Return the list of client for which max_load is => ld
f566ccb9	175	#param : load
cdf5b41f JL	176	sub get_possible_client(#){
	177	my $ld=shift;
	178	my @list=();
f566ccb9	179
cdf5b41f	180	foreach my $arg (keys %{$conf{'client'}}){
cdf5b41f JL	181	my $hash = ${$conf{'client'}}{$arg};
cdf5b41f JL	182	if (${$hash}{'max_load'} >= $ld){
cdf5b41f	183	push(@list,$arg);
cdf5b41f JL	184	}
	185	}
	186	return \@list;
	187	}
	188
	189
	190	#Return the client that should be executed according to priorities
	191	#given in conf file
	192	# Refaire avec calcul du min de launches/prio !
	193	sub get_next(#){
	194	my $ref=shift;
	195	my @possible_client = @{$ref};
	196	#List des proc executes assez souvent
	197	my $client="";
	198	my $min_ratio=-1;
	199
	200	foreach my $arg (@possible_client){
	201	if ($ratio_launch_prio{"$arg"} < $min_ratio or $min_ratio == -1){
	202	$min_ratio=$ratio_launch_prio{"$arg"};
	203	$client=$arg;
	204	}
	205	}
	206
	207	if ($client){
	208	#Update ratio for him
	209	$launches{"$client"}++;
	210	$ratio_launch_prio{"$client"}=$launches{"$client"}/${${$conf{'client'}}{$client}}{'priority'};
	211	return $client;
	212	}else{
	213	&debug_msg("No client runnable in get_next\n");
	214	return;
	215	}
	216	return;
	217	}
	218
	219	#Elimine les clients pr�sent dans la liste qui sont en cours d'�x�cution et
	220	#qui n'ont pas le allow_many (pour pas les �x�cuter deux fois)
	221	#Elimine aussi les clients qui ont termin� depuis moins que min_schedule
	222	sub trim_possible_client(#){
	223	my $ref=shift;
	224	my @out_list;
	225
	226
	227	foreach my $arg (@$ref){
	228	if (${${$conf{'client'}}{$arg}}{'allow_many'} eq "no"){
	229	#Exec only one
	230	if ((time - $last_schedule{$arg}) >= ${${$conf{'client'}}{$arg}}{'min_schedule'}){
	231	push(@out_list,$arg) unless grep($_ eq $arg, values %running);
	232	}
	233	}else{
	234	push(@out_list,$arg);
	235	}
	236	}
	237
	238	return \@out_list;
	239	}
	240
	241
	242	sub change_uid_gid(#){
	243	my $client=shift;
	244	if ($gid{"$client"}){
	245	&debug_msg("Changing gid to $gid{$client} for $client ...");
	246	if (POSIX::setgid($gid{"$client"})){
	247	&debug_msg("done\n");
248	}else{
249	&debug_msg("error, $!\n");
250	exit(1);
251	}
252	}
253	if ($uid{"$client"}){
254	&debug_msg("Changing uid to $uid{$client} for $client ...");
255	if (POSIX::setuid($uid{"$client"})){
256	&debug_msg("done\n");
257	}else{
258	&debug_msg("error, $!\n");
259	exit(1);
260	}
261	}
262	}
263
264
265	#Sends mail on the input of the command (pipe)
266	sub send_data(#){
f566ccb9 JL	267	my $client = shift;
	268	my $hash = ${$conf{'client'}}{$client};
	269	if (${$hash}{'mbox'} =~ /\/$/){ #ok, maildir format
	270	my $path = "${$hash}{'mbox'}";
	271	$path =~ s/\/$//igo;
	272	&debug_msg("Sending datas for ${$hash}{'mbox'}\n");
	273	my @list=`ls -1 $path/new \| head -n ${$hash}{'nb_mails'}`;
cdf5b41f JL	274	if ($#list >= 0){
	275	#Send files, one by one
	276	foreach my $fich (@list){
f566ccb9	277	chomp($fich);
cdf5b41f JL	278	&debug_msg("File : $fich\n");
	279	if (my $pid = open(CHILD, "\|-")) {
	280	CHILD->autoflush(1);
f566ccb9	281	if (open(DATA,"<$path/new/$fich")){
cdf5b41f JL	282	while (my $line=<DATA>){
cdf5b41f JL	283	print CHILD "$line";
cdf5b41f JL	284	}
cdf5b41f JL	285	close(DATA);
f566ccb9 JL	286	&debug_msg("$path/new/$fich -> $path/cur/$fich ... ");
	287	if (rename("$path/new/$fich","$path/cur/$fich")){
	288	&debug_msg("ok\n");
	289	}else{
	290	print STDERR "Error moving $path/new/$fich, keeped : $!\n";
	291	}
cdf5b41f	292	}else{
f566ccb9	293	print STDERR "Error opening $path/new/$fich : $!\n";
cdf5b41f JL	294	exit(1);
	295	}
	296	close(CHILD);
cdf5b41f JL	297	} else {
	298	die "cannot fork: $!" unless defined $pid;
	299	&change_uid_gid("$client");
f566ccb9 JL	300	&debug_msg("Executing ${$hash}{'command'} .... \n");
f566ccb9 JL	301	exec("${$hash}{'command'}");
cdf5b41f JL	302	}
	303	}
	304	}else{
	305	&debug_msg("No mail available\n");
	306	}
	307	}else{
	308	&debug_msg("Mbox format not yet supported.\n");
	309	exit(1);
	310	}
	311	}
	312
	313
	314
	315	sub launch(#){
	316	my $client=shift;
	317	#Launch the command of a simple client
	318	&debug_msg("Son $client, launching ${${$conf{'client'}}{$client}}{'command'}\n");
	319	#Change uid and gid if needed
	320	&change_uid_gid("$client");
	321	exec(${${$conf{'client'}}{$client}}{'command'});
	322	}
	323
	324
	325	sub main_loop {
	326
	327	my $ld;
	328	my $nchild;
	329
	330	while (1) {
	331
	332	if ($reload_conf == 1){
	333	#We have to load conf again
	334	$reload_conf=0;
	335	&debug_msg("Reloading configuration .... \n");
	336	&debug_msg(" Waiting all child to terminate ...");
	337	while ((my $kid=wait) != -1){
	338	$nchild--;
	339	delete($running{$kid});
	340	}
	341	&debug_msg("done\n");
	342	&debug_msg(" Restarting ...");
	343	&init;
f566ccb9	344	&init_sched;
cdf5b41f JL	345	&debug_msg("done\n");
	346	}
	347
	348
	349	if ($nchild >= $conf{'max_client'}){
	350	#We have to wait for one child (Blocking)"
	351	&debug_msg("Waiting for childs to terminate\n");
	352	my $kid=wait;
	353	if ($kid>0){
	354	&debug_msg("Kid=$kid est mort, c'�tait un $running{$kid}\n");
	355	$nchild--;
	356	delete($running{$kid});
	357	}
	358	}else{
	359	#Rip child terminated
	360	&debug_msg("Checking dead childs....\n");
	361	while ( (my $kid = waitpid(-1, WNOHANG)) > 0 ){
	362	&debug_msg("Kid=$kid est mort, c'�tait un $running{$kid}\n");
	363	$nchild--;
	364	delete($running{$kid});
	365	}
	366
	367	#Look for a client to execute
	368	my $ld = &get_load;
	369	&debug_msg("Load = $ld, processing\n");
	370	my $possible_client=&get_possible_client($ld);
	371	my @list=@{$possible_client};
	372	&debug_msg("Avant Trim : \n");
	373	&debug_msg(Dumper($possible_client));
	374	$possible_client=&trim_possible_client($possible_client);
	375	&debug_msg("Apr�s Trim : \n");
	376	&debug_msg(Dumper($possible_client));
	377	my $client=&get_next($possible_client);
	378	if ($client){
	379	#sleep(1);
	380	&debug_msg("$client was chosen, launching\n");
	381	$last_schedule{$client} = time ;
	382	if (my $pid = fork){
	383	#Pere, on marque qu'on l'a lanc�
	384	$running{$pid}="$client";
	385	$nchild++;
	386	&debug_msg("$client launched as PID $pid\n");
	387	&debug_msg(Dumper(\%running));
	388	&debug_msg(Dumper(\%launches));
	389	}else{
	390	#Fils
	391	if (${${$conf{'client'}}{$client}}{'mbox'}){
	392	#We have to send data ourselves
	393	&send_data("$client");
	394	}else{
	395	#We only have to execute a command
	396	&launch("$client");
	397	}
	398	exit(0);
	399	}
	400	}else{
	401	&debug_msg("No client runable\n");
	402	sleep($conf{'sleep_poll'});
	403	}
	404	sleep($conf{'active_poll'});
	405	}
	406	}
	407	}
	408
409
410
411	##########
412	## Main ##
413	##########
414
415	$SIG{HUP}=\&sigHUP_handler;
416	&init();
cdf5b41f	417	&check_conf();
f566ccb9	418	&init_sched();
cdf5b41f JL	419	&daemonize();
	420	&main_loop();
	421
	422