--- /dev/null
+#!/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;
+my $priority_ref = "";
+
+###############
+## 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 $msg=shift;
+ if ($debug == 1){
+ print STDERR $msg;
+ }
+}
+
+
+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'}){
+ $debug = 1;
+ }else{
+ $debug = 0;
+ }
+
+}
+
+sub init_launches(){
+ my $min_priority=100;
+ foreach my $arg (keys %{$conf{'client'}}){
+ $launches{"$arg"}=0;
+ $ratio_launch_prio{"$arg"}=0;
+ }
+}
+
+
+sub check_conf(){
+ 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);
+ }
+ }
+}
+
+
+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");
+}
+
+sub get_load {
+ my $load = `$conf{"ldcmd"}`;
+ chop($load);
+ #&debug_msg("$load\n");
+ return $load;
+}
+
+#Return the list of client for which max_load is => ld
+sub get_possible_client(#){
+ my $ld=shift;
+ my @list=();
+ #&debug_msg("get_possible_client, load = $ld\n");
+ foreach my $arg (keys %{$conf{'client'}}){
+ #&debug_msg("get_possible_client : Trying client $arg :");
+ my $hash = ${$conf{'client'}}{$arg};
+ if (${$hash}{'max_load'} >= $ld){
+ #&debug_msg("max_load = ".${$hash}{'max_load'}." => in\n");
+ push(@list,$arg);
+ }else{
+ #&debug_msg("max_load = ".${$hash}{'max_load'}." => out\n");
+ }
+ }
+ 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;
+ if (${${$conf{'client'}}{$client}}{'mbox'} =~ /\/$/){
+ &debug_msg("Sending datas for ${${$conf{'client'}}{$client}}{'mbox'}\n");
+ my @list=`ls -1 ${${$conf{'client'}}{$client}}{'mbox'}/new | head -n ${${$conf{'client'}}{$client}}{'nb_mails'}`;
+ if ($#list >= 0){
+ #Send files, one by one
+ foreach my $fich (@list){
+ &debug_msg("File : $fich\n");
+ if (my $pid = open(CHILD, "|-")) {
+ CHILD->autoflush(1);
+ &debug_msg("Parent Pid $$\n");
+ if (open(DATA,"<${${$conf{'client'}}{$client}}{'mbox'}/new/$fich")){
+ while (my $line=<DATA>){
+ print CHILD "$line";
+ #&debug_msg("Sending : $line");
+ }
+ close(DATA);
+ }else{
+ &debug_msg("Error opening ${${$conf{'client'}}{$client}}{'mbox'}/new/$fich : $!\n");
+ exit(1);
+ }
+ close(CHILD);
+ #unlink("${${$conf{'client'}}{$client}}{'mbox'}/new/$fich");
+ } else {
+ die "cannot fork: $!" unless defined $pid;
+ &change_uid_gid("$client");
+ &debug_msg("Executing ${${$conf{'client'}}{$client}}{'command'} .... \n");
+ exec("${${$conf{'client'}}{$client}}{'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_launches;
+ &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();
+&init_launches();
+&check_conf();
+&daemonize();
+&main_loop();
+
+
projects / old-projects.git / commitdiff