muxdaemon/muxdaemon.pl

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