smeserver-altqmail/root/var/service/altqmail/qmail-remote-throttle

120 lines
2.3 KiB
Perl

#!/usr/bin/perl
use Fcntl ':flock';
$QMAIL = "/var/qmail";
$CONTROL = "$QMAIL/control";
open LOG, ">>", "/tmp/qmail-remote-log";
{ my $ofh = select LOG; $|=1; select $ofh; }
Log("starting");
$msgs = 0;
$time = 0;
load_policy();
while(1) {
my @last = grep {$_ > time() - $time} read_log();
Log("status " . @last . "/$msgs");
if (@last >= $msgs) {
# Log("sleeping");
} else {
last;
}
while (@last >= $msgs) {
my $oldest = $last[0];
my $age = time() - $oldest;
# When will the oldest message expire off the queue?
# The end of the queue is $time seconds ago
# The age of the oldest message is now time() - $oldest
# The oldest message will expire in $time - $age seconds
my $zzz = $time - $age + int(rand(3));
$zzz = 1 if $zzz < 1;
# Log("Sleeping for $zzz secs");
sleep $zzz;
shift @last while @last && $last[0] < time() - $time;
load_policy();
}
}
append_log(time());
#if (open F, ">>", "/tmp/qmail-remote-log") {
# print F time(), " @ARGV\n";
#}
Log("sending @ARGV");
exec "/var/qmail/bin/qmail-remote.real", @ARGV;
exit 0;
sub fail {
my $msg = shift;
Log("fail: $msg");
print "Z$msg";
exit 0;
}
my $last_policy_load ;
sub load_policy {
my $POLICY = "$CONTROL/outratelimit";
return if ((stat($POLICY))[9] <= $last_policy_load);
if (open F, "<", $POLICY) {
chomp(my $line = <F>);
($msgs, $time) = split m{/}, $line;
if (defined $last_policy_load) {
Log("Policy changed to $msgs/$time");
}
$last_policy_load = time();
close F;
}
}
sub read_log {
lock_semaphore(LOCK_SH);
my @last;
if (open(F, "+<", "$CONTROL/outlog")) {
chomp(@last = <F>);
close F;
}
lock_semaphore(LOCK_UN);
return @last;
}
sub append_log {
lock_semaphore(LOCK_EX);
if (open(F, "+<", "$CONTROL/outlog")) {
my @last = grep {$_ > time() - $time} <F>;
chomp(@last);
truncate F, 0;
seek F, 0, 0;
print F join "\n", @last, @_, "";
close F;
}
lock_semaphore(LOCK_UN);
}
sub lock_semaphore {
if (open SEM, ">", "$CONTROL/qmail-remote-semaphore") {
flock(SEM, $_[0]) or fail("Couldn't lock semaphore: $!");
} else {
fail("Couldn't open semaphore: $!");
}
}
sub Log {
my @args = @_;
tr/\n//d for @args;
print LOG time(), " $$ @args\n";
}