Skip to content

GitLab

Commit 6b2f2b81 authored by Johannes Schilling's avatar Johannes Schilling
Browse files

mupfl: add

parent 0891afb2
Hide whitespace changes
Inline Side-by-side
mupfl/README 0 → 100644
View file @ 6b2f2b81
=== dinge, die man bei mailinglisten einstellen wollen würde ===
== rücKbestätigung durch subscriber per mail ==
./mailman.pl set stuve-finanzen privacy/subscribing '^subscribe_policy' 2
== admin member-listing threshold setzen ==
für ./mailman.pl users list
./mailman.pl set stuve-aktive general 'admin_member_chunksize' 4711
== ban_list(leute die sich nicht subscriben können) ==
oft ist default '^.*$', also keiner kann sich (auch nicht manuell vom admin)
eintragen
./mailmen.pl set stuve-finanzen privacy ban_list ''
== list-server-domain ==
das, was bei listen wenn man den technischen teil anschaut. meistens
@lists.fau.de, man könnte aber auch @fau.de hinschreiben, wenn man passende
aliases unter @fau.de angelegt hat
./mailman.pl set stuve-finanzen general host_name fau.de
mupfl/mailman.pl 0 → 100755
View file @ 6b2f2b81
#!/usr/bin/perl
use strict;
use warnings;
use WWW::Mechanize;
use Config::IniFiles;
use URI::Escape;
unless (-e "mailman.ini") {
open(INI, "> mailman.ini");
print INI <<EOF;
## empty default config for mailman.pl
## adjust to your needs, but mostly
## leave it alone and let mailman.pl work on it
EOF
print INI "[general]";
close(INI);
}
my $cfg = Config::IniFiles->new( -file => "mailman.ini" );
## the idea is that the only way to get a connection handle is to login
my %logged_in_already = ();
sub login {
my $listname = shift;
die "list not configured, use $0 init <listname> <baseurl> <passwd>\n"
unless ($cfg->val($listname, 'password'));
if ($logged_in_already{$listname}) {
return $logged_in_already{$listname};
}
my $passwd = $cfg->val($listname, 'password');
my $baseurl = $cfg->val($listname, 'baseurl');
my $con = WWW::Mechanize->new();
$con->show_progress(1);
$con->get($baseurl . '/admin/' . $listname);
my $reply = $con->submit_form(
form_name => 'f',
fields => {
'adminpw' => "$passwd",
},
);
if ($reply->is_success()) {
$logged_in_already{$listname} = $con;
return $con;
} else {
return undef;
}
};
sub get_members {
my $listname = shift;
my $con = login($listname) or die "could not log in";
$con->follow_link( url_regex => qr/\/members/ );
my @hidden_inputs = $con->find_all_inputs(
type => 'hidden',
name => 'user',
);
my @members = ();
for my $inp (@hidden_inputs) {
push(@members, uri_unescape($inp->value()));
};
return @members;
};
sub cfg_save_members {
my $listname = shift;
my @members = get_members $listname;
$cfg->newval($listname, 'members', @members);
$cfg->RewriteConfig();
};
sub members_list {
my $listname = shift;
print STDERR "members list: ", $listname, "\n";
my @members = get_members($listname);
print "total: ", scalar(@members), " members\n";
print join "\n", @members;
print "\n";
}
sub members_save {
print STDERR "members save: ", $_[0], "\n";
cfg_save_members(@_);
}
sub members_add {
my $listname = shift;
my $con = login($listname);
$con->follow_link( url_regex => qr/\/members/ );
$con->follow_link( url_regex => qr/\/members\/add/ );
$con->form_number(1); ## 1-based indexing
my $members_string = join ("\n", @_);
$con->set_fields('subscribees', $members_string);
$con->submit();
}
sub members_del {
my $listname = shift;
my $con = login($listname);
$con->follow_link( url_regex => qr/\/members/ );
$con->follow_link( url_regex => qr/\/members\/remove/ );
$con->form_number(1); ## 1-based indexing
my $members_string = join ("\n", @_);
$con->set_fields('unsubscribees', $members_string);
$con->submit();
}
sub members {
my $subcmd = shift;
print STDERR "members: ", $subcmd, "\n";
my %member_subcmds = (
"list" => \&members_list,
"show" => \&members_list,
"get" => \&members_list,
"dump" => \&members_list,
"save" => \&members_save,
"add" => \&members_add,
"subscribe" => \&members_add,
"del" => \&members_del,
"remove" => \&members_del,
"unsubscribe" => \&members_del,
);
if ($member_subcmds{$subcmd}) {
$member_subcmds{$subcmd}->(@_);
}
};
my %logged_in_already_mod = ();
sub login_mod {
my $listname = shift;
die "list not configured, use $0 init <listname> <baseurl> <passwd>\n"
unless ($cfg->val($listname, 'password'));
if ($logged_in_already_mod{$listname}) {
return $logged_in_already_mod{$listname};
}
my $passwd = $cfg->val($listname, 'password');
my $baseurl = $cfg->val($listname, 'baseurl');
my $con = WWW::Mechanize->new();
$con->show_progress(1);
$con->get($baseurl . '/admindb/' . $listname);
my $reply = $con->submit_form(
form_name => 'f',
fields => {
'adminpw' => "$passwd",
},
);
if ($reply->is_success()) {
$logged_in_already_mod{$listname} = $con;
return $con;
} else {
return undef;
}
}
my %moderate_radiobutton_values = (
later => 0,
l => 0,
accept => 1,
a => 1,
reject => 2,
r => 2,
drop => 3,
d => 3,
);
### from: http://www.perlmonks.org/?node_id=406883
sub min ($$) { $_[$_[0] > $_[1]] }
sub moderate_interactive {
my $listname = shift;
my $con = login_mod($listname) or die "could not log in";
my $baseurl = $cfg->val($listname, 'baseurl');
if ($con->content() =~ qr/Keine unbearbeiteten Anfragen./) {
print "no unworked requests :)\n";
return;
}
## it's all one form, so that doesn't matter even if we have pending
## subscribee requests
$con->form_number(1); ## 1-based indexing
## now for the pending messages, they are rather worked from the detailed
## view..
$con->follow_link(
url_regex => qr/\?details=all/,
);
my @held_messages_inputs = $con->find_all_inputs(
name_regex => qr/fulltext-/,
);
foreach my $inp (@held_messages_inputs) {
my $id = $inp->name();
$id =~ s/fulltext-//;
my @all_headerlike_fields = $con->find_all_inputs( name => 'headers-' . $id);
my @headers = split(/\n/, $all_headerlike_fields[0]->value());
print join("\n", grep (/^(From|To|Subject|Cc|X-Spam-)/, @headers)), "\n";
my $fulltext = $inp->value();
my @fulltext_lines = split(/\n/, $fulltext);
print join("\n", @fulltext_lines[0..min(10, $#fulltext_lines)]), "\n";
print "\n" for 1..3;
print "What now? [A]ccept, [R]eject, [D]rop, think about it [L]ater?\n> ";
chomp(my $reply = <STDIN>);
my $mod_answer = $moderate_radiobutton_values{$reply};
print "set input $id to value $mod_answer\n";
$con->set_fields( $id => $mod_answer );
}
print STDERR "number of held messages: ", scalar(@held_messages_inputs), "\n";
if (scalar(@held_messages_inputs) > 0) {
$con->submit();
print "submitted.\n";
}
}
my %moderate_subscribees_radiobutton_values = (
later => 0,
l => 0,
accept => 4,
a => 4,
reject => 2,
r => 2,
drop => 3,
d => 3,
);
sub moderate_subscribees {
my $listname = shift;
my $con = login_mod($listname) or die "could not log in";
my $baseurl = $cfg->val($listname, 'baseurl');
if ($con->content() =~ qr/Keine unbearbeiteten Anfragen./) {
print "no unworked requests :)\n";
return;
}
my @pending_subscribers_inputs = $con->find_all_inputs(
name_regex => qr/ban-/,
);
my $num_subscribers = scalar(@pending_subscribers_inputs);
print "$num_subscribers subscribers pending\n";
foreach (split /[ <>]/, $con->content()) {
if (/([a-zA-Z0-9.+-]+\@[a-zA-Z0-9.+-]+)/) {
unless (/stuve-.*-owner\@(lists\.)?(fau|uni-erlangen).de/) {
my $addr = $_;
print $addr, "\n";
my $inp = shift @pending_subscribers_inputs;
print $inp, "\n";
my $id = $inp->name();
$id =~ s/ban-//;
print "\n" for 1..3;
print "id: $id, addr: $addr (matching of addrs and ids is somewhat experimental!)\n";
print "What now? [A]ccept, [R]eject, [D]rop, think about it [L]ater?\n> ";
chomp(my $reply = <STDIN>);
my $mod_answer = $moderate_subscribees_radiobutton_values{$reply};
print "setting field $id to $mod_answer\n";
$con->set_fields( $id => $mod_answer );
}
}
}
print STDERR "$num_subscribers subscribers were pending\n";
if ($num_subscribers > 0) {
## submit for the subscriber requests
$con->submit();
print "submitted\n";
}
}
sub moderate {
my $subcmd = shift;
print STDERR "moderate: ", $subcmd, "\n";
my %moderate_subcmds = (
"interactive" => \&moderate_interactive,
"ask" => \&moderate_interactive,
"confirm" => \&moderate_interactive,
"list" => \&moderate_list,
"show" => \&moderate_list,
"pending" => \&moderate_list,
"subscribers" => \&moderate_subscribees,
"subs" => \&moderate_subscribees,
"sub" => \&moderate_subscribees,
);
if ($moderate_subcmds{$subcmd}) {
$moderate_subcmds{$subcmd}->(@_);
}
};
sub set_option {
my $listname = shift;
my $section = shift;
my $option = shift;
my $value = shift;
print STDERR "$listname($section): set $option to $value\n";
my $con = login($listname) or die "could not log in";
my @todo = split( qr/\//, $section);
## click through the layers of link-depth. assume that in every level, a
## link to the next deeper level exists somewhere
my $done = "";
while (my $next = shift @todo) {
$done = $done . '/' . $next;
$con->follow_link( url_regex => qr/$done/ );
};
$con->set_fields( $option => $value );
$con->submit();
}
sub get_option {
my $listname = shift;
my $section = shift;
my $option_re = shift;
print STDERR "$listname($section): get $option_re\n";
my $con = login($listname) or die "could not log in";
my @todo = split( qr/\//, $section);
## click through the layers of link-depth. assume that in every level, a
## link to the next deeper level exists somewhere
my $done = "";
while (my $next = shift @todo) {
$done = $done . '/' . $next;
$con->follow_link( url_regex => qr/$done/ );
};
my @fields = $con->find_all_inputs( name_regex => qr/$option_re/ );
foreach my $field (@fields) {
print $field->name(), ": ", $field->value(), "\n";
}
}
## actually, this num2name and name2num might be 180 degrees from correct
my %spamfilter_action_number2name = (
delay => 0, ## verschieben
delay2 => 7, ## zurückhalten
deny => 2,
drop => 3,
accept => 6,
);
my %spamfilter_action_name2number = reverse (%spamfilter_action_number2name);
sub init_list {
my $listname = shift;
my $baseurl = shift;
my $passwd = shift;
if ($cfg->SectionExists($listname)) {
die "list already exists, doing nothing";
}
if ($cfg->exists('general', 'instances')) {
$cfg->push('general', 'instances', $listname);
} else {
$cfg->newval('general', 'instances', $listname);
}
$cfg->AddSection($listname);
$cfg->newval($listname, 'baseurl', $baseurl);
$cfg->newval($listname, 'password', $passwd);
$cfg->RewriteConfig();
}
sub fsck {
## TODO: alert about sections that are not instances
my @instances = $cfg->val('general', 'instances');
foreach my $instance (@instances) {
print STDERR "checking $instance.. \n";
die "$instance has no baseurl" unless $cfg->exists($instance, 'baseurl');
die "$instance has no password" unless $cfg->exists($instance, 'password');
};
print "everything seems ok\n";
}
sub list_instances {
my @instances = $cfg->val('general', 'instances');
print join("\n", @instances), "\n";
}
sub spamfilter_show_filters {
my $listname = shift;
print STDERR "spamfilter_show: $listname\n";
my $con = login($listname) or die "could not log in";
$con->follow_link( url_regex => qr/privacy/ );
$con->follow_link( url_regex => qr/privacy\/spam/ );
my @spamfilter_inputs = $con->find_all_inputs( name_regex => 'hdrfilter_.*');
## it is assumed, that every rule produces 7 input-fields.
my $spamfilter_fields = scalar(@spamfilter_inputs);
if ($spamfilter_fields eq 3) {
print STDERR "no rules yet\n";
return;
}
if ($spamfilter_fields % 7 ne 0) {
print STDERR "not sure about field count.. (%7 != 0). fields are: ";
foreach (@spamfilter_inputs) {
print $_->name(), ", ";
}
}
my $num_rules = $spamfilter_fields/7;
for (my $i = 1; $i le $num_rules; $i++) {
my $rule_id_str = sprintf("%02d", $i);
print "rule #$rule_id_str:\n";
my @filter_re_inputs = $con->find_all_inputs( name => "hdrfilter_rebox_$rule_id_str" );
print "regex: ", $filter_re_inputs[0]->value(), "\n";
my @filter_actions = $con->find_all_inputs( name => "hdrfilter_action_$rule_id_str" );
print "action: ", $spamfilter_action_name2number{$filter_actions[0]->value()}, "\n";
}
}
sub spamfilter_add_filter {
my $listname = shift;
my $regex = shift;
my $action = shift;
my $con = login($listname) or die "could not log in";
$con->follow_link( url_regex => qr/privacy/ );
$con->follow_link( url_regex => qr/privacy\/spam/ );
my @hdrfilter_inputs = $con->find_all_inputs( name_regex => qr/hdrfilter_.*/);
if (scalar(@hdrfilter_inputs) < 7) {
print scalar(@hdrfilter_inputs), "\n";
## no rules been there before
print STDERR "note: this is the first rule in this mailman\n";
$con->field( "hdrfilter_rebox_01", $regex);
$con->field( "hdrfilter_action_01", $spamfilter_action_name2number{$action});
} else {
$con->click_button( name => "hdrfilter_add_01" );
$con->field( "hdrfilter_rebox_02", $regex);
$con->field( "hdrfilter_action_02", $spamfilter_action_number2name{$action} );
}
$con->submit();
}
my %spamfilter_subcommands = (
"list" => \&spamfilter_show_filters,
"show" => \&spamfilter_show_filters,
"add" => \&spamfilter_add_filter,
"del" => \&spamfilter_del_filter,
);
sub spamfilter_command {
my $subcmd = shift;
print STDERR "spamfilter: $subcmd\n";
if ($spamfilter_subcommands{$subcmd}) {
$spamfilter_subcommands{$subcmd}->(@_);
} else {
print STDERR "spamfilter: unknown subcmd \"$subcmd\"\n"
}
}
sub print_passwd_command {
my $listname = shift;
die "list not configured, use $0 init <listname> <baseurl> <passwd>\n"
unless (print $cfg->val($listname, 'password'), "\n");
}
####
# kinda main, from here on
# ##########
## TODO: rewrite using http://search.cpan.org/dist/WWW-Mailman/lib/WWW/Mailman.pm
my %available_commands = (
"members" => \&members,
"users" => \&members,
"moderate" => \&moderate,
"mod" => \&moderate,
"set" => \&set_option,
"get" => \&get_option,
"init" => \&init_list,
"fsck" => \&fsck,
"instances" => \&list_instances,
"spamfilter" => \&spamfilter_command,
"spam" => \&spamfilter_command,
"print_passwd" => \&print_passwd_command,
"pass" => \&print_passwd_command,
## alias that skips a level.. somehow non-nicely from a modularization
## viewpoint
"mask" => \&moderate_interactive,
);
if (scalar(@ARGV) < 1) {
print STDERR "usage: at least one command must be given\n";
exit(1);
};
my $cmd = shift @ARGV;
if ($available_commands{$cmd}) {
print STDERR "cmd: $cmd\n";
$available_commands{$cmd}->(@ARGV);
} else {
print STDERR "unknown command \"$cmd\" \n";
exit 1;
};
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment