initial commit of file from CVS for smeserver-altqmail on Sat Sep 7 20:06:59 AEST 2024

2024-09-07 20:06:59 +10:00
parent c535ecdbab
commit 8a31f1fcf2
31 changed files with 901 additions and 2 deletions
--- a/root/var/service/altqmail/qmail-remote-throttle
+++ b/root/var/service/altqmail/qmail-remote-throttle
@@ -0,0 +1,119 @@
+#!/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";
+}
+