120 lines
2.3 KiB
Plaintext
120 lines
2.3 KiB
Plaintext
|
#!/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";
|
||
|
|
}
|
||
|
|
|