Initial checkin.
Signed-off-by: Thomas Hochstein <thh@thh.name>
This commit is contained in:
commit
30132626b8
68 changed files with 5497 additions and 0 deletions
109
bin/autoreply.pl
Normal file
109
bin/autoreply.pl
Normal file
|
|
@ -0,0 +1,109 @@
|
|||
#!/usr/bin/perl -sw
|
||||
######################################################################
|
||||
#
|
||||
# $Id: autoreply.pl 288 2011-02-18 22:45:59Z alba $
|
||||
#
|
||||
# Copyright 2007 - 2009 Roman Racine
|
||||
# Copyright 2010 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Mail::Sendmail();
|
||||
use MOD::DBIUtils();
|
||||
use MOD::Utils();
|
||||
|
||||
# Mail::Sendmail can handle Cc: and produces a detailed log
|
||||
# Mail::Mailer is inferior, don't use
|
||||
|
||||
|
||||
######################################################################
|
||||
sub get_strings($)
|
||||
######################################################################
|
||||
{
|
||||
my $r_config = shift || die;
|
||||
|
||||
my $lang = MOD::Utils::get_translator_language(
|
||||
$r_config->{'html_language'},
|
||||
undef
|
||||
);
|
||||
if ($::debug) { printf "get_translator_language=%s\n", $lang; }
|
||||
my $trans = MOD::Utils::get_translator($lang);
|
||||
|
||||
my %result = map { $_ => $trans->($_); }
|
||||
(
|
||||
'_ARRIVAL_NOTICE_BODY',
|
||||
'_ARRIVAL_NOTICE_SUBJECT'
|
||||
);
|
||||
if ($::debug)
|
||||
{
|
||||
while(my ($key, $value) = each %result)
|
||||
{ printf "%s => [%s]\n", $key, $value; }
|
||||
}
|
||||
return \%result;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub send_autoreply($$$)
|
||||
######################################################################
|
||||
{
|
||||
my $r_config = shift || die;
|
||||
my $r_strings = shift || die;
|
||||
my $address = shift;
|
||||
|
||||
chomp $address;
|
||||
return if ($address =~ /(,|\n)/s);
|
||||
|
||||
my $moderated_group = $r_config->{'moderated_group'};
|
||||
Mail::Sendmail::sendmail(
|
||||
'From' => $r_config->{'mailfrom'},
|
||||
'Subject' => sprintf(
|
||||
$r_strings->{_ARRIVAL_NOTICE_SUBJECT},
|
||||
$moderated_group
|
||||
),
|
||||
'To' => $address,
|
||||
'Message' => sprintf(
|
||||
$r_strings->{_ARRIVAL_NOTICE_BODY},
|
||||
$moderated_group
|
||||
),
|
||||
);
|
||||
if ($::debug) { print $Mail::Sendmail::log, "\n\n"; }
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# MAIN
|
||||
######################################################################
|
||||
|
||||
$::debug = 0 if (!$::debug);
|
||||
|
||||
die "Missing parameter '-config'" unless($::config);
|
||||
my %config = MOD::Utils::read_private_config($::config);
|
||||
my $dbi = MOD::DBIUtils->new(\%config);
|
||||
|
||||
my $r_strings = get_strings(\%config);
|
||||
my $address_rx = $Mail::Sendmail::address_rx;
|
||||
|
||||
my $dataref = $dbi->select_pending();
|
||||
while (my $ref = $dataref->fetchrow_arrayref)
|
||||
{
|
||||
my ($address) = @{$ref};
|
||||
if ($address =~ /$address_rx/o)
|
||||
{
|
||||
# my $address = $1;
|
||||
# my $user = $2;
|
||||
# my $domain = $3;
|
||||
if ($::debug) { printf "processing [%s]\n", $address; }
|
||||
send_autoreply(\%config, $r_strings, $address);
|
||||
}
|
||||
elsif ($::debug) {
|
||||
printf "invalid address [%s]\n", $address;
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
94
bin/fremdcancel.pl
Normal file
94
bin/fremdcancel.pl
Normal file
|
|
@ -0,0 +1,94 @@
|
|||
#!/usr/bin/perl
|
||||
######################################################################
|
||||
#
|
||||
# $Id: fremdcancel.pl 302 2011-09-30 00:09:02Z alba $
|
||||
#
|
||||
# Copyright 2007 - 2009 Roman Racine
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
BEGIN { push (@INC, $ENV{'HUHU_DIR'}); }
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Net::NNTP;
|
||||
use News::Article;
|
||||
use News::Article::Cancel;
|
||||
use MOD::Utils;
|
||||
|
||||
use constant NR_POSTS_TO_EXAMINE => 5;
|
||||
|
||||
######################################################################
|
||||
sub check_pgp($$$)
|
||||
######################################################################
|
||||
{
|
||||
my $article = shift || die;
|
||||
my $moderated_group = shift || die;
|
||||
my $pgp_keyid = shift || die;
|
||||
|
||||
my $mid = $article->header('message-id') || die 'No Message-ID';
|
||||
my $result = $article->verify_pgpmoose($moderated_group);
|
||||
|
||||
if (!$result)
|
||||
{
|
||||
printf "Checking %s, not signed.\n", $mid;
|
||||
return undef;
|
||||
}
|
||||
if ($result ne $pgp_keyid)
|
||||
{
|
||||
printf "Checking %s, signed with wrong key. Expected '%s', got '%s'.\n",
|
||||
$mid, $pgp_keyid, $result;
|
||||
return undef;
|
||||
}
|
||||
printf "Checking %s, ok\n", $mid;
|
||||
return 1;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# MAIN
|
||||
######################################################################
|
||||
|
||||
my %config = MOD::Utils::read_private_config($ARGV[0]);
|
||||
|
||||
my $moderated_group = $config{'moderated_group'};
|
||||
if (!$moderated_group)
|
||||
{
|
||||
printf "Missing configuration item 'moderated_group'.\n";
|
||||
exit(1);
|
||||
}
|
||||
|
||||
my $pgp_keyid = $config{'pgp_keyid'};
|
||||
if (!$pgp_keyid)
|
||||
{
|
||||
printf "Missing configuration item 'pgp_keyid'.\n";
|
||||
exit(1);
|
||||
}
|
||||
|
||||
my $nntp = new Net::NNTP($config{'nntp_server'}) or exit(0);
|
||||
$nntp->authinfo($config{'nntp_user'},$config{'nntp_pass'}) or exit(0);
|
||||
my ($articles,$first,$last,undef) = $nntp->group($config{'moderated_group'});
|
||||
|
||||
my $start = $last - NR_POSTS_TO_EXAMINE;
|
||||
if ($start < $first) { $start = $first; }
|
||||
|
||||
for my $id ($start .. $last)
|
||||
{
|
||||
my $articletext = $nntp->article($id);
|
||||
if (defined($articletext))
|
||||
{
|
||||
my $article = News::Article::Cancel->new($articletext);
|
||||
my $ok = check_pgp($article, $moderated_group, $pgp_keyid);
|
||||
if (!$ok)
|
||||
{
|
||||
next if ($article->header('Newsgroups') =~ /de.admin.news.announce/);
|
||||
my $cancel = $article->make_cancel($config{'approve_string'},'moderator','Gecancelt because of fake approval');
|
||||
$cancel->set_headers('Approved',$config{'approve_string'});
|
||||
$cancel->sign_pgpmoose($config{'moderated_group'},$config{'pgp_passphrase'},$config{'pgp_keyid'});
|
||||
$cancel->post($nntp);
|
||||
}
|
||||
}
|
||||
}
|
||||
261
bin/ircbot.pl
Normal file
261
bin/ircbot.pl
Normal file
|
|
@ -0,0 +1,261 @@
|
|||
#!/usr/bin/perl -sw
|
||||
######################################################################
|
||||
#
|
||||
# $Id: ircbot.pl 266 2010-05-18 15:14:08Z alba $
|
||||
#
|
||||
# Copyright 2009 Roman Racine
|
||||
# Copyright 2010 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(confess);
|
||||
use Data::Dumper;
|
||||
use Net::IRC();
|
||||
|
||||
use MOD::DBIUtilsPublic();
|
||||
use MOD::Utils();
|
||||
use MOD::Displaylib();
|
||||
use MOD::NotificationSocket();
|
||||
|
||||
######################################################################
|
||||
|
||||
use constant DEBUG_TO_IRC => 0;
|
||||
use constant MIN_TIME_BETWEEN_QUERIES => 5;
|
||||
use constant MAX_TIME_BETWEEN_QUERIES => 30;
|
||||
|
||||
######################################################################
|
||||
|
||||
my Net::IRC $irc;
|
||||
my Net::IRC::Connection $conn;
|
||||
my MOD::DBIUtilsPublic $db;
|
||||
my MOD::Displaylib $display;
|
||||
|
||||
my $channel;
|
||||
my $last = 'none';
|
||||
my $pending = 'no';
|
||||
my $last_query_time = 0;
|
||||
|
||||
######################################################################
|
||||
sub on_connect
|
||||
######################################################################
|
||||
{
|
||||
my $self = shift;
|
||||
$self->join($channel);
|
||||
$conn->privmsg($channel,'*huhu*');
|
||||
check_for_new(1);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub alarm_handler
|
||||
######################################################################
|
||||
{
|
||||
check_for_new(1);
|
||||
alarm(MAX_TIME_BETWEEN_QUERIES);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub on_public
|
||||
######################################################################
|
||||
{
|
||||
my ($self, $event) = @_;
|
||||
my $msg = ($event->args)[0];
|
||||
if ($msg eq '!pending') {
|
||||
eval { print_pending(1); };
|
||||
warn $@ if ($@);
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub on_disconnect
|
||||
######################################################################
|
||||
{
|
||||
my ($self, $event) = @_;
|
||||
while (1) {
|
||||
eval {
|
||||
$self->connect();
|
||||
}; if ($@) {
|
||||
sleep 60;
|
||||
} else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub do_connect($$)
|
||||
######################################################################
|
||||
{
|
||||
my $config = shift || confess;
|
||||
my Net::IRC $irc = shift || confess;
|
||||
|
||||
my $nick = $config->{'ircbot_nick'};
|
||||
my $realname = $config->{'ircbot_realname'};
|
||||
my $username = $config->{'ircbot_username'};
|
||||
my $server = $config->{'ircbot_server'};
|
||||
my $port = $config->{'ircbot_port'};
|
||||
|
||||
my $conn = $irc->newconn(
|
||||
Nick => $nick,
|
||||
Server => $server,
|
||||
Port => $port,
|
||||
Ircname => $realname,
|
||||
);
|
||||
confess if (!defined($conn));
|
||||
|
||||
$conn->add_global_handler('376', \&on_connect);
|
||||
$conn->add_global_handler('public', \&on_public);
|
||||
$conn->add_global_handler('disconnect', \&on_disconnect);
|
||||
return $conn;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub on_socket_read($)
|
||||
######################################################################
|
||||
{
|
||||
my $read_socket = shift || confess;
|
||||
|
||||
my $buffer;
|
||||
my $rc = sysread($read_socket, $buffer, 512);
|
||||
|
||||
if (!defined($rc))
|
||||
{
|
||||
if (DEBUG_TO_IRC) { $conn->privmsg($channel, "on_socket_read $!"); }
|
||||
return;
|
||||
}
|
||||
|
||||
if ($rc == 0)
|
||||
{
|
||||
if (DEBUG_TO_IRC) { $conn->privmsg($channel, 'on_socket_read close'); }
|
||||
|
||||
# Do not call close($read_socket), this will hang the process.
|
||||
# Socket is automatically closed when the last reference is freed.
|
||||
$irc->removefh($read_socket) || confess;
|
||||
return;
|
||||
}
|
||||
|
||||
$buffer =~ s/\s+$//;
|
||||
$conn->privmsg($channel, "sysread=$rc [$buffer]");
|
||||
if ($last_query_time + MIN_TIME_BETWEEN_QUERIES < time())
|
||||
{
|
||||
check_for_new(0);
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub on_socket_accept($)
|
||||
######################################################################
|
||||
{
|
||||
my $accept_socket = shift || confess;
|
||||
|
||||
if (DEBUG_TO_IRC)
|
||||
{
|
||||
$conn->privmsg($channel, 'on_socket_accept');
|
||||
}
|
||||
|
||||
my $new_socket;
|
||||
accept($new_socket, $accept_socket) || die "accept: $!";
|
||||
defined($new_socket) || die 'defined($new_socket)';
|
||||
$irc->addfh($new_socket, \&on_socket_read, 'r') || die "addfh: $!";
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub add_notify_sock($$)
|
||||
######################################################################
|
||||
{
|
||||
my $config = shift || confess;
|
||||
my Net::IRC $irc = shift || confess;
|
||||
|
||||
my $fh = MOD::NotificationSocket::socket_create_listening($config);
|
||||
if ($fh) { $irc->addfh($fh, \&on_socket_accept, 'r'); }
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub print_pending($)
|
||||
######################################################################
|
||||
{
|
||||
my $verbose = shift;
|
||||
my $result = eval
|
||||
{
|
||||
my @overview = qw(Sender Subject Datum);
|
||||
$db->displayrange('pending', 0, 10, \@overview);
|
||||
};
|
||||
if ($@) { warn $@; return; }
|
||||
$last_query_time = time();
|
||||
|
||||
my $ref;
|
||||
my $count = 0;
|
||||
while ($ref = $result->fetchrow_arrayref) {
|
||||
my @columns = @{$ref};
|
||||
my ($from,$subject,$date) = ($display->decode_line($columns[0]),$display->decode_line($columns[1]),
|
||||
$columns[2]);
|
||||
$conn->privmsg($channel,"$date; $from; $subject");
|
||||
sleep 1;
|
||||
$count++;
|
||||
}
|
||||
if (!$count && $verbose) {
|
||||
$conn->privmsg($channel,"No postings pending");
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub check_for_new($)
|
||||
######################################################################
|
||||
{
|
||||
my $verbose = shift;
|
||||
my $result = eval
|
||||
{
|
||||
my @overview = qw(Id Sender Subject Datum);
|
||||
$db->displayrange('pending', 0, 1, \@overview);
|
||||
};
|
||||
if ($@) { warn $@; return; }
|
||||
$last_query_time = time();
|
||||
|
||||
my $ref;
|
||||
if ($ref = $result->fetchrow_arrayref) {
|
||||
my @result = @{$ref};
|
||||
if ($last eq 'none' or $last < $result[0]) {
|
||||
my ($from,$subject,$date) = ($display->decode_line($result[1]),$display->decode_line($result[2]),
|
||||
$result[3]);
|
||||
$conn->privmsg($channel,"New posting: $date; $from; $subject");
|
||||
$pending = 'yes';
|
||||
$last = $result[0];
|
||||
}
|
||||
} elsif ($pending eq 'yes') {
|
||||
$conn->privmsg($channel,"No pending postings any more.");
|
||||
$pending = 'no';
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# main
|
||||
######################################################################
|
||||
|
||||
if ($::pidfile)
|
||||
{
|
||||
my $file;
|
||||
if (open($file, '>', $::pidfile))
|
||||
{ print $file $$, "\n"; }
|
||||
else
|
||||
{ warn "Can't open $::pidfile for writing: $!"; }
|
||||
}
|
||||
|
||||
die "Missing parameter '-config'" unless($::config);
|
||||
my %config = MOD::Utils::read_private_config($::config);
|
||||
$channel = $config{'ircbot_channel'} || die;
|
||||
$db = MOD::DBIUtilsPublic->new(\%config);
|
||||
$display = MOD::Displaylib->new(\%config,0);
|
||||
|
||||
$irc = new Net::IRC;
|
||||
add_notify_sock(\%config, $irc);
|
||||
$conn = do_connect(\%config, $irc);
|
||||
|
||||
$SIG{'ALRM'} = \&alarm_handler;
|
||||
alarm(MAX_TIME_BETWEEN_QUERIES);
|
||||
$irc->start;
|
||||
37
bin/ircbot.sh
Normal file
37
bin/ircbot.sh
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
#!/bin/sh
|
||||
######################################################################
|
||||
#
|
||||
# $Id: ircbot.sh 283 2011-02-18 00:17:33Z alba $
|
||||
#
|
||||
######################################################################
|
||||
export "LANG=C"
|
||||
export "LC_ALL=C"
|
||||
set -o nounset
|
||||
set -o errexit
|
||||
|
||||
pidfile="${HOME}/var/ircbot.pid"
|
||||
logfile="${HOME}/var/ircbot.log"
|
||||
config="${HOME}/etc/public.conf"
|
||||
|
||||
do_stop()
|
||||
{
|
||||
if [ -s "${pidfile}" ]; then
|
||||
kill $(cat "${pidfile}") || echo status=$?
|
||||
rm "${pidfile}"
|
||||
fi
|
||||
}
|
||||
|
||||
do_start()
|
||||
{
|
||||
${HUHU_DIR}/bin/ircbot.pl "-config=${config}" "-pidfile=${pidfile}" \
|
||||
> "${logfile}" 2>&1 &
|
||||
}
|
||||
|
||||
case "${1:-}" in
|
||||
start) do_start ;;
|
||||
restart) do_stop; do_start ;;
|
||||
stop) do_stop ;;
|
||||
*) echo "Usage: ircbot.sh {start|stop|restart}"
|
||||
exit 3
|
||||
;;
|
||||
esac
|
||||
100
bin/mailget.pl
Normal file
100
bin/mailget.pl
Normal file
|
|
@ -0,0 +1,100 @@
|
|||
#!/usr/bin/perl -w
|
||||
######################################################################
|
||||
#
|
||||
# $Id: mailget.pl 148 2009-10-13 15:02:22Z alba $
|
||||
#
|
||||
# Copyright 2007 - 2009 Roman Racine
|
||||
# Copyright 2009 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
#
|
||||
# Reads the mail from the moderator account checks it against
|
||||
# a spamfilter and either puts it into the "to_moderate" table
|
||||
# into the "spam" table or discards the mail completly.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use warnings;
|
||||
use Net::POP3;
|
||||
|
||||
use News::Article;
|
||||
use MOD::Utils;
|
||||
use MOD::DBIUtils;
|
||||
use MOD::Spamfilter;
|
||||
|
||||
sub process($);
|
||||
sub enter_table($);
|
||||
sub enter_spam_table($);
|
||||
|
||||
my %config = MOD::Utils::read_private_config($ARGV[0]);
|
||||
my $spamutil = MOD::Spamfilter->new(\%config);
|
||||
|
||||
my $pop = Net::POP3->new($config{'mod_pop_server'}) or die $!;
|
||||
if ($pop->login($config{'mod_pop_username'}, $config{'mod_pop_pass'}) > 0) {
|
||||
my $msgnums = $pop->list;
|
||||
foreach my $msgnum (keys %{$msgnums}) {
|
||||
my $article = News::Article->new($pop->get($msgnum));
|
||||
if (defined($article)) {
|
||||
eval {
|
||||
process($article);
|
||||
}; if ($@) {
|
||||
print $@,"\n";
|
||||
}
|
||||
}
|
||||
$pop->delete($msgnum);
|
||||
}
|
||||
}
|
||||
$pop->quit;
|
||||
|
||||
|
||||
sub process($) {
|
||||
my $article = shift;
|
||||
my $dbi = MOD::DBIUtils->new(\%config);
|
||||
# broken spam postings
|
||||
return if ($article->bytes() <= 2);
|
||||
if (!defined($article->header('Newsgroups'))) {
|
||||
$article->set_headers('Newsgroups',$config{'moderated_group'});
|
||||
}
|
||||
my $score = 0;
|
||||
if ($spamutil->blacklist($article)) {
|
||||
# $score = 100;
|
||||
# $dbi->enter_table($article,'spam',$score);
|
||||
return;
|
||||
}
|
||||
if ($config{'spamassassin'}) {
|
||||
open(my $savestdout,">&STDOUT") or warn "Failed to dup STDOUT: $!";
|
||||
open(my $savestderr,">&STDERR") or warn "Failed to dup STDOUT: $!";
|
||||
open(STDOUT,'/dev/null') or warn $!;
|
||||
open(STDERR,'/dev/null') or warn $!;
|
||||
$score += $spamutil->spamfilter_spamassassin($article);
|
||||
open(STDOUT,">&$savestdout") or warn $!;
|
||||
open(STDERR,">&$savestderr") or warn $!;
|
||||
|
||||
}
|
||||
|
||||
if ($config{'subjectcheck'} and
|
||||
$dbi->check_subject($article->header('subject'))) {
|
||||
$article->add_headers('X-Subject-Test',
|
||||
$config{'subjectscore'});
|
||||
$score += $config{'subjectscore'};
|
||||
}
|
||||
|
||||
if ($config{'attachmentcheck'}) {
|
||||
$score += $spamutil->spamfilter_attachment($article);
|
||||
}
|
||||
|
||||
if ($config{'langcheck'}) {
|
||||
$score += $spamutil->spamfilter_language($article);
|
||||
}
|
||||
|
||||
if ($score < 5) {
|
||||
$dbi->enter_table($article,'pending',$score);
|
||||
} else {
|
||||
$dbi->enter_table($article,'spam',$score);
|
||||
}
|
||||
}
|
||||
55
bin/mk-gpg-key.sh
Normal file
55
bin/mk-gpg-key.sh
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
#!/bin/sh
|
||||
######################################################################
|
||||
#
|
||||
# $Id: mk-gpg-key.sh 291 2011-06-21 13:19:54Z alba $
|
||||
#
|
||||
######################################################################
|
||||
export "LANG=C"
|
||||
export "LC_ALL=C"
|
||||
set -o nounset
|
||||
set -o errexit
|
||||
|
||||
public="${HOME}/etc/public.conf"
|
||||
if [ ! -s "${public}" ]; then
|
||||
echo "ERROR: Public configuration file does not exist."
|
||||
echo "public=${public}"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
private=$(
|
||||
sed -ne '/^priv_config_file=/ { s///; p; q }' "${public}"
|
||||
)
|
||||
if [ ! -s "${private}" ]; then
|
||||
echo "ERROR: Private configuration file does not exist."
|
||||
echo "private=${private}"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
passphrase=$(
|
||||
sed -ne '/^pgp_passphrase=/ { s///; p; q }' "${private}"
|
||||
)
|
||||
name_real=$(
|
||||
sed -ne '/^pgp_keyid=\(.*\)<.*/ { s//\1/; s/ *$//; p; q }' "${private}"
|
||||
)
|
||||
name_email=$(
|
||||
sed -ne '/^pgp_keyid=.*<\([^>]*\)>.*/ { s//\1/; p; q }' "${private}"
|
||||
)
|
||||
|
||||
echo "passphrase=${passphrase}"
|
||||
echo "name_real=${name_real}"
|
||||
echo "name_email=${name_email}"
|
||||
|
||||
if [ -n "${name_real:-}" -a -n "${name_email:-}" ]; then
|
||||
(
|
||||
# See /usr/share/doc/gnupg/DETAILS.gz for parameter description
|
||||
echo "Key-Type: 1"
|
||||
echo "Key-Length: 2048"
|
||||
echo "Name-Real: ${name_real}"
|
||||
echo "Name-Email: ${name_email}"
|
||||
[ -n "${passphrase:-}" ] && echo "Passphrase: ${passphrase}"
|
||||
echo "Expire-Date: 10y"
|
||||
echo "%commit"
|
||||
echo "%echo done"
|
||||
) | gpg --gen-key --batch
|
||||
gpg --list-keys
|
||||
fi
|
||||
141
bin/mk-summary.pl
Normal file
141
bin/mk-summary.pl
Normal file
|
|
@ -0,0 +1,141 @@
|
|||
#!/usr/bin/perl -sw
|
||||
#######################################################################
|
||||
#
|
||||
# $Id: mk-summary.pl 249 2010-02-17 22:42:19Z alba $
|
||||
#
|
||||
# Copyright 2010 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use Carp qw(confess);
|
||||
use MOD::Utils();
|
||||
|
||||
######################################################################
|
||||
sub get_param($)
|
||||
######################################################################
|
||||
{
|
||||
my $param_name = shift || confess;
|
||||
|
||||
my $r_value;
|
||||
{
|
||||
# man perlvar
|
||||
# $^W ... The current value of the warning switch, initially
|
||||
# true if -w was used.
|
||||
local $^W = 0;
|
||||
$r_value = eval '*{$::{"' . $param_name . '"}}{"SCALAR"}';
|
||||
}
|
||||
if (defined($r_value))
|
||||
{
|
||||
my $value = $$r_value;
|
||||
return $value if (defined($value));
|
||||
}
|
||||
my $var_name = 'HUHU_' . uc($param_name);
|
||||
my $value = $ENV{$var_name};
|
||||
return $value if (defined($value));
|
||||
die "Parameter -$param_name not specified and environment variable $var_name not defined.";
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# main
|
||||
######################################################################
|
||||
|
||||
die 'Argument -config=file missing' unless($::config);
|
||||
|
||||
# supress warnings
|
||||
$::email_domain = undef unless($::email_domain);
|
||||
$::www_base_dir = undef unless($::www_base_dir);
|
||||
$::www_base_url = undef unless($::www_base_url);
|
||||
|
||||
my $email_domain = get_param('email_domain');
|
||||
my $www_base_dir = get_param('www_base_dir');
|
||||
my $www_base_url = get_param('www_base_url');
|
||||
|
||||
my %config = MOD::Utils::read_private_config($::config);
|
||||
|
||||
my $MODERATED_GROUP = $config{'moderated_group'} || die;
|
||||
my $user_name = $MODERATED_GROUP;
|
||||
$user_name =~ s/\./-/g;
|
||||
my $SUBMISSION_EMAIL = $user_name . '@' . $email_domain;
|
||||
|
||||
my $APPROVE_STRING = $config{'approve_string'} || '';
|
||||
my $MID_FQDN = $config{'mid_fqdn'} || '';
|
||||
my $MAILFROM = $config{'mailfrom'} || '';
|
||||
my $NNTP_USER = $config{'nntp_user'} || '';
|
||||
my $NNTP_PASS = $config{'nntp_pass'} || '';
|
||||
my $NNTP_SERVER = $config{'nntp_server'} || '';
|
||||
|
||||
print <<EOF;
|
||||
== Email ==
|
||||
|
||||
The submission address is <$SUBMISSION_EMAIL>.
|
||||
|
||||
Messages are directly processed by procmail, so you cannot access it
|
||||
with POP or IMAP. (Messages are saved in a backup directory as plain
|
||||
files, though.)
|
||||
|
||||
You can test Huhu by sending posts directly to this address.
|
||||
When tests are finished you should send a message stating that
|
||||
<$SUBMISSION_EMAIL> is the new submission address of
|
||||
$MODERATED_GROUP to <moderators-request\@isc.org>.
|
||||
|
||||
== Web Interface ==
|
||||
|
||||
The web interface consists of two parts. The public part is accessible
|
||||
to everybody. It just displays the approved posts.
|
||||
|
||||
https://albasani.net/huhu/aus/legal/moderated/public.pl
|
||||
|
||||
And then there is the private part. This is protected with a login.
|
||||
using the HTTP digest system.
|
||||
|
||||
https://albasani.net/huhu/aus/legal/moderated/modtable.pl
|
||||
|
||||
HTTP digest is safe to use on unencrypted connections, but for additional
|
||||
paranoia above URLs are also available through https (with a self signed
|
||||
certificate).
|
||||
|
||||
There is currently no way to handle user management through the web
|
||||
interface. I created one account for you:
|
||||
|
||||
Username:
|
||||
Password:
|
||||
|
||||
== Test Mode ==
|
||||
|
||||
At the moment this instance of Huhu is in test mode. Approved messages
|
||||
are sent to albasani.test.moderated. This is an internal group, i.e.
|
||||
it is not sent to peers. You need an albasani-account to read it.
|
||||
|
||||
When you are satisfied with your tests please give me a note.
|
||||
I will then switch to $MODERATED_GROUP.
|
||||
|
||||
== Configurable Options ==
|
||||
|
||||
The following settings are set to default values.
|
||||
Please give me a note if you want to have them changed.
|
||||
|
||||
# Value of header "Approved:" in posts
|
||||
approve_string=$APPROVE_STRING
|
||||
|
||||
# Right hand side of message IDs in in posts.
|
||||
# Empty value means that the news server generates the ID.
|
||||
mid_fqdn=$MID_FQDN
|
||||
|
||||
# Value of header "From:" in rejection notices.
|
||||
mailfrom=$MAILFROM
|
||||
|
||||
== Usenet Account ==
|
||||
|
||||
Username: $NNTP_USER
|
||||
Password: $NNTP_PASS
|
||||
Server : $NNTP_SERVER
|
||||
|
||||
It has permissions to send approved posts to albasani.test.moderated
|
||||
and $MODERATED_GROUP. Use it to bypass the moderation (e.g. send FAQs
|
||||
or cancel messages) or to read the internal albasani.* groups.
|
||||
EOF
|
||||
24
bin/new-passwd.pl
Normal file
24
bin/new-passwd.pl
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
#!/usr/bin/perl -w
|
||||
#######################################################################
|
||||
#
|
||||
# $Id: new-passwd.pl 164 2009-11-03 20:21:38Z alba $
|
||||
#
|
||||
# Copyright 2009 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use constant PRINTABLE =>
|
||||
'*+-./0123456789' .
|
||||
'ABCDEFGHIJKLMNOPQRSTUVWXYZ' .
|
||||
'abcdefghijklmnopqrstuvwxyz';
|
||||
|
||||
for(my $i = 1; $i <= 8; $i++)
|
||||
{
|
||||
print substr PRINTABLE, rand(length(PRINTABLE)), 1;
|
||||
}
|
||||
print "\n";
|
||||
225
bin/poster.pl
Normal file
225
bin/poster.pl
Normal file
|
|
@ -0,0 +1,225 @@
|
|||
#!/usr/bin/perl -w
|
||||
######################################################################
|
||||
#
|
||||
# $Id: poster.pl 303 2011-10-31 13:03:03Z root $
|
||||
#
|
||||
# Copyright 2007 - 2009 Roman Racine
|
||||
# Copyright 2009 - 2011 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
poster.pl
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Dieses Programm liest die zu postenden Postings aus der
|
||||
Datenbank aus und postet sie ins Usenet. Sofern dies erfolgreich
|
||||
ist, setzt es das Bit "posted" in der Datenbank.
|
||||
|
||||
Wenn der Versand nicht erfolgreich ist, tut das Programm nichts,
|
||||
d.h, das Posten wird bei einem spaeteren Aufruf des Programms
|
||||
einfach nochmals versucht.
|
||||
|
||||
Dieses Programm sollte am besten via Cronjob laufen.
|
||||
|
||||
Das Programm wird mit
|
||||
./poster.pl <Pfad zum Configfile> aufgerufen
|
||||
Dasselbe Programm mit unterschiedlichen Konfigurationsfiles
|
||||
aufgerufen kann zur Moderation mehrerer Gruppen eingesetzt werden.
|
||||
|
||||
=head1 REQUIREMENTS
|
||||
|
||||
Net::NNTP
|
||||
|
||||
News::Article
|
||||
|
||||
MOD::*
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Roman Racine <roman.racine@gmx.net>
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
10. Februar 2007
|
||||
|
||||
=cut
|
||||
|
||||
######################################################################
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp qw(confess);
|
||||
|
||||
use Net::NNTP();
|
||||
use News::Article;
|
||||
|
||||
use MOD::Utils;
|
||||
use MOD::DBIUtils;
|
||||
|
||||
use constant DEBUG => 0;
|
||||
|
||||
######################################################################
|
||||
sub connect_nntp($)
|
||||
######################################################################
|
||||
{
|
||||
my $r_config = shift || confess;
|
||||
|
||||
my $cfg_nntp_server = $r_config->{'nntp_server'} ||
|
||||
die 'No "nntp_server" in configuration file';
|
||||
my $nntp = new Net::NNTP($cfg_nntp_server, 'DEBUG' => DEBUG) ||
|
||||
die "Can't connect to news server $cfg_nntp_server";
|
||||
|
||||
my $cfg_nntp_user = $r_config->{'nntp_user'} ||
|
||||
die 'No "nntp_user" in configuration file';
|
||||
my $cfg_nntp_pass = $r_config->{'nntp_pass'} ||
|
||||
die 'No "nntp_pass" in configuration file';
|
||||
|
||||
# authinfo does not return a value
|
||||
$nntp->authinfo($cfg_nntp_user, $cfg_nntp_pass);
|
||||
|
||||
return $nntp;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# MAIN
|
||||
######################################################################
|
||||
|
||||
my %config = MOD::Utils::read_private_config($ARGV[0]);
|
||||
my $approve_string = $config{'approve_string'} ||
|
||||
die 'No "approve_string" in $config';
|
||||
|
||||
my $moderated_group = $config{'moderated_group'};
|
||||
my $pgp_passphrase = $config{'pgp_passphrase'};
|
||||
my $pgp_keyid = $config{'pgp_keyid'};
|
||||
my $sign_pgpmoose = ($moderated_group && $pgp_passphrase && $pgp_keyid);
|
||||
|
||||
if ($sign_pgpmoose && DEBUG > 1)
|
||||
{
|
||||
print "News::Article::sign_pgpmoose enabled.\n";
|
||||
}
|
||||
|
||||
my Net::NNTP $nntp = connect_nntp(\%config);
|
||||
my $dbi = MOD::DBIUtils->new(\%config) ||
|
||||
die "Can't connect to database";
|
||||
|
||||
# Select all posts that have been approved but not posted,
|
||||
# i.e. all posts in the state 'moderated'.
|
||||
my $dataref = $dbi->select_unposted();
|
||||
|
||||
#Schleife ueber alle selektierten Postings
|
||||
#Einlesen des Postings, Header anpassen,anschliessend posten
|
||||
#und das das posted-Bit in der Datenbank setzen.
|
||||
|
||||
while (my $ref = $dataref->fetchrow_arrayref)
|
||||
{
|
||||
my ($id,$posting) = @{$ref};
|
||||
next unless($dbi->set_status($id, 'sending', [ 'moderated' ]));
|
||||
|
||||
# Posting einlesen.
|
||||
my $article = News::Article->new(\$posting);
|
||||
next if (!defined($article->header('Newsgroups')));
|
||||
|
||||
{ # Save original date header
|
||||
my $date = $article->header('Date');
|
||||
if ($date)
|
||||
{ $article->set_headers('X-Huhu-Submission-Date', $date); }
|
||||
}
|
||||
|
||||
# Drop superfluous headers
|
||||
$article->drop_headers(
|
||||
'Approved',
|
||||
'Date',
|
||||
'Delivery-date',
|
||||
'Delivered-To',
|
||||
'Errors-To', # Mailman
|
||||
'Envelope-to',
|
||||
'Injection-Info', # defined by INN 2.6.x and Schnuerpel 2010
|
||||
'Lines', # defined by INN 2.5.x or older
|
||||
'NNTP-Posting-Date', # defined by INN 2.5.x or older
|
||||
'NNTP-Posting-Host', # defined by INN 2.5.x or older
|
||||
'Path',
|
||||
'Precedence', # Mailman
|
||||
'Received',
|
||||
'Status',
|
||||
'Return-Path',
|
||||
'To',
|
||||
'X-Antivirus',
|
||||
'X-Antivirus-Status',
|
||||
'X-Attachment-Test',
|
||||
'X-Beenthere', # Mailman
|
||||
'X-Complaints-To', # defined by INN 2.5.x or older
|
||||
'X-Lang-Test',
|
||||
'X-Mailman-Version', # Mailman
|
||||
'X-MSMail-Priority', # Outlook
|
||||
'X-NNTP-Posting-Host', # set by Schnuerpel 2009 or older
|
||||
'X-Originating-IP',
|
||||
'X-Priority', # Outlook
|
||||
'X-Provags-ID', # GMX/1&1
|
||||
'X-Spamassassin-Test',
|
||||
'X-Spam-Checker-Version',
|
||||
'X-Spam-Level',
|
||||
'X-Spam-Report',
|
||||
'X-Spam-Score',
|
||||
'X-Spam-Status',
|
||||
'X-Subject-Test',
|
||||
'X-Trace', # defined by INN 2.5.x or older
|
||||
'X-User-ID', # set by Schnuerpel 2009 or older
|
||||
'X-Virus-Scanned',
|
||||
'X-Y-Gmx-Trusted', # GMX/1&1
|
||||
'X-Zedat-Hint', # Uni Berlin/Individual?
|
||||
);
|
||||
|
||||
#albasani-workaround fuer @invalid
|
||||
if ($article->header('From') =~ /\@invalid[> ]/i) {
|
||||
my $newfrom = $article->header('From');
|
||||
$newfrom =~ s/\@invalid/\@invalid.invalid/i;
|
||||
$article->set_headers('From',$newfrom);
|
||||
}
|
||||
# albasani-workaround fuer leere User-Agent headerzeilen
|
||||
if (defined $article->header('User-Agent') and $article->header('User-Agent') !~ /\w/) {
|
||||
$article->drop_headers(('User-Agent'));
|
||||
}
|
||||
|
||||
#Neue Message-ID und Approved-Header erzeugen
|
||||
my $mid = defined($article->header('Message-ID')) ? $article->header('Message-ID') :
|
||||
'<' . substr (rand() . '-' . time(), 2) . '@' . $config{'mid_fqdn'} . '>';
|
||||
$article->set_headers('Message-ID', $mid, 'Approved', $approve_string);
|
||||
|
||||
#signieren
|
||||
if ($sign_pgpmoose)
|
||||
{
|
||||
my @msg = $article->sign_pgpmoose($moderated_group, $pgp_passphrase, $pgp_keyid);
|
||||
if (@msg)
|
||||
{
|
||||
print join("\n", 'News::Article::sign_pgpmoose ', @msg);
|
||||
}
|
||||
}
|
||||
|
||||
my @articleheaders = $article->header('References');
|
||||
eval {
|
||||
# Workaround fuer Buggy Software, die kaputte References erzeugt
|
||||
my @references = $article->header('References');
|
||||
if (@references > 1) {
|
||||
$article->set_headers('References', join "\n ", @references);
|
||||
}
|
||||
#posten
|
||||
$article->post($nntp) or die $!;
|
||||
#posted-Bit setzen, aktuelle MID in DB eintragen (wird in Zukunft vielleicht mal von einer Zusatzfunktion benoetigt)
|
||||
$dbi->set_posted_status($id,$mid);
|
||||
};
|
||||
# Fehler in Datenbank festhalten, sofern einer aufgetreten ist
|
||||
if ($@) {
|
||||
$dbi->increase_errorlevel($id, $@);
|
||||
$dbi->set_status($id, 'moderated', [ 'sending' ]);
|
||||
}
|
||||
}
|
||||
154
bin/read-mail.pl
Normal file
154
bin/read-mail.pl
Normal file
|
|
@ -0,0 +1,154 @@
|
|||
#!/usr/bin/perl -ws
|
||||
######################################################################
|
||||
#
|
||||
# $Id: read-mail.pl 306 2012-01-31 16:59:35Z root $
|
||||
#
|
||||
# Copyright 2009 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(confess);
|
||||
use News::Article();
|
||||
use MOD::Utils();
|
||||
use MOD::ReadMail();
|
||||
|
||||
######################################################################
|
||||
sub parse_text($)
|
||||
######################################################################
|
||||
{
|
||||
my $text = shift || confess;
|
||||
|
||||
my $article = News::Article->new($text);
|
||||
if (!$article)
|
||||
{
|
||||
print STDERR "Error: Parsing mail with News::Article failed.\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $bytes = $article->bytes();
|
||||
if ($bytes <= 2)
|
||||
{
|
||||
print STDERR "Error: Article too small, bytes=$bytes\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $article;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub skip_empty_lines($$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($body, $start, $stop) = @_;
|
||||
|
||||
my @result;
|
||||
push(@result, $body->[$start - 1]) if ($start > 0);
|
||||
|
||||
for(my $i = $start; $i <= $stop; $i += 2)
|
||||
{
|
||||
if (length($body->[$i]) != 0)
|
||||
{
|
||||
printf STDERR "check_for_empty_lines i=%d %s\n", $i, $body->[$i];
|
||||
return undef;
|
||||
}
|
||||
push @result, $body->[$i + 1];
|
||||
}
|
||||
return \@result;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub test_article($$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($rm, $article, $filename) = @_;
|
||||
|
||||
my $lines = $article->header('Lines');
|
||||
if (!$lines)
|
||||
{
|
||||
printf STDERR "Warning: No Lines header.\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
my @body = $article->body();
|
||||
my $delta = $lines * 2 - $#body;
|
||||
if (abs($delta) <= 2)
|
||||
{
|
||||
print $filename, "\n";
|
||||
printf "body: %d\n", $#body;
|
||||
printf "Lines: %d\n", $article->header('Lines');
|
||||
|
||||
my $new_body = skip_empty_lines(\@body, 1, $#body);
|
||||
if (!$new_body)
|
||||
{
|
||||
$new_body = skip_empty_lines(\@body, 0, $#body);
|
||||
return 0 if (!$new_body);
|
||||
}
|
||||
|
||||
printf "new_body=%d\n", $#$new_body;
|
||||
print join("\n", @$new_body);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub process_text($$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($rm, $article, $filename) = @_;
|
||||
|
||||
my $rc = eval { $rm->add_article($article, $::status); };
|
||||
if ($@)
|
||||
{
|
||||
print STDERR "add_article failed, $@\n";
|
||||
return 0;
|
||||
}
|
||||
if (!$rc)
|
||||
{
|
||||
printf STDERR "add_article(%s) failed, rc=%s\n",
|
||||
$::status ? $::status : '',
|
||||
$rc;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# MAIN
|
||||
######################################################################
|
||||
|
||||
die 'Argument -config=file missing' unless($::config);
|
||||
$::status = undef unless($::status); # to suppress warning
|
||||
$::stdin = undef unless($::stdin); # to suppress warning
|
||||
|
||||
my %config = MOD::Utils::read_private_config($::config);
|
||||
my $rm = MOD::ReadMail->new(\%config);
|
||||
|
||||
my $fn = $::test ? \&test_article : \&process_text;
|
||||
|
||||
if ($::stdin)
|
||||
{
|
||||
my $text = do { local $/; <STDIN>; };
|
||||
die "Error: No data on stdin" unless ($text);
|
||||
my $article = parse_text(\$text) || exit(1);
|
||||
$fn->($rm, $article, '<STDIN>');
|
||||
}
|
||||
else
|
||||
{
|
||||
for my $name(@ARGV)
|
||||
{
|
||||
my $file;
|
||||
open($file, '<', $name) || die "Error: Can't open $name\n$!";
|
||||
my $text = do { local $/; <$file>; };
|
||||
close($file);
|
||||
my $article = parse_text(\$text) || next;
|
||||
$fn->($rm, $article, $name);
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
74
bin/removeold.pl
Normal file
74
bin/removeold.pl
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
#!/usr/bin/perl
|
||||
######################################################################
|
||||
#
|
||||
# $Id: removeold.pl 148 2009-10-13 15:02:22Z alba $
|
||||
#
|
||||
# Copyright 2007 - 2009 Roman Racine
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(confess);
|
||||
use MOD::Utils();
|
||||
use MOD::DBIUtils();
|
||||
use MOD::Spamfilter();
|
||||
|
||||
my %config = MOD::Utils::read_private_config($ARGV[0]);
|
||||
my $dbi = MOD::DBIUtils->new(\%config) || confess;
|
||||
|
||||
{
|
||||
#Zeige Postings an, die zwischen 0 und 1 Tagen alt sind
|
||||
#und den Status 'moderated' haben.
|
||||
my $dataref = $dbi->select_old_postings(0,1,'moderated');
|
||||
while (my $ref = $dataref->fetchrow_arrayref) {
|
||||
my ($id,$posting) = @{$ref};
|
||||
#Fuettere sie an Spamassassin als Ham (kein Spam)
|
||||
MOD::Spamfilter::spamlearn($posting,0);
|
||||
}
|
||||
}
|
||||
|
||||
#Zeige Postings an, die aelter als x Tage sind und den
|
||||
#Status 'spam' tragen, d.h. in den letzten x Tagen
|
||||
#entweder von einem Moderator als Spam klassifiziert
|
||||
#worden sind oder bereits als Spam erkannt wurden, ohne
|
||||
#dass ein Moderator sie im Nachhinein als "kein Spam" klassifiziert
|
||||
#haette.
|
||||
|
||||
my $delete_spam_after = $config{'delete_spam_after'};
|
||||
if ($delete_spam_after)
|
||||
{
|
||||
my $dataref = $dbi->select_old_postings($delete_spam_after, undef, 'spam');
|
||||
while (my $ref = $dataref->fetchrow_arrayref) {
|
||||
my ($id,$posting) = @{$ref};
|
||||
#Fuettere sie an Spamassassin als Spam
|
||||
MOD::Spamfilter::spamlearn($posting,1);
|
||||
#Loesche das Posting
|
||||
$dbi->delete_posting($id);
|
||||
}
|
||||
}
|
||||
|
||||
#Zeige Postings an, die aelter als x Tage sind
|
||||
my $delete_posting_after = $config{'delete_posting_after'};
|
||||
if ($delete_posting_after)
|
||||
{
|
||||
my $dataref = $dbi->select_old_postings($delete_posting_after, undef, undef);
|
||||
while (my $ref = $dataref->fetchrow_arrayref) {
|
||||
my ($id,$posting) = @{$ref};
|
||||
#Loesche sie aus der Datenbank
|
||||
$dbi->delete_posting($id);
|
||||
}
|
||||
}
|
||||
|
||||
my $delete_error_after = $config{'delete_error_after'};
|
||||
if ($delete_error_after)
|
||||
{
|
||||
$dbi->delete_old_errors($delete_error_after, undef);
|
||||
}
|
||||
|
||||
# End of file
|
||||
123
bin/statistics.pl
Normal file
123
bin/statistics.pl
Normal file
|
|
@ -0,0 +1,123 @@
|
|||
#!/usr/bin/perl -w
|
||||
######################################################################
|
||||
#
|
||||
# $Id: statistics.pl 148 2009-10-13 15:02:22Z alba $
|
||||
#
|
||||
# Copyright 2009 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
use strict;
|
||||
use warnings;
|
||||
use MOD::Utils();
|
||||
use MOD::DBIUtilsPublic();
|
||||
use Data::Dumper;
|
||||
|
||||
######################################################################
|
||||
sub format_time($)
|
||||
######################################################################
|
||||
{
|
||||
my ( $seconds ) = @_;
|
||||
|
||||
my $hours = $seconds / 3600;
|
||||
$seconds %= 3600;
|
||||
my $minutes = $seconds / 60;
|
||||
$seconds %= 60;
|
||||
|
||||
return sprintf '%02d:%02d:%02d', $hours, $minutes, $seconds;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub format_item($)
|
||||
######################################################################
|
||||
{
|
||||
my ( $r ) = @_;
|
||||
|
||||
return sprintf
|
||||
"%5d %9s %9s %9s %9s",
|
||||
$r->{'count'},
|
||||
format_time($r->{'min'}),
|
||||
format_time($r->{'max'}),
|
||||
format_time($r->{'avg'}),
|
||||
format_time($r->{'median'})
|
||||
;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub print_stats($$)
|
||||
######################################################################
|
||||
{
|
||||
my ( $status, $r_stats ) = @_;
|
||||
|
||||
return unless ($r_stats->{'total'}->{'count'});
|
||||
|
||||
print "\n";
|
||||
if ($status eq 'all')
|
||||
{ print " All posts.\n"; }
|
||||
else
|
||||
{ printf " Posts of type %s.\n", $status; }
|
||||
print "\n";
|
||||
|
||||
for my $year(sort keys %$r_stats)
|
||||
{
|
||||
next if ($year eq 'total');
|
||||
my $r_month = $r_stats->{$year};
|
||||
|
||||
for my $month(sort keys %$r_month)
|
||||
{
|
||||
next if ($month eq 'total');
|
||||
my $r_mday = $r_month->{$month};
|
||||
|
||||
print "yyyy-mm-dd posts min max avg median\n";
|
||||
print "========================================================\n";
|
||||
for my $mday(sort keys %$r_mday)
|
||||
{
|
||||
next if ($mday eq 'total');
|
||||
my $r = $r_mday->{$mday};
|
||||
printf "%04d-%02d-%02d %s\n", $year, $month, $mday, format_item($r);
|
||||
}
|
||||
|
||||
my $r = $r_mday->{'total'};
|
||||
print "--------------------------------------------------------\n";
|
||||
printf "%04d-%02d %s\n", $year, $month, format_item($r);
|
||||
print "\n";
|
||||
}
|
||||
|
||||
my $r = $r_month->{'total'};
|
||||
print "========================================================\n";
|
||||
printf "%04d %s\n", $year, format_item($r);
|
||||
print "========================================================\n";
|
||||
print "\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# MAIN
|
||||
######################################################################
|
||||
|
||||
my %config = MOD::Utils::read_private_config($ARGV[0]);
|
||||
my $db = MOD::DBIUtilsPublic->new(\%config);
|
||||
my $statistics = $db->get_statistics();
|
||||
|
||||
my $all = $statistics->{'all'};
|
||||
|
||||
for my $status(
|
||||
'all',
|
||||
'pending',
|
||||
'moderated',
|
||||
'spam',
|
||||
'rejected',
|
||||
'deleted',
|
||||
'posted')
|
||||
{
|
||||
print_stats($status, $statistics->{$status});
|
||||
}
|
||||
|
||||
# print Dumper($statistics);
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue