-#!/usr/bin/perl
+#!/usr/bin/perl -w
use Config::General;
use Data::Dumper;
use POSIX qw(setsid setuid setgid);
use POSIX ":sys_wait_h";
+use strict;
+
#################
-## Global vars ##
+## Global vars ##
#################
-my $confile;
+my $confile = '';
my %conf;
my %running;
my $reload_conf=0;
###############
sub sigHUP_handler{
- &debug_msg("got SIGHUP\n");
- $reload_conf=1;
+ &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));
+ my $file = shift;
+ my $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);
+ 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;
- }
+
+ 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);
+ }
+ }
+
+ my %opts;
+ 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;
- }
+ foreach my $arg (keys %{$conf{'client'}}){
+ $launches{$arg} = 0;
+ $ratio_launch_prio{$arg} = 0;
+ $last_schedule{$arg} = 0;
+ }
}
-#check configuration file
+#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);
- }
- }
+ &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){
+ $conf{'client'}{$arg}{'uid'} = $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){
+ $conf{'client'}{$arg}{'gid'} = $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");
+ 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;
+ my $load = 100;
+ if (open(LOAD, '</proc/loadavg')) {
+ my $line = <LOAD>;
+ ($load) = ($line =~ m/(\d+\.\d+)/);
+ close(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;
+ 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;
+ 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;
+ 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);
- }
- }
+ my $client = shift;
+ if ($conf{'client'}{$client}{'gid'}){
+ &debug_msg("Changing gid to $conf{'client'}{$client}{'gid'} for $client ...");
+# $( = $conf{'client'}{$client}{'gid'};
+# $) = $conf{'client'}{$client}{'gid'};
+ if (POSIX::setgid($conf{'client'}{$client}{'gid'})){
+ &debug_msg("done\n");
+ } else {
+ &debug_msg("error, $!\n");
+ exit(1);
+ }
+ }
+ if ($conf{'client'}{$client}{'uid'}){
+ &debug_msg("Changing uid to $conf{'client'}{$client}{'uid'} for $client ...");
+# $< = $conf{'client'}{$client}{'uid'};
+# $> = $conf{'client'}{$client}{'uid'};
+ if (POSIX::setuid($conf{'client'}{$client}{'uid'})){
+ &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 send_data(#) {
+ # TODO check that the child has properly finished before moving
+ # the file tu cur/
+ my $client = shift;
+ my $fich = shift;
+ &debug_msg("run $conf{'client'}{$client}{'command'} with file $fich for $client\n");
+ my $pid = fork;
+ if (!defined $pid) {
+ die "cannot fork $!";
+ } elsif ($pid == 0) {
+ # fils
+ if (open(STDIN, '<', $fich)) {
+ &change_uid_gid($client);
+ &debug_msg("sending output to $conf{'client'}{$client}{'command'} with file $fich for $client $fich openned\n");
+ exec $conf{'client'}{$client}{'command'} or die "exec error $!";
+ } else {
+ die "Error opening $fich : $!\n";
+ }
+ } else {
+ # père
+ wait;
+ &debug_msg("sending output to $conf{'client'}{$client}{'command'} with file $fich for $client done\n");
+ # return true if the program exited normaly
+ return ($? >> 8) == 0;
+ }
+}
+
+sub list_files(#) {
+ my $client = shift;
+ my %hash = %{$conf{'client'}{$client}};
+ if ($hash{'mbox'} =~ /\/$/) { #ok, maildir format
+ my @tomove;
+ my @args;
+ my $path = $hash{'mbox'};
+ $path =~ s/\/$//igo; # suppress the final /
+ &debug_msg("Sending datas for $hash{'mbox'}\n");
+ # read the dir
+ if (opendir MAILDIR, "$path/new") {
+ my $nb_left = $hash{'nb_mails'};
+ while (my $fich = readdir MAILDIR) {
+ # skip . and ..
+ next if ($fich eq "." or $fich eq "..");
+ # read the dir until the max number of mail is done
+ &debug_msg("nb_left : $nb_left\n");
+ last if ($nb_left-- == 0);
+ &debug_msg("File : $fich\n");
+ # if add_to_cmdline is true, add to the list
+ if ($hash{'add_to_cmdline'}) {
+ push @args, $fich;
+ } else {
+ # else run the command for each file
+ if (&send_data($client, "$path/new/$fich")) {
+ push @tomove, $fich;
+ }
+ }
+ &debug_msg("Done file : $fich, $?\n");
+ }
+ closedir MAILDIR;
+ } else {
+ print STDERR "Error opening $path/new : $!\n";
+ }
+ # if add_to_cmdline is true and there are files to treat,
+ # run the command
+ if ($hash{'add_to_cmdline'} and scalar @args > 0) {
+ chdir "$path/new" or die "Cannot chdir to $path/new : $!";
+ &debug_msg("run $hash{'command'} with files @args for $client\n");
+ my @cmd = split(/ /, $hash{'command'});
+ push @cmd, @args;
+ &debug_msg("@cmd\n");
+ my $pid = fork;
+ if (!defined $pid) {
+ die "cannot fork $!";
+ } elsif ($pid == 0) {
+ # fils
+ &change_uid_gid($client);
+ exec @cmd or die "exec error $!";
+ } else {
+ # père
+ wait;
+ my $status = $? >> 8;
+ if ($status == 0) {
+ # if the command didn't fail, mark the files to be moved
+ @tomove = @args;
+ }
+ }
+ }
+ # if there is files to move, moves them
+ foreach my $fich (@tomove) {
+ &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 {
+ &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'});
+ my $client = shift;
+ &change_uid_gid($client);
+ #Launch the command of a simple client
+ &debug_msg("Son $client, launching $conf{'client'}{$client}{'command'}\n");
+ 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'});
- }
- }
+
+ my $ld;
+ my $nchild = 0;
+
+ 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) {
+ &debug_msg("$client was chosen, launching\n");
+ $last_schedule{$client} = time ;
+ my $pid = fork;
+ if (!defined $pid) {
+ print STDERR "cannot fork: $!\n";
+ } elsif ($pid != 0) {
+ #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
+ &list_files($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'});
+ }
+ }
}
&init();
&check_conf();
&init_sched();
-&daemonize();
&main_loop();
-
-
projects / old-projects.git / commitdiff