Add old RSE admin scripts

This commit is contained in:
Peter Simons 2001-01-18 15:31:30 +00:00
parent f6fbe740a0
commit a7691cdfaa
2 changed files with 151 additions and 0 deletions

76
petidomo-approve Executable file
View File

@ -0,0 +1,76 @@
:
eval 'exec perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
##
## petidomo-approve -- Petidomo approval tool
## Copyright (c) 2000 Ralf S. Engelschall <rse@engelschall.com>
##
# locate the file with the approval passwords
my $config = "$ENV{HOME}/.petidomo";
# locate the Sendmail program
my $sendmail = "sendmail";
foreach my $dir (split(/:/, "$ENV{PATH}:/bin:/sbin:/usr/bin:/usr/sbin:/lib:/usr/lib")) {
if (-x "$dir/sendmail") {
$sendmail = "$dir/sendmail";
last;
}
}
# suck in the whole mail
my $mail = '';
$mail .= $_ while (<STDIN>);
# dispatch over the two mail types which need approval...
if ($mail =~ m|^Subject:\s+Petidomo:\s+APPROVE\s+(\S+):|mi) {
# approve a request
my $list = $1;
my $replyto = 'petidomo';
$replyto = $1 if ($mail =~ m|^Reply-to:\s+(\S+)|mi);
my $password = 'petidomo';
open(FP, "<$config");
while (<FP>) {
next if (m|^\s*#.*| or m|^\s*$|);
$password = $1 if (m|^\s*(?:$list)\s+(\S+)|);
}
close(FP);
$mail =~ s|^.+?\n(password\s+<AdminPassword>.+?)\n\n.*|$1|s;
$mail =~ s|<AdminPassword>|$password|s;
open(SM, "|$sendmail $replyto") || die "cannot spawn $sendmail";
print SM "To: $replyto\n\n";
print SM $mail;
close(SM);
print STDERR "petidomo-approve: sent approved mail back to $replyto\n";
sleep(1);
exit(0);
}
elsif ($mail =~ m|^Subject:\s+Petidomo:\s+BOUNCE|mi) {
# approve a posting
my $list = 'petidomo';
$list = $1 if ($mail =~ m|^Subject:\s+Petidomo:\s+BOUNCE\s+(\S+):|m);
my $replyto = $list;
my $password = 'petidomo';
open(FP, "<$config");
while (<FP>) {
next if (m|^\s*#.*| or m|^\s*$|);
$password = $1 if (m|^\s*(?:$list)\s+(\S+)|);
}
close(FP);
$mail =~ s|^.+?\n\n||s;
$mail =~ s|^.+?\n>?From .+?\n||s;
$mail = "Approved: $password\n" . $mail; # best
#$mail =~ s|^(.+?\n\n)(.*)$|$1Approved $password\n$2|s; # not good
open(SM, "|$sendmail $replyto") || die "cannot spawn $sendmail";
print SM $mail;
close(SM);
print STDERR "petidomo-approve: sent approved mail back to $replyto\n";
sleep(1);
exit(0);
}
else {
print STDERR "petidomo-approve: unrecognized mail type\n";
sleep(1);
exit(1);
}

75
petidomo-kickout Executable file
View File

@ -0,0 +1,75 @@
:
eval 'exec perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
##
## petidomo-kickout -- Petidomo kickout tool
## Copyright (c) 2000 Ralf S. Engelschall <rse@engelschall.com>
##
my $pattern = $ARGV[0] || die "Usage: petidomo-kickout <address-pattern>";
# locate the file with the approval passwords
my $config = "$ENV{HOME}/.petidomo";
# locate the Sendmail program
my $sendmail = "sendmail";
foreach my $dir (split(/:/, "$ENV{PATH}:/bin:/sbin:/usr/bin:/usr/sbin:/lib:/usr/lib")) {
if (-x "$dir/sendmail") {
$sendmail = "$dir/sendmail";
last;
}
}
# locate the Petidomo basedir
my $basedir = `petidomo --version 2>&1`;
$basedir =~ s|^.+\((\S+)\).*$|$1|s;
# read config
my $list = {};
open(FP, "<$config") || die "No ~/.petidomo file found";
while (<FP>) {
next if (m|^\s*#.*| or m|^\s*$|);
if (m|^\s*(\S+)\s+(\S+)|) {
my ($l, $pw) = ($1, $2);
$l =~ s|@[^@]+$||;
if (-f "$basedir/$l.list") {
$list->{$l} = {};
$list->{$l}->{PASSWORD} = $pw;
$list->{$l}->{MEMBERS} = [];
open(LST, "<$basedir/$l.list");
while (<LST>) {
s|\n$||s;
push(@{$list->{$l}->{MEMBERS}}, $_);
}
close(LST);
}
}
}
close(FP);
# iterate over all mailing lists
foreach my $l (keys(%{$list})) {
foreach my $m (@{$list->{$l}->{MEMBERS}}) {
if ($m =~ m|$pattern|) {
print "petidomo-kickout: $l: <$m> Kickout? [Y/n] ";
my $yn = <STDIN>;
$yn =~ s|\n$||s;
$yn = "y" if ($yn eq '');
$yn = lc($yn);
if ($yn eq 'y') {
open(SM, "|$sendmail petidomo") || die "cannot spawn $sendmail";
print SM "To: petidomo\n" .
"\n" .
"password ".$list->{$l}->{PASSWORD}."\n" .
"unsubscribe $l $m\n";
"password ".$list->{petidomo}->{PASSWORD}."\n" .
"subscribe bounces $m\n";
close(SM);
print "petidomo-kickout: kicked out <$m>\n";
}
}
}
}
sleep(1);
exit(0);