| 1 | #!/usr/bin/perl |
| 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 | |
| 11 | ################# |
| 12 | ## Global vars ## |
| 13 | ################# |
| 14 | |
| 15 | my $confile; |
| 16 | my %conf; |
| 17 | my %running; |
| 18 | my $reload_conf=0; |
| 19 | my $debug=0; |
| 20 | #For each process, uid and gid to set after fork |
| 21 | my %gid; |
| 22 | my %uid; |
| 23 | |
| 24 | #For sheduler |
| 25 | #Number of launch, for each daemon |
| 26 | my %launches; |
| 27 | my %ratio_launch_prio; |
| 28 | my %last_schedule; |
| 29 | |
| 30 | ############### |
| 31 | ## Functions ## |
| 32 | ############### |
| 33 | |
| 34 | sub sigHUP_handler{ |
| 35 | &debug_msg("got SIGHUP\n"); |
| 36 | $reload_conf=1; |
| 37 | } |
| 38 | |
| 39 | |
| 40 | #Read Configuration and init global vars |
| 41 | sub read_conf { |
| 42 | my $file = shift; |
| 43 | $config = new Config::General( -file =>"$file", |
| 44 | -AllowMultiOptions =>"yes", |
| 45 | -LowerCaseNames =>"yes",); |
| 46 | %conf = $config->getall; |
| 47 | &debug_msg(Dumper(\%conf)); |
| 48 | } |
| 49 | |
| 50 | |
| 51 | sub debug_msg(#){ |
| 52 | my $text=shift; |
| 53 | print STDERR $text unless ($debug == 0); |
| 54 | } |
| 55 | |
| 56 | |
| 57 | sub init { |
| 58 | #getopts('hf:', \%opts) or die "Illegal program option. ($0 -h for list)\n"; |
| 59 | #&debug_msg(Dumper(\%opts)); |
| 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 | 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", |
| 76 | "-d - debug mode\n"; |
| 77 | exit(1); |
| 78 | } |
| 79 | |
| 80 | if ($opts{'f'}){ |
| 81 | if (-r "$opts{'f'}") { |
| 82 | print STDERR "Using $opts{'f'} as config file\n"; |
| 83 | &read_conf("$opts{'f'}"); |
| 84 | } else { |
| 85 | print STDERR "$opts{'f'} : not a valid config file\n"; |
| 86 | exit(1); |
| 87 | } |
| 88 | } else { |
| 89 | print STDERR "Using $confile as config file\n"; |
| 90 | if (-r "$confile") { |
| 91 | &read_conf("$confile"); |
| 92 | } else { |
| 93 | print STDERR "No valid configuration file found, aborting\n"; |
| 94 | exit(1); |
| 95 | } |
| 96 | } |
| 97 | |
| 98 | if ($opts{'d'}){ |
| 99 | print STDERR "Running in debug mode ...\n"; |
| 100 | $debug = 1; |
| 101 | }else{ |
| 102 | $debug = 0; |
| 103 | } |
| 104 | } |
| 105 | |
| 106 | #init useful variables for scheduler |
| 107 | sub init_sched(){ |
| 108 | foreach my $arg (keys %{$conf{'client'}}){ |
| 109 | $launches{"$arg"}=0; |
| 110 | $ratio_launch_prio{"$arg"}=0; |
| 111 | $last_schedule{"$arg"}=0; |
| 112 | } |
| 113 | } |
| 114 | |
| 115 | #check configuration file |
| 116 | sub check_conf{ |
| 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'}"); |
| 124 | if ($id){ |
| 125 | $uid{"$arg"} = $id; |
| 126 | }else{ |
| 127 | print STDERR " Error, user ${$hash}{'run_as_user'} does not exist, please check...\n"; |
| 128 | exit(1); |
| 129 | } |
| 130 | } |
| 131 | if (${$hash}{'run_as_group'}){ |
| 132 | my $id = getgrnam("${$hash}{'run_as_group'}"); |
| 133 | if ($id){ |
| 134 | $gid{"$arg"} = $id; |
| 135 | }else{ |
| 136 | print STDERR " Error, group ${$hash}{'run_as_group'} does not exist, please check...\n"; |
| 137 | exit(1); |
| 138 | } |
| 139 | } |
| 140 | if (${$hash}{'allow_many'} eq "yes" and ${$hash}{'min_schedule'}){ |
| 141 | print STDERR " Error, allow_many and min_schedule defined for $arg\n"; |
| 142 | exit(1); |
| 143 | } |
| 144 | } |
| 145 | } |
| 146 | |
| 147 | |
| 148 | #make the program run in daemon mode |
| 149 | sub daemonize { |
| 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'}: $!"; |
| 156 | }else{ |
| 157 | open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!"; |
| 158 | } |
| 159 | defined(my $pid = fork) or die "Can't fork: $!"; |
| 160 | exit if $pid; |
| 161 | setsid or die "Can't start a new session: $!"; |
| 162 | #umask 0; |
| 163 | &debug_msg("Daemon started\n"); |
| 164 | } |
| 165 | |
| 166 | |
| 167 | #returns current load or any good value |
| 168 | sub get_load { |
| 169 | my $load = `$conf{"ldcmd"}`; |
| 170 | chomp($load); |
| 171 | return $load; |
| 172 | } |
| 173 | |
| 174 | #Return the list of client for which max_load is => ld |
| 175 | #param : load |
| 176 | sub get_possible_client(#){ |
| 177 | my $ld=shift; |
| 178 | my @list=(); |
| 179 | |
| 180 | foreach my $arg (keys %{$conf{'client'}}){ |
| 181 | my $hash = ${$conf{'client'}}{$arg}; |
| 182 | if (${$hash}{'max_load'} >= $ld){ |
| 183 | push(@list,$arg); |
| 184 | } |
| 185 | } |
| 186 | return \@list; |
| 187 | } |
| 188 | |
| 189 | |
| 190 | #Return the client that should be executed according to priorities |
| 191 | #given in conf file |
| 192 | # Refaire avec calcul du min de launches/prio ! |
| 193 | sub get_next(#){ |
| 194 | my $ref=shift; |
| 195 | my @possible_client = @{$ref}; |
| 196 | #List des proc executes assez souvent |
| 197 | my $client=""; |
| 198 | my $min_ratio=-1; |
| 199 | |
| 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"}; |
| 203 | $client=$arg; |
| 204 | } |
| 205 | } |
| 206 | |
| 207 | if ($client){ |
| 208 | #Update ratio for him |
| 209 | $launches{"$client"}++; |
| 210 | $ratio_launch_prio{"$client"}=$launches{"$client"}/${${$conf{'client'}}{$client}}{'priority'}; |
| 211 | return $client; |
| 212 | }else{ |
| 213 | &debug_msg("No client runnable in get_next\n"); |
| 214 | return; |
| 215 | } |
| 216 | return; |
| 217 | } |
| 218 | |
| 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(#){ |
| 223 | my $ref=shift; |
| 224 | my @out_list; |
| 225 | |
| 226 | |
| 227 | foreach my $arg (@$ref){ |
| 228 | if (${${$conf{'client'}}{$arg}}{'allow_many'} eq "no"){ |
| 229 | #Exec only one |
| 230 | if ((time - $last_schedule{$arg}) >= ${${$conf{'client'}}{$arg}}{'min_schedule'}){ |
| 231 | push(@out_list,$arg) unless grep($_ eq $arg, values %running); |
| 232 | } |
| 233 | }else{ |
| 234 | push(@out_list,$arg); |
| 235 | } |
| 236 | } |
| 237 | |
| 238 | return \@out_list; |
| 239 | } |
| 240 | |
| 241 | |
| 242 | sub change_uid_gid(#){ |
| 243 | my $client=shift; |
| 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"); |
| 248 | }else{ |
| 249 | &debug_msg("error, $!\n"); |
| 250 | exit(1); |
| 251 | } |
| 252 | } |
| 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"); |
| 257 | }else{ |
| 258 | &debug_msg("error, $!\n"); |
| 259 | exit(1); |
| 260 | } |
| 261 | } |
| 262 | } |
| 263 | |
| 264 | |
| 265 | #Sends mail on the input of the command (pipe) |
| 266 | sub send_data(#){ |
| 267 | my $client = shift; |
| 268 | my $hash = ${$conf{'client'}}{$client}; |
| 269 | if (${$hash}{'mbox'} =~ /\/$/){ #ok, maildir format |
| 270 | my $path = "${$hash}{'mbox'}"; |
| 271 | $path =~ s/\/$//igo; |
| 272 | &debug_msg("Sending datas for ${$hash}{'mbox'}\n"); |
| 273 | my @list=`ls -1 $path/new | head -n ${$hash}{'nb_mails'}`; |
| 274 | if ($#list >= 0){ |
| 275 | #Send files, one by one |
| 276 | foreach my $fich (@list){ |
| 277 | chomp($fich); |
| 278 | &debug_msg("File : $fich\n"); |
| 279 | if (my $pid = open(CHILD, "|-")) { |
| 280 | CHILD->autoflush(1); |
| 281 | if (open(DATA,"<$path/new/$fich")){ |
| 282 | while (my $line=<DATA>){ |
| 283 | print CHILD "$line"; |
| 284 | } |
| 285 | close(DATA); |
| 286 | &debug_msg("$path/new/$fich -> $path/cur/$fich ... "); |
| 287 | if (rename("$path/new/$fich","$path/cur/$fich")){ |
| 288 | &debug_msg("ok\n"); |
| 289 | }else{ |
| 290 | print STDERR "Error moving $path/new/$fich, keeped : $!\n"; |
| 291 | } |
| 292 | }else{ |
| 293 | print STDERR "Error opening $path/new/$fich : $!\n"; |
| 294 | exit(1); |
| 295 | } |
| 296 | close(CHILD); |
| 297 | } else { |
| 298 | die "cannot fork: $!" unless defined $pid; |
| 299 | &change_uid_gid("$client"); |
| 300 | &debug_msg("Executing ${$hash}{'command'} .... \n"); |
| 301 | exec("${$hash}{'command'}"); |
| 302 | } |
| 303 | } |
| 304 | }else{ |
| 305 | &debug_msg("No mail available\n"); |
| 306 | } |
| 307 | }else{ |
| 308 | &debug_msg("Mbox format not yet supported.\n"); |
| 309 | exit(1); |
| 310 | } |
| 311 | } |
| 312 | |
| 313 | |
| 314 | |
| 315 | sub launch(#){ |
| 316 | my $client=shift; |
| 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'}); |
| 322 | } |
| 323 | |
| 324 | |
| 325 | sub main_loop { |
| 326 | |
| 327 | my $ld; |
| 328 | my $nchild; |
| 329 | |
| 330 | while (1) { |
| 331 | |
| 332 | if ($reload_conf == 1){ |
| 333 | #We have to load conf again |
| 334 | $reload_conf=0; |
| 335 | &debug_msg("Reloading configuration .... \n"); |
| 336 | &debug_msg(" Waiting all child to terminate ..."); |
| 337 | while ((my $kid=wait) != -1){ |
| 338 | $nchild--; |
| 339 | delete($running{$kid}); |
| 340 | } |
| 341 | &debug_msg("done\n"); |
| 342 | &debug_msg(" Restarting ..."); |
| 343 | &init; |
| 344 | &init_sched; |
| 345 | &debug_msg("done\n"); |
| 346 | } |
| 347 | |
| 348 | |
| 349 | if ($nchild >= $conf{'max_client'}){ |
| 350 | #We have to wait for one child (Blocking)" |
| 351 | &debug_msg("Waiting for childs to terminate\n"); |
| 352 | my $kid=wait; |
| 353 | if ($kid>0){ |
| 354 | &debug_msg("Kid=$kid est mort, c'était un $running{$kid}\n"); |
| 355 | $nchild--; |
| 356 | delete($running{$kid}); |
| 357 | } |
| 358 | }else{ |
| 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"); |
| 363 | $nchild--; |
| 364 | delete($running{$kid}); |
| 365 | } |
| 366 | |
| 367 | #Look for a client to execute |
| 368 | my $ld = &get_load; |
| 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); |
| 378 | if ($client){ |
| 379 | #sleep(1); |
| 380 | &debug_msg("$client was chosen, launching\n"); |
| 381 | $last_schedule{$client} = time ; |
| 382 | if (my $pid = fork){ |
| 383 | #Pere, on marque qu'on l'a lancé |
| 384 | $running{$pid}="$client"; |
| 385 | $nchild++; |
| 386 | &debug_msg("$client launched as PID $pid\n"); |
| 387 | &debug_msg(Dumper(\%running)); |
| 388 | &debug_msg(Dumper(\%launches)); |
| 389 | }else{ |
| 390 | #Fils |
| 391 | if (${${$conf{'client'}}{$client}}{'mbox'}){ |
| 392 | #We have to send data ourselves |
| 393 | &send_data("$client"); |
| 394 | }else{ |
| 395 | #We only have to execute a command |
| 396 | &launch("$client"); |
| 397 | } |
| 398 | exit(0); |
| 399 | } |
| 400 | }else{ |
| 401 | &debug_msg("No client runable\n"); |
| 402 | sleep($conf{'sleep_poll'}); |
| 403 | } |
| 404 | sleep($conf{'active_poll'}); |
| 405 | } |
| 406 | } |
| 407 | } |
| 408 | |
| 409 | |
| 410 | |
| 411 | ########## |
| 412 | ## Main ## |
| 413 | ########## |
| 414 | |
| 415 | $SIG{HUP}=\&sigHUP_handler; |
| 416 | &init(); |
| 417 | &check_conf(); |
| 418 | &init_sched(); |
| 419 | &daemonize(); |
| 420 | &main_loop(); |
| 421 | |
| 422 | |