my %launches;
my %ratio_launch_prio;
my %last_schedule;
-my $priority_ref = "";
###############
## Functions ##
sub debug_msg(#){
- my $msg=shift;
- if ($debug == 1){
- print STDERR $msg;
- }
+ my $text=shift;
+ print STDERR $text unless ($debug == 0);
}
}
if ($opts{'d'}){
+ print STDERR "Running in debug mode ...\n";
$debug = 1;
}else{
$debug = 0;
}
-
}
-sub init_launches(){
- my $min_priority=100;
+#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;
}
}
-
-sub check_conf(){
+#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
}
}
-
+
+#make the program run in daemon mode
sub daemonize {
print STDERR "Forking ... \n";
chdir '/' or die "Can't chdir to /: $!";
defined(my $pid = fork) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
- umask 0;
+ #umask 0;
&debug_msg("Daemon started\n");
}
+
+#returns current load or any good value
sub get_load {
my $load = `$conf{"ldcmd"}`;
- chop($load);
- #&debug_msg("$load\n");
+ 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=();
- #&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;
#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'}`;
+ 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);
- &debug_msg("Parent Pid $$\n");
- if (open(DATA,"<${${$conf{'client'}}{$client}}{'mbox'}/new/$fich")){
+ if (open(DATA,"<$path/new/$fich")){
while (my $line=<DATA>){
print CHILD "$line";
- #&debug_msg("Sending : $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{
- &debug_msg("Error opening ${${$conf{'client'}}{$client}}{'mbox'}/new/$fich : $!\n");
+ print STDERR "Error opening $path/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'}");
+ &debug_msg("Executing ${$hash}{'command'} .... \n");
+ exec("${$hash}{'command'}");
}
}
}else{
&debug_msg("done\n");
&debug_msg(" Restarting ...");
&init;
- &init_launches;
+ &init_sched;
&debug_msg("done\n");
}
$SIG{HUP}=\&sigHUP_handler;
&init();
-&init_launches();
&check_conf();
+&init_sched();
&daemonize();
&main_loop();