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;
29 my $priority_ref = "";
36 &debug_msg
("got SIGHUP\n");
41 #Read Configuration and init global vars
44 $config = new Config
::General
( -file
=>"$file",
45 -AllowMultiOptions
=>"yes",
46 -LowerCaseNames
=>"yes",);
47 %conf = $config->getall;
48 &debug_msg
(Dumper
(\
%conf));
61 #getopts('hf:', \%opts) or die "Illegal program option. ($0 -h for list)\n";
62 #&debug_msg(Dumper(\%opts));
68 $confile="$path/muxdaemon.conf";
70 print STDERR
"Error : unable to get working directory, $!\n";
75 if ( not getopts
('dhf:', \
%opts) or $opts{'h'}) {
76 print STDERR
"\nThis is mail processing Daemon :\n",
77 "-h - this help message\n",
78 "-f <file> - use <file> as config file\n",
84 if (-r
"$opts{'f'}") {
85 print STDERR
"Using $opts{'f'} as config file\n";
86 &read_conf
("$opts{'f'}");
88 print STDERR
"$opts{'f'} : not a valid config file\n";
92 print STDERR
"Using $confile as config file\n";
94 &read_conf
("$confile");
96 print STDERR
"No valid configuration file found, aborting\n";
110 my $min_priority=100;
111 foreach my $arg (keys %{$conf{'client'}}){
113 $ratio_launch_prio{"$arg"}=0;
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'}");
128 print STDERR
" Error, user ${$hash}{'run_as_user'} does not exist, please check...\n";
132 if (${$hash}{'run_as_group'}){
133 my $id = getgrnam("${$hash}{'run_as_group'}");
137 print STDERR
" Error, group ${$hash}{'run_as_group'} does not exist, please check...\n";
141 if (${$hash}{'allow_many'} eq "yes" and ${$hash}{'min_schedule'}){
142 print STDERR
" Error, allow_many and min_schedule defined for $arg\n";
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 my $load = `$conf{"ldcmd"}`;
169 #&debug_msg("$load\n");
173 #Return the list of client for which max_load is => ld
174 sub get_possible_client(#){
177 #&debug_msg("get_possible_client, load = $ld\n");
178 foreach my $arg (keys %{$conf{'client
'}}){
179 #&debug_msg("get_possible_client : Trying client $arg :");
180 my $hash = ${$conf{'client
'}}{$arg};
181 if (${$hash}{'max_load
'} >= $ld){
182 #&debug_msg("max_load = ".${$hash}{'max_load
'}." => in\n");
185 #&debug_msg("max_load = ".${$hash}{'max_load
'}." => out\n");
192 #Return the client that should be executed according to priorities
194 # Refaire avec calcul du min de launches/prio !
197 my @possible_client = @{$ref};
198 #List des proc executes assez souvent
202 foreach my $arg (@possible_client){
203 if ($ratio_launch_prio{"$arg"} < $min_ratio or $min_ratio == -1){
204 $min_ratio=$ratio_launch_prio{"$arg"};
210 #Update ratio for him
211 $launches{"$client"}++;
212 $ratio_launch_prio{"$client"}=$launches{"$client"}/${${$conf{'client
'}}{$client}}{'priority
'};
215 &debug_msg("No client runnable in get_next\n");
221 #Elimine les clients présent dans la liste qui sont en cours d'éxécution et
222 #qui n'ont pas le allow_many (pour pas les éxécuter deux fois)
223 #Elimine aussi les clients qui ont terminé depuis moins que min_schedule
224 sub trim_possible_client
(#){
229 foreach my $arg (@
$ref){
230 if (${${$conf{'client'}}{$arg}}{'allow_many'} eq "no"){
232 if ((time - $last_schedule{$arg}) >= ${${$conf{'client'}}{$arg}}{'min_schedule'}){
233 push(@out_list,$arg) unless grep($_ eq $arg, values %running);
236 push(@out_list,$arg);
244 sub change_uid_gid
(#){
246 if ($gid{"$client"}){
247 &debug_msg
("Changing gid to $gid{$client} for $client ...");
248 if (POSIX
::setgid
($gid{"$client"})){
249 &debug_msg
("done\n");
251 &debug_msg
("error, $!\n");
255 if ($uid{"$client"}){
256 &debug_msg
("Changing uid to $uid{$client} for $client ...");
257 if (POSIX
::setuid
($uid{"$client"})){
258 &debug_msg
("done\n");
260 &debug_msg
("error, $!\n");
267 #Sends mail on the input of the command (pipe)
270 if (${${$conf{'client'}}{$client}}{'mbox'} =~ /\/$/){
271 &debug_msg
("Sending datas for ${${$conf{'client'}}{$client}}{'mbox'}\n");
272 my @list=`ls -1 ${${$conf{'client'}}{$client}}{'mbox'}/new | head -n ${${$conf{'client'}}{$client}}{'nb_mails'}`;
274 #Send files, one by one
275 foreach my $fich (@list){
276 &debug_msg
("File : $fich\n");
277 if (my $pid = open(CHILD
, "|-")) {
279 &debug_msg
("Parent Pid $$\n");
280 if (open(DATA
,"<${${$conf{'client'}}{$client}}{'mbox'}/new/$fich")){
281 while (my $line=<DATA
>){
283 #&debug_msg("Sending : $line");
287 &debug_msg
("Error opening ${${$conf{'client'}}{$client}}{'mbox'}/new/$fich : $!\n");
291 #unlink("${${$conf{'client'}}{$client}}{'mbox'}/new/$fich");
293 die "cannot fork: $!" unless defined $pid;
294 &change_uid_gid
("$client");
295 &debug_msg
("Executing ${${$conf{'client'}}{$client}}{'command'} .... \n");
296 exec("${${$conf{'client'}}{$client}}{'command'}");
300 &debug_msg
("No mail available\n");
303 &debug_msg
("Mbox format not yet supported.\n");
312 #Launch the command of a simple client
313 &debug_msg
("Son $client, launching ${${$conf{'client'}}{$client}}{'command'}\n");
314 #Change uid and gid if needed
315 &change_uid_gid
("$client");
316 exec(${${$conf{'client'}}{$client}}{'command'});
327 if ($reload_conf == 1){
328 #We have to load conf again
330 &debug_msg
("Reloading configuration .... \n");
331 &debug_msg
(" Waiting all child to terminate ...");
332 while ((my $kid=wait) != -1){
334 delete($running{$kid});
336 &debug_msg
("done\n");
337 &debug_msg
(" Restarting ...");
340 &debug_msg
("done\n");
344 if ($nchild >= $conf{'max_client'}){
345 #We have to wait for one child (Blocking)"
346 &debug_msg
("Waiting for childs to terminate\n");
349 &debug_msg
("Kid=$kid est mort, c'était un $running{$kid}\n");
351 delete($running{$kid});
354 #Rip child terminated
355 &debug_msg
("Checking dead childs....\n");
356 while ( (my $kid = waitpid(-1, WNOHANG
)) > 0 ){
357 &debug_msg
("Kid=$kid est mort, c'était un $running{$kid}\n");
359 delete($running{$kid});
362 #Look for a client to execute
364 &debug_msg
("Load = $ld, processing\n");
365 my $possible_client=&get_possible_client
($ld);
366 my @list=@
{$possible_client};
367 &debug_msg
("Avant Trim : \n");
368 &debug_msg
(Dumper
($possible_client));
369 $possible_client=&trim_possible_client
($possible_client);
370 &debug_msg
("Après Trim : \n");
371 &debug_msg
(Dumper
($possible_client));
372 my $client=&get_next
($possible_client);
375 &debug_msg
("$client was chosen, launching\n");
376 $last_schedule{$client} = time ;
378 #Pere, on marque qu'on l'a lancé
379 $running{$pid}="$client";
381 &debug_msg
("$client launched as PID $pid\n");
382 &debug_msg
(Dumper
(\
%running));
383 &debug_msg
(Dumper
(\
%launches));
386 if (${${$conf{'client'}}{$client}}{'mbox'}){
387 #We have to send data ourselves
388 &send_data
("$client");
390 #We only have to execute a command
396 &debug_msg
("No client runable\n");
397 sleep($conf{'sleep_poll'});
399 sleep($conf{'active_poll'});
410 $SIG{HUP
}=\
&sigHUP_handler
;