6d5c4cc822be0874e0bb6d9dc73110a91dd01451
7 use POSIX
qw(setsid setuid setgid
);
8 use POSIX
":sys_wait_h";
20 #For each process, uid and gid to set after fork
25 #Number of launch, for each daemon
27 my %ratio_launch_prio;
35 &debug_msg
("got SIGHUP\n");
40 #Read Configuration and init global vars
43 $config = new Config
::General
( -file
=>"$file",
44 -AllowMultiOptions
=>"yes",
45 -LowerCaseNames
=>"yes",);
46 %conf = $config->getall;
47 &debug_msg
(Dumper
(\
%conf));
53 print STDERR
$text unless ($debug == 0);
58 #getopts('hf:', \%opts) or die "Illegal program option. ($0 -h for list)\n";
59 #&debug_msg(Dumper(\%opts));
65 $confile="$path/muxdaemon.conf";
67 print STDERR
"Error : unable to get working directory, $!\n";
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",
81 if (-r
"$opts{'f'}") {
82 print STDERR
"Using $opts{'f'} as config file\n";
83 &read_conf
("$opts{'f'}");
85 print STDERR
"$opts{'f'} : not a valid config file\n";
89 print STDERR
"Using $confile as config file\n";
91 &read_conf
("$confile");
93 print STDERR
"No valid configuration file found, aborting\n";
99 print STDERR
"Running in debug mode ...\n";
106 #init useful variables for scheduler
108 foreach my $arg (keys %{$conf{'client'}}){
110 $ratio_launch_prio{"$arg"}=0;
111 $last_schedule{"$arg"}=0;
115 #check configuration file
117 &debug_msg
("Salut\n");
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'}");
127 print STDERR
" Error, user ${$hash}{'run_as_user'} does not exist, please check...\n";
131 if (${$hash}{'run_as_group'}){
132 my $id = getgrnam("${$hash}{'run_as_group'}");
136 print STDERR
" Error, group ${$hash}{'run_as_group'} does not exist, please check...\n";
140 if (${$hash}{'allow_many'} eq "yes" and ${$hash}{'min_schedule'}){
141 print STDERR
" Error, allow_many and min_schedule defined for $arg\n";
148 #make the program run in daemon mode
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'}: $!";
157 open STDERR, '>>/dev/null' or die "Can
't write to /dev/null: $!";
159 defined(my $pid = fork) or die "Can't
fork: $!";
161 setsid or die "Can
't start a new session: $!";
163 &debug_msg("Daemon started\n");
167 #returns current load or any good value
169 my $load = `$conf{"ldcmd"}`;
174 #Return the list of client for which max_load is => ld
176 sub get_possible_client(#){
180 foreach my $arg (keys %{$conf{'client
'}}){
181 my $hash = ${$conf{'client
'}}{$arg};
182 if (${$hash}{'max_load
'} >= $ld){
190 #Return the client that should be executed according to priorities
192 # Refaire avec calcul du min de launches/prio !
195 my @possible_client = @{$ref};
196 #List des proc executes assez souvent
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"};
208 #Update ratio for him
209 $launches{"$client"}++;
210 $ratio_launch_prio{"$client"}=$launches{"$client"}/${${$conf{'client
'}}{$client}}{'priority
'};
213 &debug_msg("No client runnable in get_next\n");
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
(#){
227 foreach my $arg (@
$ref){
228 if (${${$conf{'client'}}{$arg}}{'allow_many'} eq "no"){
230 if ((time - $last_schedule{$arg}) >= ${${$conf{'client'}}{$arg}}{'min_schedule'}){
231 push(@out_list,$arg) unless grep($_ eq $arg, values %running);
234 push(@out_list,$arg);
242 sub change_uid_gid
(#){
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");
249 &debug_msg
("error, $!\n");
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");
258 &debug_msg
("error, $!\n");
265 #Sends mail on the input of the command (pipe)
268 my $hash = ${$conf{'client'}}{$client};
269 if (${$hash}{'mbox'} =~ /\/$/){ #ok, maildir format
270 my $path = "${$hash}{'mbox'}";
272 &debug_msg
("Sending datas for ${$hash}{'mbox'}\n");
273 my @list=`ls -1 $path/new | head -n ${$hash}{'nb_mails'}`;
275 #Send files, one by one
276 foreach my $fich (@list){
278 &debug_msg
("File : $fich\n");
279 if (my $pid = open(CHILD
, "|-")) {
281 if (open(DATA
,"<$path/new/$fich")){
282 while (my $line=<DATA
>){
286 &debug_msg
("$path/new/$fich -> $path/cur/$fich ... ");
287 if (rename("$path/new/$fich","$path/cur/$fich")){
290 print STDERR
"Error moving $path/new/$fich, keeped : $!\n";
293 print STDERR
"Error opening $path/new/$fich : $!\n";
298 die "cannot fork: $!" unless defined $pid;
299 &change_uid_gid
("$client");
300 &debug_msg
("Executing ${$hash}{'command'} .... \n");
301 exec("${$hash}{'command'}");
305 &debug_msg
("No mail available\n");
308 &debug_msg
("Mbox format not yet supported.\n");
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'});
332 if ($reload_conf == 1){
333 #We have to load conf again
335 &debug_msg
("Reloading configuration .... \n");
336 &debug_msg
(" Waiting all child to terminate ...");
337 while ((my $kid=wait) != -1){
339 delete($running{$kid});
341 &debug_msg
("done\n");
342 &debug_msg
(" Restarting ...");
345 &debug_msg
("done\n");
349 if ($nchild >= $conf{'max_client'}){
350 #We have to wait for one child (Blocking)"
351 &debug_msg
("Waiting for childs to terminate\n");
354 &debug_msg
("Kid=$kid est mort, c'était un $running{$kid}\n");
356 delete($running{$kid});
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");
364 delete($running{$kid});
367 #Look for a client to execute
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);
380 &debug_msg
("$client was chosen, launching\n");
381 $last_schedule{$client} = time ;
383 #Pere, on marque qu'on l'a lancé
384 $running{$pid}="$client";
386 &debug_msg
("$client launched as PID $pid\n");
387 &debug_msg
(Dumper
(\
%running));
388 &debug_msg
(Dumper
(\
%launches));
391 if (${${$conf{'client'}}{$client}}{'mbox'}){
392 #We have to send data ourselves
393 &send_data
("$client");
395 #We only have to execute a command
401 &debug_msg
("No client runable\n");
402 sleep($conf{'sleep_poll'});
404 sleep($conf{'active_poll'});
415 $SIG{HUP
}=\
&sigHUP_handler
;