From 30132626b826e3fd6c56d0f26bc18257d8976b7a Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sat, 29 Jan 2022 10:22:11 +0100 Subject: [PATCH] Initial checkin. Signed-off-by: Thomas Hochstein --- MOD/DBIUtils.pm | 261 ++++++++ MOD/DBIUtilsPublic.pm | 478 +++++++++++++ MOD/Displaylib.pm | 811 +++++++++++++++++++++++ MOD/Handler.pm | 281 ++++++++ MOD/NotificationSocket.pm | 85 +++ MOD/PublicHandler.pm | 159 +++++ MOD/ReadMail.pm | 131 ++++ MOD/Spamfilter.pm | 142 ++++ MOD/Utils.pm | 245 +++++++ MOD/lang/de.pm | 104 +++ MOD/lang/de_ch.pm | 42 ++ MOD/lang/de_de.pm-disable | 22 + MOD/lang/en_us.pm | 54 ++ TODO | 12 + bin/autoreply.pl | 109 +++ bin/fremdcancel.pl | 94 +++ bin/ircbot.pl | 261 ++++++++ bin/ircbot.sh | 37 ++ bin/mailget.pl | 100 +++ bin/mk-gpg-key.sh | 55 ++ bin/mk-summary.pl | 141 ++++ bin/new-passwd.pl | 24 + bin/poster.pl | 225 +++++++ bin/read-mail.pl | 154 +++++ bin/removeold.pl | 74 +++ bin/statistics.pl | 123 ++++ cgi-bin/modtable.pl | 12 + cgi-bin/public.pl | 13 + doc/CONTRIBUTORS | 12 + doc/environment.txt | 63 ++ doc/extra-modules.txt | 7 + doc/get-perl-modules.sh | 36 + doc/html/huhu.css | 208 ++++++ doc/html/index.html | 89 +++ doc/required-deb-packages.txt | 8 + doc/required-perl-modules.txt | 18 + doc/security.txt | 45 ++ etc/skel/.bashrc | 4 + etc/skel/.cshrc | 10 + etc/skel/.forward | 4 + etc/skel/.my.cnf | 3 + etc/skel/.procmailrc | 18 + etc/skel/backup/EMPTY | 0 etc/skel/bin/poster.sh | 16 + etc/skel/bin/read-mail.sh | 16 + etc/skel/bin/statistics.sh | 10 + etc/skel/etc/htdigest | 0 etc/skel/etc/htdigest.sh | 2 + etc/skel/etc/private.conf | 67 ++ etc/skel/etc/public.conf | 50 ++ etc/skel/etc/samples/apache-digest.conf | 11 + etc/skel/etc/samples/crontab | 29 + etc/skel/etc/samples/huhu-directory.html | 17 + etc/skel/etc/samples/summary.txt | 68 ++ etc/skel/var/EMPTY | 0 samples/crontab | 24 + samples/modtable.pl | 15 + samples/mysql/create.sql | 86 +++ samples/mysql/update-0.05-to-0.06.sql | 17 + samples/mysql/update-0.06-to-0.07.sql | 22 + samples/mysql/update-0.07-0.08.sql | 7 + samples/mysql/update-0.08-0.09.sql | 16 + samples/mysql/update-0.09-0.10.sql | 8 + samples/procmailrc | 19 + samples/public.pl | 14 + sbin/create-functions.sh | 123 ++++ sbin/create-mysql.sh | 12 + sbin/create-procmail-user.sh | 74 +++ 68 files changed, 5497 insertions(+) create mode 100644 MOD/DBIUtils.pm create mode 100644 MOD/DBIUtilsPublic.pm create mode 100644 MOD/Displaylib.pm create mode 100644 MOD/Handler.pm create mode 100644 MOD/NotificationSocket.pm create mode 100644 MOD/PublicHandler.pm create mode 100644 MOD/ReadMail.pm create mode 100644 MOD/Spamfilter.pm create mode 100644 MOD/Utils.pm create mode 100644 MOD/lang/de.pm create mode 100644 MOD/lang/de_ch.pm create mode 100644 MOD/lang/de_de.pm-disable create mode 100644 MOD/lang/en_us.pm create mode 100644 TODO create mode 100644 bin/autoreply.pl create mode 100644 bin/fremdcancel.pl create mode 100644 bin/ircbot.pl create mode 100644 bin/ircbot.sh create mode 100644 bin/mailget.pl create mode 100644 bin/mk-gpg-key.sh create mode 100644 bin/mk-summary.pl create mode 100644 bin/new-passwd.pl create mode 100644 bin/poster.pl create mode 100644 bin/read-mail.pl create mode 100644 bin/removeold.pl create mode 100644 bin/statistics.pl create mode 100644 cgi-bin/modtable.pl create mode 100644 cgi-bin/public.pl create mode 100644 doc/CONTRIBUTORS create mode 100644 doc/environment.txt create mode 100644 doc/extra-modules.txt create mode 100644 doc/get-perl-modules.sh create mode 100644 doc/html/huhu.css create mode 100644 doc/html/index.html create mode 100644 doc/required-deb-packages.txt create mode 100644 doc/required-perl-modules.txt create mode 100644 doc/security.txt create mode 100644 etc/skel/.bashrc create mode 100644 etc/skel/.cshrc create mode 100644 etc/skel/.forward create mode 100644 etc/skel/.my.cnf create mode 100644 etc/skel/.procmailrc create mode 100644 etc/skel/backup/EMPTY create mode 100644 etc/skel/bin/poster.sh create mode 100644 etc/skel/bin/read-mail.sh create mode 100644 etc/skel/bin/statistics.sh create mode 100644 etc/skel/etc/htdigest create mode 100644 etc/skel/etc/htdigest.sh create mode 100644 etc/skel/etc/private.conf create mode 100644 etc/skel/etc/public.conf create mode 100644 etc/skel/etc/samples/apache-digest.conf create mode 100644 etc/skel/etc/samples/crontab create mode 100644 etc/skel/etc/samples/huhu-directory.html create mode 100644 etc/skel/etc/samples/summary.txt create mode 100644 etc/skel/var/EMPTY create mode 100644 samples/crontab create mode 100644 samples/modtable.pl create mode 100644 samples/mysql/create.sql create mode 100644 samples/mysql/update-0.05-to-0.06.sql create mode 100644 samples/mysql/update-0.06-to-0.07.sql create mode 100644 samples/mysql/update-0.07-0.08.sql create mode 100644 samples/mysql/update-0.08-0.09.sql create mode 100644 samples/mysql/update-0.09-0.10.sql create mode 100644 samples/procmailrc create mode 100644 samples/public.pl create mode 100644 sbin/create-functions.sh create mode 100644 sbin/create-mysql.sh create mode 100644 sbin/create-procmail-user.sh diff --git a/MOD/DBIUtils.pm b/MOD/DBIUtils.pm new file mode 100644 index 0000000..61edfde --- /dev/null +++ b/MOD/DBIUtils.pm @@ -0,0 +1,261 @@ +###################################################################### +# +# $Id: DBIUtils.pm 305 2011-12-26 19:51:53Z root $ +# +# 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. +# +###################################################################### +package MOD::DBIUtils; + +use warnings; +use strict; +use Carp qw( confess ); + +use DBI(); +use MOD::Utils qw(read_private_config); +use News::Article(); +use MOD::DBIUtilsPublic(); +use Digest::SHA1(); + +push @MOD::DBIUtils::ISA,'MOD::DBIUtilsPublic'; + +###################################################################### +sub enter_table($$$$) +###################################################################### +{ + my ($self,$article,$status,$spamcount) = @_; + my %tmphash; + for my $headerdata (qw(Reply-To Subject Message-ID)) { + $tmphash{$headerdata} = defined($article->header($headerdata)) ? $article->header($headerdata) : ' '; + } + + my $table = $self->{'config'}->{'mysql_table'} || confess; + my $body = join("\n", $article->body()); + + my @columns = ( + 'Sender', + 'ReplyTo', + 'Subject', + 'MessageID', + 'Spamcount', + 'Status', + 'Header', + 'Body', + 'Datum', + 'checksum' + ); + my @values = ( + $article->header('From'), + $tmphash{'Reply-To'}, + $tmphash{'Subject'}, + $tmphash{'Message-ID'}, + $spamcount, + $status, + join("\n", $article->headers()), + $body, + ); + + my $value_format = '?,?,?,?,?,?,?,?,NOW(),SHA1(Body)'; + if ($status eq 'moderated') + { + push @columns, 'Moddatum'; + $value_format .= ',NOW()'; + } + + my $rc = $self->{'dbh'}->do( + 'INSERT IGNORE INTO ' . $table . + ' (' . join(',', @columns) . ')' . + ' VALUES(' . $value_format . ')', + undef, + @values + ); + if ($rc != 1) + { + my $msg = 'enter_table failed'; + my $article_id = undef; + + my $age = $self->{'config'}->{'check_duplicates_age'} || 7; + my $sha1 = Digest::SHA1::sha1_hex($body); + my $stmt = $self->{'dbh'}->prepare( + "SELECT id\n" . + "\nFROM " . $table . + "\nWHERE checksum=?" . + "\nAND Datum < DATE_SUB(CURDATE(), INTERVAL ? DAY);" + ); + $stmt->execute($sha1, $age); + my $row = $stmt->fetchrow_arrayref; + if ($row) + { + ( $article_id ) = @$row; + $msg = 'Duplicate received'; + } + + $msg .= "\n*** sha1_hex(\$body) ***\n" . $sha1; + for(my $i = 0; $i <= $#values; $i++) + { + if ($values[$i]) + { + $msg .= "\n*** " . $columns[$i] . "***\n" . $values[$i]; + } + } + $self->increase_errorlevel($article_id, $msg); + } + return $rc; +} + +###################################################################### +sub select_unposted($) +###################################################################### +{ + my $self = shift; + my $table = $self->{'config'}->{'mysql_table'} || confess; + my $query = $self->{'dbh'}->prepare( + "SELECT ID, CONCAT(header,\"\\n\\n\",body)\n" . + "FROM $table\n" . + "WHERE status='moderated'"); + $query->execute(); + return $query; +} + +###################################################################### +sub set_posted_status($$$) +###################################################################### +{ + my ($self,$id,$mid) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + $self->{'dbh'}->do( + "UPDATE $table\n" . + "SET status='posted', MessageID=(?)\n" . + "WHERE ID=(?)\n" . + "AND (status = 'moderated' OR status = 'sending')", + undef, $mid, $id + ); + $self->{'dbh'}->do( + "DELETE FROM ${table}_error\n" . + "WHERE article_id=(?)\n", + undef, $id + ); + return; +} + +###################################################################### +sub delete_posting($$) +###################################################################### +{ + my ($self,$id) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + $self->{'dbh'}->do( + "DELETE FROM $table" . + "\nWHERE ID=(?)" . + "\nAND status <> 'pending'" . + "\nAND status <> 'sending'", + undef, $id + ); +} + +###################################################################### +sub select_old_postings($$$$) +###################################################################### +{ + my ($self,$end,$start,$status) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + my $query = + "SELECT ID, CONCAT(header,\"\\n\\n\",body)" . + "\nFROM $table" . + "\nWHERE status <> 'pending'" . + "\nAND Datum < DATE_SUB(CURDATE(), INTERVAL ? DAY)"; + my @values = ( $end ); + if (defined($start)) { + $query .= "\nAND Datum > DATE_SUB(CURDATE(), INTERVAL ? DAY)"; + push @values, $start; + } + if (defined($status)) { + $query .= "\nAND status=?"; + push @values, $status; + } + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute(@values); + return $stmt; +} + +###################################################################### +sub delete_old_errors($$$$) +###################################################################### +{ + my ($self, $end, $start, $status) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + my $query = + "DELETE FROM ${table}_error" . + "\nWHERE error_date < DATE_SUB(CURDATE(), INTERVAL ? DAY)"; + my @values = ( $end ); + if (defined($start)) { + $query .= "\nAND error_date > DATE_SUB(CURDATE(), INTERVAL ? DAY)"; + push @values, $start; + } + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute(@values); + return $stmt; +} + +###################################################################### +sub select_pending($) +###################################################################### +{ + my $self = shift || die; + my $table = $self->{'config'}->{'mysql_table'} || confess; + my $query = + "select DISTINCT(if (length(replyto) > 1,replyto,sender)) AS Adresse" . + "\nFROM ${table}" . + "\nwhere status='pending'" . + "\nAND datum < DATE_SUB(NOW(), INTERVAL ? HOUR)" . + "\nAND datum > DATE_SUB(NOW(), INTERVAL ? HOUR)"; + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute( + $self->{'config'}->{'min_time_until_autoreply'}, + $self->{'config'}->{'max_time_until_autoreply'} + ); + return $stmt; +} + +###################################################################### +sub increase_errorlevel($$$) +###################################################################### +{ + my ($self, $article_id, $reason) = @_; + + my $query = sprintf( + "INSERT INTO %s_error\n" . + "(article_id, error_date, error_count, error_message)\n" . + "VALUES (?, NOW(), 1, ?)\n" . + "ON DUPLICATE KEY UPDATE\n" . + " error_count = IF(error_count + 1 > 100, 100, error_count + 1),\n" . + " error_date = NOW(),\n" . + " error_message=(?)", + $self->{'config'}->{'mysql_table'} + ); + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute($article_id, $reason, $reason); + return; +} + +###################################################################### +sub check_subject($$) +###################################################################### +{ + my ($self,$subject) = @_; + my $query = $self->{'dbh'}->prepare("select count(subject) from $self->{'config'}->{'mysql_table'} where subject=(?) and status='spam';"); + $query->execute($subject); + my ($result) = @{$query->fetchrow_arrayref}; + return $result; +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/DBIUtilsPublic.pm b/MOD/DBIUtilsPublic.pm new file mode 100644 index 0000000..a9a3515 --- /dev/null +++ b/MOD/DBIUtilsPublic.pm @@ -0,0 +1,478 @@ +###################################################################### +# +# $Id: DBIUtilsPublic.pm 267 2010-05-27 19:46:57Z 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. +# +###################################################################### +package MOD::DBIUtilsPublic; + +use warnings; +use strict; +use DBI; +use News::Article; +use Carp qw(confess); +use Time::Local; + +sub display_single; +sub set_status; +sub set_status_by_moderator; +sub displayrange; +sub get_working_by_id; +sub get_reason; +sub set_rejected; +sub get_statistics; + +# 'spam' can be put back to 'pending' queue +# 'moderated' tells poster.pl to send the message via NNTP (there is +# no safe way to undo this) +# 'rejected' means that a mail was sent the poster - cannot be undone +# 'deleted' can be put back to 'pending' queue +# 'posted' means that message was sent to server - cannot be undone + +use constant NOT_FINAL => + "status <> 'rejected' AND status <> 'posted' AND status <> 'sending'"; + +###################################################################### +# Constructor, open a new connection to the database +###################################################################### +sub new($$) +###################################################################### +{ + my ($class,$configref) = @_; + my $self = {}; + $self->{'config'} = $configref; + $self->{'dsn'} = "DBI:mysql:database=$self->{'config'}->{'mysql_db'};host=$self->{'config'}->{'mysql_host'};port=$self->{'config'}->{'mysql_port'}"; + $self->{'dbh'} = DBI->connect($self->{'dsn'},$self->{'config'}->{'mysql_username'},$self->{'config'}->{'mysql_password'}, + { RaiseError => 1}) + or die($DBI::errstr); + + bless $self,$class; + return $self; +} + + +##Die nachfolgenden Methoden sind fuer den Gebrauch im Webinterface bestimmt, alle Methoden, die den Zustand der DB +##aendern, muessen idempotent sein! + +###################################################################### +# Update the Status of a posting +###################################################################### +sub set_status($$$$) +###################################################################### +{ + my ($self, $id, $newstatus, $prevstatus) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + my $query = + "UPDATE $table" . + "\nSET status=(?)" . + "\nWHERE id=(?)"; + if ($prevstatus) + { + $query .= "\nAND (\n status = '"; + $query .= join("'\n OR status = '", @$prevstatus); + $query .= "'\n)"; + } + else + { + $query .= "\nAND " . NOT_FINAL; + } + + my $stmt = $self->{'dbh'}->prepare($query); + return $stmt->execute($newstatus, $id); +} + +###################################################################### +# Update the Status of a posting +###################################################################### +sub set_status_by_moderator() +###################################################################### +{ + my ($self, $newstatus, $id, $moderator) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + $self->{'dbh'}->do( + "UPDATE $table" . + "\nSET status=(?), Moderator=(?), Moddatum=NOW()" . + "\nWHERE id=(?)" . + "\nAND " . NOT_FINAL, + undef, $newstatus, $moderator, $id + ); +} + +###################################################################### +sub set_rejected($$$$$) +###################################################################### +{ + my ($self, $newstatus, $article_id, $moderator, $reply) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + $self->set_status_by_moderator($newstatus, $article_id, $moderator); + + my $query = sprintf( + "INSERT INTO %s_reply\n" . + "(article_id, reply_date, reply_message)\n" . + "VALUES (?, NOW(), ?)\n" . + "ON DUPLICATE KEY UPDATE\n" . + " reply_date = NOW(),\n" . + " reply_message=(?)", + $table + ); + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute($article_id, $reply, $reply); +} + +###################################################################### +sub set_reply($$$) +###################################################################### +{ + my ($self, $article_id, $reply) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + my $query = sprintf( + "INSERT INTO %s_reply\n" . + "(article_id, reply_date, reply_message)\n" . + "VALUES (?, NOW(), ?)\n" . + "ON DUPLICATE KEY UPDATE\n" . + " reply_date = NOW(),\n" . + " reply_message=(?)", + $table + ); + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute($article_id, $reply, $reply); +} + +###################################################################### +# Display a range out of a table +###################################################################### +sub displayrange($$$$$) +###################################################################### +{ + my ($self,$status,$start,$number_of_results,$overviewref) = @_; + $start = 0 if ($start !~ /^\d+$/); + $number_of_results = 1 if ($number_of_results !~ /^\d+$/); + + my $table = $self->{'config'}->{'mysql_table'} + || confess 'No "mysql_table" in config'; + + my $query = sprintf( + "SELECT %s" . + "\nFROM %s" . + "\nWHERE status=(?)" . + "\nORDER BY ID DESC" . + "\nLIMIT %d,%d", + join(',', @$overviewref), + $table, + $start, $number_of_results + ); + + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute($status); + return $stmt; +} + +###################################################################### +# display a single entry of a table +###################################################################### +sub display_single($$$) +###################################################################### +{ + my ($self,$status,$id) = @_; + + my $table = $self->{'config'}->{'mysql_table'} || confess; + + my $query = + "SELECT CONCAT(header, \"\\n\\n\", body)," . + "\n Status," . + "\n Spamcount," . + "\n Moderator," . + "\n Moddatum AS 'Decision Date'," . + "\n Flag" . + "\nFROM $table" . + "\nWHERE id=(?)"; + my @param = ( $id ); + + if ($status) + { + $query .= "\nAND Status=(?)"; + push @param, $status; + } + + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute(@param); + return $stmt; +} + +###################################################################### +sub set_status_posted($$$) +###################################################################### +{ + my ($self,$id,$user) = @_; + return $self->set_status_by_moderator('moderated', $id, $user); +} + +###################################################################### +sub get_working_by_id($$) +###################################################################### +{ + my ($self,$id) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + my $query = $self->{'dbh'}->prepare( + "SELECT" . + "\n CONCAT(header,\"\\n\\n\",body) AS Posting," . + "\n if (length(replyto) > 1,replyto,sender) AS Adresse" . + "\nFROM $table" . + "\nWHERE ID=(?)" . + "\nAND " . NOT_FINAL + ); + $query->execute($id); + return $query; +} + +###################################################################### +sub get_reason($$) +###################################################################### +{ + my ($self,$id) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + my $query = $self->{'dbh'}->prepare( + "SELECT reply_message" . + "\nFROM ${table}, ${table}_reply" . + "\nWHERE ${table}.id = ${table}_reply.article_id" . + "\nAND article_id=(?)" . + "\nAND (status='rejected' OR status='deleted') + "); + $query->execute($id); + return $query; +} + +###################################################################### +sub display_errors($$$$$) +###################################################################### +{ + my ($self,$status,$start,$number_of_results,$overviewref) = @_; + $start = 0 if ($start !~ /^\d+$/); + $number_of_results = 1 if ($number_of_results !~ /^\d+$/); + + my $table = $self->{'config'}->{'mysql_table'} || confess; + + my $query = sprintf( + "SELECT %s" . + "\nFROM %s_error_view" . + "\nORDER BY error_date DESC" . + "\nLIMIT %d, %d", + join(',', @$overviewref), + $table, + $start, $number_of_results + ); + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute(); + return $stmt; +} + +###################################################################### +sub get_errormessage($$) +###################################################################### +{ + my ($self,$id) = @_; + + my $table = $self->{'config'}->{'mysql_table'} || confess; + + my $query = sprintf( + "SELECT error_message" . + "\nFROM %s_error" . + "\nWHERE error_id=(?)", + $table + ); + my $stmt = $self->{'dbh'}->prepare($query); + $stmt->execute($id); + return $stmt; +} + +###################################################################### +sub invert_flag($$) +###################################################################### +{ + my ($self,$id) = @_; + my $table = $self->{'config'}->{'mysql_table'} || confess; + $self->{'dbh'}->do( + "UPDATE $table" . + "\nSET flag = !flag" . + "\nWHERE ID=(?)" . + "\nAND " . NOT_FINAL, + undef, $id + ); +} + +###################################################################### +sub calc_item_stats($$) +###################################################################### +{ + my ($r_result, $r_items) = @_; + + my @items = sort { $a <=> $b }( @$r_items ); + return undef unless($#items >= 0); + + my $sum = 0; + for my $i( @items ) { $sum += $i; } + + my $nr_items = 1 + $#items; + my $pivot = int($nr_items / 2); + my $median = $items[$pivot]; + if (($nr_items % 2) == 0) + { + $median = ( $median + $items[$pivot - 1] ) / 2; + } + + $r_result->{'count'} = $nr_items; + $r_result->{'sum'} = $sum; + $r_result->{'avg'} = $sum / $nr_items; + $r_result->{'median'} = $median; + $r_result->{'min'} = $items[0]; + $r_result->{'max'} = $items[ $#items ]; + + return $r_items; +} + +###################################################################### +sub get_reaction_time($;$$$) +###################################################################### +{ + my ( $self, $from, $to, $status ) = @_; + + # Warning: Plain "Moddatum - Datum" returns strange values when + # crossing day boundaries. Using unix_timestamp instead. + + my $query = + "select unix_timestamp(Datum), timestampdiff(SECOND, Datum, Moddatum)" . + "\nfrom " . $self->{'config'}->{'mysql_table'} . + "\nwhere datum is not null" . + "\nand Moddatum is not null" . + "\nand Datum is not null"; + + if ($from) + { $query .= "\nand datum >= from_unixtime($from)"; } + if ($to) + { $query .= "\nand datum < from_unixtime($to)"; } + if ($status) + { $query .= "\nand Status = '$status'"; } + + my $sth = $self->{'dbh'}->prepare($query); + $sth->execute(); + + my %result; + while(my $row = $sth->fetchrow_arrayref ) + { + my $datum = 0 + $row->[0]; + my $reaction_time = 0 + $row->[1]; + my ($sec, $minute, $hour, $mday, $month, $year, $wday, $yday, $isdst) = + localtime($datum); + + my $y = sprintf("%04d", $year + 1900); + my $m = sprintf("%02d", $month + 1); + my $d = sprintf("%02d", $mday); + + my $items = $result{$y}->{$m}->{$d}->{'items'}; + if (defined( $items )) + { + push @$items, $reaction_time; + } + else + { + $result{$y}->{$m}->{$d}->{'items'} = [ $reaction_time ]; + } + } + + # we are going to modify the hash so we need robust iteration + my @year = keys(%result); + my @all_items; + + for my $year(@year) + { + my $r_month = $result{$year}; + my @month = keys(%$r_month); + my @year_items; + + for my $month(@month) + { + my $r_mday = $r_month->{$month}; + my @mday = keys(%$r_mday); + my @month_items; + + for my $mday(@mday) + { + my $r = $r_mday->{$mday}; + my $r_items = $r->{'items'}; + push @month_items, @$r_items; + calc_item_stats($r, $r_items); + # delete $r->{'items'}; + } + + push @year_items, @month_items; + calc_item_stats($r_mday->{'total'} = {}, \@month_items); + } + push @all_items, @year_items; + calc_item_stats($r_month->{'total'} = {}, \@year_items); + } + calc_item_stats($result{'total'} = {}, \@all_items); + + return \%result; +} + +###################################################################### +sub get_statistics($) +###################################################################### +{ + my ($self) = @_; + my $dbh = $self->{'dbh'} + || confess 'No "dbh" in self'; + my $table = $self->{'config'}->{'mysql_table'} || confess; + + # + # Warning: The combination of union and selectall_arrayref does not + # like null values. They are just ommitted from the result. + # + my $arrayref = $dbh->selectall_arrayref( + "select unix_timestamp(min(datum)) from $table" . + "\nunion" . + "\nselect unix_timestamp(max(datum)) from $table" + ); + + if (!$arrayref) { return undef; } + if (!$arrayref->[1]) { return undef; } + if (!$arrayref->[0]) { return undef; } + + # add 1 because query is (datum >= min and datum < max) + my $to = 1 + $arrayref->[1]->[0]; + my $from = $arrayref->[0]->[0]; + undef $arrayref; + + my $result = { + 'all' => $self->get_reaction_time($from, $to) + }; + for my $status( + 'pending', + 'moderated', + 'spam', + 'rejected', + 'deleted', + 'posted', + 'sending') + { + $result->{$status} = $self->get_reaction_time($from, $to, $status); + } + + return $result; +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/Displaylib.pm b/MOD/Displaylib.pm new file mode 100644 index 0000000..6af529b --- /dev/null +++ b/MOD/Displaylib.pm @@ -0,0 +1,811 @@ +###################################################################### +# +# $Id: Displaylib.pm 305 2011-12-26 19:51:53Z 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. +# +###################################################################### +package MOD::Displaylib; + +use strict; +use warnings; +use Carp qw( confess ); + +use Mail::Mailer(); +use News::Article(); +use News::Article::Response(); +use MIME::QuotedPrint(); +use MIME::Base64(); +use Encode(); +use CGI(); +use CGI::Pretty(); + +use MOD::DBIUtilsPublic; +use MOD::Utils; + +use constant VERSION => 0.09; + +use constant MENU_MESSAGES => [ + [ 'pending', 'Pending' ], + [ 'spam', 'Spam' ], + [ 'moderated', 'Approved' ], + [ 'posted', 'Posted' ], + [ 'rejected', 'Rejected' ], + [ 'deleted', 'Deleted' ], + [ 'errors', 'Error Messages' ], +]; +use constant MENU_CONFIGURATION => undef; + +use constant MENU_MAIN => [ + [ 'pending', 'Messages', MENU_MESSAGES ], + [ 'config', 'Configuration', MENU_CONFIGURATION ], +]; + +###################################################################### +sub new($$$) +###################################################################### +{ + my ($class, $configref, $privileged) = @_; + my $self = {}; + + $self->{'db'} = MOD::DBIUtilsPublic->new($configref); + my $q = $self->{'q'} = CGI->new(); + + my $self_url = $q->self_url; + $self_url =~ s/\?+.+$//; + $self->{'self_url'} = $self_url; + + $self->{'config'} = $configref; + $self->{'privileged'} = $privileged; + + my $lang = MOD::Utils::get_translator_language( + $configref->{'html_language'}, + $configref->{'http_negotiate_language'} + ); + $self->{'trans_lang'} = $lang; + $self->{'trans'} = MOD::Utils::get_translator($lang); + + if ($privileged) + { + my $authentication = $configref->{'http_authentication_method'}; + die "No 'http_authentication_method' in configuration file." unless($authentication); + + if ($q->auth_type() && $q->auth_type() eq $authentication) + { + $self->{'user_name'} = $q->remote_user(); + } + elsif ($authentication eq 'None') + { + $self->{'user_name'} = $q->remote_host(); + } + die 'Not authorized' unless($self->{'user_name'}); + } + + bless $self, $class; + return $self; +} + +###################################################################### +sub display_start($;$$$@) +###################################################################### +{ + my $self = shift; + my %args = @_; + + my $trans = $self->{'trans'} || confess 'No translator'; + my $title = $args{'-title'} || confess 'No -title'; + $title = $trans->($title); + + my $group = $self->{'config'}->{'moderated_group'}; + my @title; + push @title, '[*]' if ( $args{'-mark'} ); + push @title, $group if ($group); + push @title, $title if ($title); + + my $q = $self->{'q'}; + my @head = ($q->meta({ + -http_equiv => 'expires', + -content => '0' + })); + + my $refresh = $args{'-refresh'}; + if ($refresh) + { + push @head, $q->meta({ + -http_equiv => 'Refresh', + -content => $refresh + }); + } + + my @param = ( + -title => join(' ', @title), + -head => \@head + ); + + my $css = $self->{'config'}->{'html_stylesheet_href'}; + if ($css) + { push @param, -style => { -src => $css }; } + + print + $q->header, + $q->start_html( @param ); + $self->print_menu_items() if ($self->{'privileged'}); + + print '
'; + print $q->h1($title); + my $subtitle = $args{'-subtitle'}; + if ($subtitle) + { + printf '
%s
', $trans->($subtitle); + } +} + +###################################################################### +sub display_end($) +###################################################################### +{ + my ($self) = @_; + + my $group = $self->{'config'}->{'moderated_group'}; + my $user = $self->{'user_name'}; + + my @a; + push @a, $group if ($group); + push @a, $self->{'trans_lang'}; + push @a, $user if ($user); + push @a, 'huhu version ' . VERSION; + + print + '
', + join(' · ', @a), + '.
', + '
', + $self->{'q'}->end_html; +} + +###################################################################### +sub display_die_msg($$$) +###################################################################### +{ + my ($self, $title, $msg) = @_; + my $trans = $self->{'trans'} || confess 'No translator'; + + $self->display_start(-title => 'Error'); + print '
', + $trans->($msg ? $msg : $title), + '
'; + $self->display_end(); +} + +###################################################################### +sub display_table($@) +###################################################################### +{ + my $self = shift || confess 'No $self'; + my %args = @_; + + my $status = $args{'-status'} || confess 'No -status'; + my $start = $args{'-start'}; # can be 0 + my $no_of_elements = $args{'-no_of_elements'} || confess 'No -no_of_elements'; + my $overviewref = $args{'-overviewref'} || confess 'No -overviewref'; + my $decisionref = $args{'-decisionref'} || confess 'No -decisionref'; + my $cmd = $args{'-cmd'}; + + my @hidden_columns = ( 'flag', 'id' ); + { + my $extra_hidden_columns = $args{'-hiddencolumns'}; + if ($extra_hidden_columns) { + push @hidden_columns, @$extra_hidden_columns; + } + } + my @columns = ( @hidden_columns, @$overviewref ); + + my $db = $self->{'db'} || confess 'No "db" in $self'; + + my $dataref; + if ($status eq 'errors' and $self->{'privileged'}) { + $dataref = $db->display_errors($status,$start,$no_of_elements,\@columns); + } else { + $dataref = $db->displayrange($status,$start,$no_of_elements,\@columns); + } + + my $trans = $self->{'trans'} || confess 'No translator'; + my $sqlnames = $dataref->{'NAME'} || confess 'No "NAME" in $dataref'; + my @names = map { CGI::escapeHTML($trans->( $_ )) } ( + @$sqlnames[1 + $#hidden_columns .. $#$sqlnames], + 'Available Actions' + ); + + my $ref = $dataref->fetchrow_arrayref(); + my $q = $self->{'q'} || confess 'No "q" in $self'; + + $self->display_start( + -title => $args{'-title'}, + -subtitle => $args{'-subtitle'}, + -mark => $ref && $self->{'privileged'}, + -refresh => '300; ' . $q->url() . '?' . $cmd + ); + + print ''; + print $q->Tr($q->th({-align=>'left'},\@names)); + + my $css = $self->{'config'}->{'html_stylesheet_href'}; + my $flagattr = ($css) ? ' class="huhuFlag"' : ' bgcolor="#ffcccc"'; + + my $row_nr = 0; + if ($ref) { + do { + $row_nr++; + my @dataline = @{$ref}; + my $flag = $dataline[0]; + my $rowattr = ($flag and $self->{'privileged'}) + ? $flagattr + : ($row_nr % 2) + ? ' class="huhuOdd"' + : ' class="huhuEven"'; + + my $id = $dataline[1]; + print ""; + for my $i(1 + $#hidden_columns .. $#dataline) { + my $data = $dataline[$i]; + $data = CGI::escapeHTML(substr($self->decode_line($data),0,40)); + $data =~ s/\@/#/g if (!defined($self->{'user_name'})); + print $q->td($data); + } + print'',"\n"; + } while ($ref = $dataref->fetchrow_arrayref); + } + + if ($row_nr == 0) + { + printf ''; + } + + print "
'; + $self->display_decisionbuttons($decisionref, $ref, \@hidden_columns); + print '
', 1 + $#names; + print $trans->('No matching records available.'); + print '
\n"; + $self->nextpage($cmd, $start, $args{'-display_per_page'}); + + $self->display_end(); + return; +} + +sub display_reason { + my ($self,$id,$decisionref,$title) = @_; + my $dataref = $self->{'db'}->get_reason($id); + my $reason; + eval { + ($reason) = @{$dataref->fetchrow_arrayref}; + }; if ($@) { + $self->display_die_msg('No reason stored in database!'); + return; + } + + $self->display_start(-title => $title); + + print + '
', + '
', CGI::escapeHTML($reason), '
', + '
'; + $self->display_decisionbuttons($decisionref, [ $id ]); + print $self->{'q'}->end_html; + return; +} + +sub display_navigation_back() { + my ($self) = @_; + my $q = $self->{'q'} || confess 'No q'; + my $trans = $self->{'trans'} || confess 'No translator'; + print + '
', + '', + $q->a({ href => $q->referer() }, $trans->('Back')), + '', + '
'; +} + +sub display_article_info($$$) +{ + my ( $self, $sqlnames, $row ) = @_; + + $sqlnames || confess 'No "NAME" in $dataref'; + $row || confess 'No $row'; + $#$row == $#$sqlnames || confess '$#$row != $#$sqlnames'; + + my @a; + for(my $i = 1; $i <= $#$row; $i++) + { + my $value = $row->[$i]; + if ($value) + { + push @a, + CGI::escapeHTML($sqlnames->[$i]) . + ': ' . + CGI::escapeHTML($value); + } + } + if (@a) + { + print + '
', + join(' · ', @a), + '
'; + } +} + +###################################################################### +sub display_article($@) +###################################################################### +{ + my $self = shift || confess 'No $self'; + my %args = @_; + + my $status = $args{'-status'}; + my $id = $args{'-id'}; + my $headerref = $args{'-headerref'}; + my $decisionref = $args{'-decisionref'}; + my $fullheader = $args{'-fullheader'}; + + if ($status eq 'errors') { + $status = undef; + } + + my $dataref = $self->{'db'}->display_single($status,$id); + my $row = $dataref->fetchrow_arrayref; + if (!$row || $#$row < 1) { + $self->display_die_msg('_ALREADY_HANDLED' . " (status=$status, id=$id)"); + return; + } + + my $article = $self->decode_article(News::Article->new(\$row->[0])); + + $self->display_start(-title => 'Selected Article'); + $self->display_article_info($dataref->{'NAME'}, $row); + my $q = $self->{'q'} || confess 'No "q" in $self'; + + print ''; + if ($fullheader) { + my $header = join "\n",$article->headers(); + print $q->Tr($q->td({-colspan=>2},'
' . CGI::escapeHTML($header) .'
')); + } else { + for my $headerline (@{$headerref}) { + print + '', + '', + '', + ''; + } + } + my @ngs = split ',', $article->header('Newsgroups'); + if ($self->{'user_name'} && @ngs > 2) + { + my $trans = $self->{'trans'} || confess 'No translator'; + print $q->Tr($q->td( + {-colspan=>2,-bgcolor=>'#ffcccc'}, + $trans->( '_CROSSPOSTED' ) + )); + } + + print $q->Tr($q->td({-colspan=>2}, + '
' . CGI::escapeHTML(join ("\n",$article->body())) . '
')), + '
', CGI::escapeHTML($headerline), '', CGI::escapeHTML($article->header($headerline)), '
\n
'; + $self->display_decisionbuttons($decisionref, [ $id ]); + print "
"; + + $self->display_navigation_back(); + print $q->end_html; + return; +} + +###################################################################### +sub display_errormessage($$$) +###################################################################### +{ + my ($self, $id, $title) = @_; + my $dataref = $self->{'db'}->get_errormessage($id); + my $input; + eval { + ($input) = @{$dataref->fetchrow_arrayref}; + }; if ($@) { + $self->display_die_msg('_ERROR_GONE'); + return; + } + + $self->display_start(-title => $title); + my $q = $self->{'q'}; + + print '
',
+        CGI::escapeHTML($input),
+	'
'; + $self->display_navigation_back(); + print $q->end_html; + return; +} + +###################################################################### +sub generate_answer($$$$) +###################################################################### +{ + my ($self, $id, $behaviour, $title) = @_; + my $db = $self->{'db'} || confess 'No "db" in $self'; + my $trans = $self->{'trans'} || confess 'No translator'; + my $q = $self->{'q'} || confess 'No q'; + + # first of all move the article out of the pending queue + $db->set_status_by_moderator('deleted', $id, $self->{'user_name'}); + + my $dataref = $db->get_working_by_id($id); + my ($input,$addr); + eval { + ($input,$addr) = @{$dataref->fetchrow_arrayref}; + }; if ($@) { + $self->display_die_msg('_ALREADY_HANDLED'); + return; + } + my $article = $self->decode_article(News::Article->new(\$input)); + + my $attribution = sprintf( + $trans->('%s wrote:'), + $article->header('From') + ); + + my $response = News::Article->response( + $article, + { + 'From' => $self->{'config'}->{'mailfrom'}, + }, + 'respstring' => sub { return $attribution; } + ); + + my $body = join ("\n",$response->body()); + $self->display_start(-title => $title); + + if ($behaviour eq 'answer') + { + print + $q->start_form, + $q->hidden(-name => 'id', -value => $id), + $q->table + ( + $q->Tr([ + $q->td(['From', $self->{'config'}->{'mailfrom'}]), + $q->td(['To', CGI::escapeHTML($addr)]), + $q->td(['Subject', CGI::escapeHTML($response->header('Subject'))]), + $q->td( + { -colspan => 2}, + $q->textarea({ + -name =>'antwort', + -cols => 80, + -rows => 40, + -default => $body, + -wrap => 'hard' + }) + ), + $q->td( + { -colspan => 2 }, + $q->submit( + -name => 'action.Send Mail', + -value => $trans->('Send Mail') + ), + $q->submit( + -name => 'action.Put back in queue', + -value => $trans->('Put back in queue') + ) + ) + ]) + ), + $q->end_form; + } + else + { + print + $trans->('_EXPLAIN_REASON'), + $q->start_form, + $q->hidden({ -name => 'id', -value => $id }), + $q->textarea({ + -name => 'antwort', + -cols => 80, + -rows => 40, + -default => $body, + -wrap => 'hard' + }), + '
', + $q->submit( + -name => 'action.Delete and save reason', + -value => $trans->('Delete and save reason') + ), + $q->submit( + -name => 'action.Put back in queue', + -value => $trans->('Put back in queue') + ), + $q->end_form; + } + print $q->end_html; + return; +} + +###################################################################### +sub delete_posting +###################################################################### +{ + my ($self,$id) = @_; + my $antwort = $self->{'q'}->param('antwort'); + $antwort =~ s/\>/>/sg; + $antwort =~ s/\</{'db'}->set_rejected('deleted', $id, $self->{'user_name'}, $antwort); + return; +} + +###################################################################### +sub send_mail($$) +###################################################################### +{ + my ($self,$id) = @_; + my $antwort = $self->{'q'}->param('antwort'); + $antwort =~ s/\>/>/sg; + $antwort =~ s/\</{'trans'} || confess 'No translator'; + + my $dataref = $self->{'db'}->get_working_by_id($id); + my ($input,$addr); + eval { + ($input,$addr) = @{$dataref->fetchrow_arrayref}; + }; if ($@) { + $self->display_die_msg('_ALREADY_HANDLED'); + return 0; + } + + my $article = News::Article->new(\$input); + my $original_subject = $article->header('Subject'); + if (!$original_subject) + { $original_subject = $trans->('No subject'); } + + $article = $self->decode_article($article); + if ($addr =~ /(,|\n)/s or $addr =~ /invalid>$/) { + $self->display_die_msg('_ERROR_INVALID_ADDRESS'); + return 0; + } + my $mailer = new Mail::Mailer; + + my $subject_prefix = $trans->('Your post regarding'); + $original_subject =~ s/(AW|Re):\s*$subject_prefix\s*/Re:/i; + + $mailer->open({ + 'From' => $self->{'config'}->{'mailfrom'}, + 'Subject' => $subject_prefix . ' ' . $original_subject, + 'To' => $addr, + 'Content-Type' => "text/plain;\n charset=\"". $self->{'config'}->{'html_content_type'}. '"', + 'Content-Transfer-Encoding' => '8bit' + }); + print $mailer $antwort; + $mailer->close(); + $self->{'db'}->set_rejected('rejected', $id, $self->{'user_name'}, $antwort); + return 1; +} + +###################################################################### +sub display_decisionbuttons +###################################################################### +{ + my ($self, $decisionref, $hidden_values, $hidden_names) = @_; + + $hidden_names = [ 'id' ] unless($hidden_names); + + my $q = $self->{'q'} || confess 'No "q" in $self'; + my $trans = $self->{'trans'} || confess 'No translator'; + + print $q->start_form; + for(my $i = 0; $i <= $#$hidden_names; $i++) + { + printf + '', + $hidden_names->[$i], $hidden_values->[$i]; + } + for my $decision (@{$decisionref}) + { + print $q->submit( + -name => 'action.' . $decision, + -label => CGI::escapeHTML($trans->($decision)) + ); + } + print $q->end_form; + return; +} + + +sub nextpage { + my ($self, $cmd, $start, $display_per_page) = @_; + + my $q = $self->{'q'} || confess 'No "q" in $self'; + $cmd || confess 'No $cmd'; + my $trans = $self->{'trans'} || confess 'No translator'; + + if (!defined($display_per_page) || $display_per_page !~ /^\d+$/) + { + $display_per_page = $self->{'config'}->{'display_per_page'}; + } + $start = 0 if ($start !~ /^\d+$/); + + my $before = $start - $display_per_page; + my $next = $start + $display_per_page; + $before = 0 if ($before < 0); + my $self_url = $self->{'self_url'} || confess; + + print '
', + $q->a( + { href => $self_url . '?'. $cmd . ',' . $before }, + $trans->('Previous page') + ), + '', + $q->a( + { href => $self_url . '?'. $cmd . ',' . $next }, + $trans->('Next page') + ), + '
'; + return; +} + +###################################################################### +sub print_menu_items($$$) +###################################################################### +{ + my $self = shift || confess; + my $r_items = shift || MENU_MAIN; + my $level = shift || 0; + + my $self_url = $self->{'self_url'} || confess; + my $trans = $self->{'trans'} || confess 'No translator'; + + printf ''; +} + +sub set_status_by_moderator { + my ($self, $newstatus, $id) = @_; + $self->{'db'}->set_status_by_moderator($newstatus, $id, $self->{'user_name'}); + return; +} + +sub post { + my ($self,$id) = @_; + $self->{'db'}->set_status_posted($id, $self->{'user_name'}); + return; +} + +sub decode_article { + my ($self, $article) = @_; + + $self || confess 'No $self'; + $article || confess 'No $article'; + + for my $headerline (qw(Subject From Reply-To)) { + $article->set_headers($headerline,$self->decode_line($article->header($headerline))); + } + + my $body = join "\n",$article->body(); + + if (defined($article->header('Content-Transfer-Encoding')) and + $article->header('Content-Transfer-Encoding') eq 'quoted-printable') { + $body = MIME::QuotedPrint::decode($body); + } + my $encoding; + if (defined($article->header('Content-Type')) and + $article->header('Content-Type') =~ m|^text/plain;.+charset=[\s"]*([\w-]+)[\s"]?|si) { + $encoding = $1; + } else { + $encoding = 'iso-8859-1'; + } + eval { + if (Encode::find_encoding($encoding)->perlio_ok) { + Encode::from_to($body,$encoding,$self->{'config'}->{'html_content_type'}); + } + }; + $article->set_body(($body)); + return $article; +} + +sub decode_line { + my ($self,$line) = @_; + if (!$self->{'privileged'}) { + $line =~ s/\@/#/g; + } + my $newline; + while ($line =~ s/^(.*?)=\?([^?]+)\?(.)\?([^?]*)\?=(?:\r?\n +)?//s) { + my ($before,$charset,$encoding,$content) = ($1,$2,lc($3),$4); + $newline .= $before; + if ($encoding eq 'q') { + $content =~ s/_/ /g; + $content = MIME::QuotedPrint::decode($content); + chomp $content; + } elsif ($encoding eq 'b') { + $content = MIME::Base64::decode($content); + } + eval { + if (Encode::find_encoding($charset)->perlio_ok) { + Encode::from_to($content,$charset,$self->{'config'}->{'html_content_type'}); + } + }; + $newline .= $content; + } + $newline .= $line; + return $newline; +} + +sub set_flag { + my ($self,$id) = @_; + $self->{'db'}->invert_flag($id); + return; +} + +use constant SHOW_CONFIG => ( + 'approve_string', + 'check_duplicates_age', + 'display_per_page', + 'followup_to', + 'html_content_type', + 'http_authentication_method', + 'http_negotiate_language', + 'mailfrom', + 'moderated_group', + 'mysql_host', + 'mysql_port', + 'mysql_username', +); + +###################################################################### +sub display_config($) +###################################################################### +{ + my $self = shift || confess; + + my $q = $self->{'q'} || confess 'No "q" in $self'; + my $trans = $self->{'trans'} || confess 'No "trans" in $self'; + my $config = $self->{'config'} || confess 'No "config" in $self'; + + $self->display_start( + -title => $trans->('Configuration'), + # -subtitle => $args{'-subtitle'}, + -mark => 0, + # -refresh => '300; ' . $q->url() . '?' . $cmd + ); + + print ''; + print $q->Tr($q->th({-align=>'left'}, [ 'Key', 'Value' ])); + + my @key = SHOW_CONFIG; + for my $key(@key) + { + printf "", $key, $config->{$key}; + } + print "
%s%s
"; + + $self->display_end(); +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/Handler.pm b/MOD/Handler.pm new file mode 100644 index 0000000..60e1a34 --- /dev/null +++ b/MOD/Handler.pm @@ -0,0 +1,281 @@ +###################################################################### +# +# $Id: Handler.pm 261 2010-02-21 16:10:09Z root $ +# +# Copyright 2007-2009 Roman Racine +# Copyright 2009-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. +# +###################################################################### +package MOD::Handler; + +use strict; +use warnings; +use Carp qw( confess ); +use CGI(); +use MOD::Utils; +use MOD::Displaylib; + +###################################################################### +sub new($$) +###################################################################### +{ + my ($class, $filename) = @_; + my $self = {}; + + my %config = MOD::Utils::read_public_config($filename); + $self->{'config'} = \%config; + + $self->{'d'} = MOD::Displaylib->new(\%config, 1); + $self->{'q'} = $self->{'d'}->{'q'} || confess; + + bless $self, $class; + return $self; +} + +###################################################################### +sub run($) +###################################################################### +{ + my $self = shift || confess; + + my $query = $ENV{'QUERY_STRING'}; + $query =~ s/keywords=//; + my ($cmd, $start, $id) = split(',',$query); + if (!defined($start) || $start !~ /^\d+$/) { + $start = 0; + } + if (!$cmd) { $cmd = 'pending'; } + + my $q = $self->{'q'} || confess 'No "q" in $self'; + + $id = $q->param('id'); + if (!defined($id) || $id !~ /^\d+$/) { + $id = 0; + } + + if ($q->param('action.Show') || + $q->param('action.Header') || + $q->param('action.Brief Headers') || + $q->param('action.Show Post')) + { + return $self->display_single($cmd, $start, $id); + } + if ( + $q->param('action.Spam') || + $q->param('action.No Spam') || + $q->param('action.Put back in queue')) + { + $self->{'d'}->set_status_by_moderator( + $q->param('action.Spam') ? 'spam' : 'pending', + $id + ); + return $self->display_overview($cmd, $start, $id); + } + if ($q->param('action.Flag')) { + $self->{'d'}->set_flag($id); + return $self->display_overview($cmd, $start, $id); + } + if ($q->param('action.Reject')) { + return $self->reject('answer', $id); + } + if ($q->param('action.Approve')) { + $self->{'d'}->post($id); + return $self->display_overview($cmd, $start, $id); + } + if ($q->param('action.Send Mail')) { + $self->{'d'}->send_mail($id) && + return $self->display_overview($cmd, $start, $id); + } + if ($q->param('action.Show Reply') || + $q->param('action.Reason')) + { + return $self->display_answer($cmd, $start, $id); + } + if ($q->param('action.Delete')) { + return $self->reject('noanswer', $id); + } + if ($q->param('action.Delete and save reason')) { + $self->{'d'}->delete_posting($id); + return $self->display_overview($cmd, $start, $id); + } + if ($q->param('action.Show Error Message')) { + return $self->display_errormessage($q->param('error_id')); + } + if ($cmd eq 'config') { + return $self->{'d'}->display_config(); + } + + return $self->display_overview($cmd, $start, $id); +} + +use constant SQL_TIME_FORMAT => '"%d.%m.%Y, %H:%i:%s"'; +use constant DEFAULT_COLUMNS => [ + 'Moderator', + 'Sender', + 'Subject', + 'Date_Format(Datum, ' . SQL_TIME_FORMAT . ") AS 'Incoming Date'", + 'Date_Format(Moddatum, ' . SQL_TIME_FORMAT . ") AS 'Decision Date'" +]; +use constant PENDING_COLUMNS => [ + 'Sender', + 'Subject', + 'DATE_Format(Datum, ' . SQL_TIME_FORMAT . ') Date', + 'Spamcount' +]; +use constant OVERVIEW => { + 'spam' => { + -decisionref => [ 'Show', 'No Spam', 'Flag' ], + -overviewref => [ + 'Moderator', + 'Sender', + 'Subject', + 'DATE_Format(Datum, ' . SQL_TIME_FORMAT . ') Date', + 'Spamcount' + ], + -title => 'Spam Folder', + -subtitle => '_SUBTITLE_SPAM', + }, + 'pending' => { + -decisionref => [ 'Show', 'Spam', 'Flag' ], + -overviewref => PENDING_COLUMNS, + -title => 'Pending Posts', + -subtitle => '_SUBTITLE_PENDING', + }, + 'rejected' => { + -title => 'Rejected Posts', + -subtitle => '_SUBTITLE_REJECTED', + }, + 'errors' => { + -decisionref => [ 'Show Post', 'Show Error Message' ], + -overviewref => [ + 'error_date', + 'article_sender', + 'article_subject', + 'article_status', + 'error_count', + 'LEFT(error_message, INSTR(error_message, "\n")) AS error_message', + ], + -title => 'Error Messages', + -subtitle => '_SUBTITLE_ERROR', + -hiddencolumns => [ 'error_id' ], + }, + 'moderated' => { + -title => 'Approved Messages', + -subtitle => '_SUBTITLE_APPROVED', + }, + 'posted' => { + -title => 'Posted Messages', + -subtitle => '_SUBTITLE_POSTED', + }, + 'deleted' => { + -title => 'Deleted Posts', + -subtitle => '_SUBTITLE_DELETED', + }, +}; + + +sub display_overview { + my ($self, $cmd, $start, $id) = @_; + my @decisions; + my @overviewdata; + my ($status, $title); + + my $ovref = OVERVIEW->{$cmd} || confess 'Illegal $cmd'; + my %params = %{$ovref}; # create copy of the hash + + if (!exists( $params{'-cmd'} )) { + $params{'-cmd'} = $cmd; + } + if (!exists( $params{'-status'} )) { + $params{'-status'} = $cmd; + } + if (!exists( $params{'-decisionref'} )) { + $params{'-decisionref'} = [ 'Show' ]; + } + if (!exists( $params{'-overviewref'} )) { + $params{'-overviewref'} = DEFAULT_COLUMNS; + } + if (!exists( $params{'-no_of_elements'} )) { + my $config = $self->{'config'} || confess 'No "config" in $self'; + my $c = $config->{'display_per_page'} || confess 'No "display_per_page" in $config'; + $params{'-no_of_elements'} = $c; + } + + $params{'-start'} = $start; + $params{'-startrange'} = $id; + + $self->{'d'}->display_table(%params); +} + +sub reject { + my ($self,$behaviour,$id) = @_; + my $title = ($behaviour eq 'noanswer') + ? 'Delete Post' + : 'Reject Post'; + $self->{'d'}->generate_answer($id,$behaviour,$title); + return; +} + +sub display_answer { + my ($self,$cmd,$start,$id) = @_; + my $title = ($cmd eq 'rejected') ? 'Reply' : 'Reason'; + my @decisions = ('Show Post'); + $self->{'d'}->display_reason($id,\@decisions,$title); + return; +} + +sub display_errormessage { + my ($self,$id) = @_; + $self->{'d'}->display_errormessage($id, 'Error Message'); + return; +} + +use constant HEADERS => [ + 'From', + 'Reply-To', + 'Subject', + 'Message-ID', + 'Date', + 'Newsgroups', + 'Followup-To', +]; + +use constant SINGLE => { + 'pending' => [ 'Approve', 'Reject', 'Flag', 'Spam', 'Delete' ], + 'spam' => [ 'No Spam', 'Approve', 'Flag', 'Reject', 'Delete' ], + 'errors' => [ 'Reject', 'Flag', 'Spam', 'Delete' ], + 'moderated' => [ 'Put back in queue' ], + 'posted' => [], + 'rejected' => [ 'Show Reply' ], + 'deleted' => [ 'Put back in queue', 'Reason' ], +}; + +sub display_single { + my ($self, $cmd, $start, $id) = @_; + + my $q = $self->{'q'} || confess 'No "q" in $self'; + my $decisionref = SINGLE->{$cmd} || confess "Illegal \$cmd ($cmd)"; + my @decisions = @$decisionref; + + my $fullheader = $q->param('action.Header') ? 1 : 0; + push(@decisions, $fullheader ? 'Brief Headers' : 'Header'); + + my %args = ( + -status => $cmd, + -id => $id, + -headerref => HEADERS, + -decisionref => \@decisions, + -fullheader => $fullheader + ); + $self->{'d'}->display_article(%args); + return; +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/NotificationSocket.pm b/MOD/NotificationSocket.pm new file mode 100644 index 0000000..4f0ff58 --- /dev/null +++ b/MOD/NotificationSocket.pm @@ -0,0 +1,85 @@ +#!/usr/bin/perl -sw +###################################################################### +# +# $Id: NotificationSocket.pm 266 2010-05-18 15:14:08Z 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. +# +###################################################################### +package MOD::NotificationSocket; + +use strict; +use warnings; +use Carp qw( confess ); + +use Socket qw( + PF_UNIX + sockaddr_un + SOCK_STREAM + SOMAXCONN +); + +###################################################################### +sub socket_read($;$$) +###################################################################### +{ + my $fh = shift || confess; + my $on_close = shift; + my $on_debug_print = shift; + + my $buffer; + my $rc = sysread($fh, $buffer, 512); + + if (!defined($rc)) + { + if ($on_debug_print) { &$on_debug_print("socket_read $!"); } + return undef; + } + + if ($rc == 0) + { + if ($on_debug_print) { &$on_debug_print('socket_read close'); } + + if ($on_close) { &$on_close($fh); } + else { close($fh) || confess; } + return undef; + + # Do not call close($fh), this will hang the process. + # Socket is automatically closed when the last reference is freed. + # $irc->removefh($fh) || confess; + # return; + } + + $buffer =~ s/\s+$//; + if ($on_debug_print) { &$on_debug_print("socket_read rc=$rc buffer=[$buffer]"); } + return $buffer; +} + +###################################################################### +sub socket_create_listening($) +###################################################################### +{ + my $config = shift || confess; + + my $filename = $config->{'ircbot_notify_sock'}; + return undef if (!$filename); + + unlink($filename); + my $uaddr = sockaddr_un($filename) || die "sockaddr_un: $!"; + my $proto = getprotobyname('tcp') || die "getprotobyname: $!"; + my $fh; + socket($fh, PF_UNIX,SOCK_STREAM, 0) || die "socket: $!"; + bind ($fh, $uaddr) || die "bind: $!"; + listen($fh, SOMAXCONN) || die "listen: $!"; + + return $fh; +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/PublicHandler.pm b/MOD/PublicHandler.pm new file mode 100644 index 0000000..d0040dd --- /dev/null +++ b/MOD/PublicHandler.pm @@ -0,0 +1,159 @@ +###################################################################### +# +# $Id: PublicHandler.pm 159 2009-10-30 11:32:21Z root $ +# +# 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. +# +###################################################################### +package MOD::PublicHandler; + +use strict; +use warnings; +use Carp qw(confess); +use CGI(); +use MOD::Utils; +use MOD::Displaylib; + +=pod + +=head1 NAME + +MOD::PublicHandler + +=head1 DESCRIPTION + +This module provides public access to the moderation database. Only things which should +be viewable to the public. Data which should only be accessable or changeable by the +moderators cannot be retrieved, manipulated whith this module. Use MOD::Handler instead. + +=head1 REQUIREMENTS + + MOD:* + CGI + News::Article + +=head1 AUTHOR + +Roman Racine + + +=head1 VERSION + +2007-11-24 + +=cut + +$MOD::PublicHandler::VERSION = 0.04; +my %config; +my $sql_time_format = '"%d.%m.%Y, %H:%i:%s"'; +1; + +=pod + +=head1 new + +constructor + + usage: + + my $handler = MOD::PublicHandler->new('/path/to/the/config/file'); + $handler->run(); + +=cut + +sub new { + my ($class,$filename) = @_; + my $self = {}; + %config = MOD::Utils::read_public_config($filename); + $self->{'q'} = new CGI; + +# 0 -> get unpriviledged (i.e. non-moderator) access to the displaylib + $self->{'d'} = MOD::Displaylib->new(\%config,0); + $self->{'config'} = \%config; + bless $self, $class; + return $self; +} + +=pod + +=head1 run + +usage: + + my $handler = MOD::PublicHandler->new('/path/to/the/config/file'); + $handler->run(); + +This is the main handling routine, this method will get the arguments from the browser, +parse it and handle it, calling the necessary routines. + +=cut + +sub run { + my $self = shift; + my $start; + + my $q = $self->{'q'} || confess 'No "q" in $self'; + +#get the parameters, check for illegal values + (undef,$start) = split (',',$ENV{'QUERY_STRING'}); + if (!defined($start) || $start !~ /^\d+$/) { + $start = 0; + } + + my $id = $q->param('id'); + $id = 0 unless($id); + +#call the handling routines + if ($q->param('action.Show')) { + $self->display_single($start,$id); + } else { + $self->display_overview($start,$id); + } + return; +} + + +########## The following methods are for internal use only ##################### + +#method to display an overview over a number of postings using a table format. +sub display_overview { + my ($self,$start,$id) = @_; + + $self->{'d'}->display_table( + -status => 'posted', + -start => $start, + -no_of_elements => $self->{'config'}->{'display_per_page'}, + -overviewref => [ + 'Sender', + 'Subject', + "Date_Format(Datum,$sql_time_format) AS 'Incoming Date'", + "Date_Format(Moddatum,$sql_time_format) AS 'Decision Date'" + ], + -decisionref => [ 'Show' ], + -title => 'Overview of Approved Posts', + -cmd => 'bla', + -startrange => $id + ); + return; +} + +#method to display a single article given by an ID. +sub display_single { + my ($self,$start,$id) = @_; + my %args = ( + -status => 'posted', + -id => $id, + -headerref => [ 'From', 'Reply-To', 'Subject', 'Date', 'Newsgroups' ], + -decisionref => [], + -fullheader => 0, + ); + $self->{'d'}->display_article(%args); + return; +} + diff --git a/MOD/ReadMail.pm b/MOD/ReadMail.pm new file mode 100644 index 0000000..27d9386 --- /dev/null +++ b/MOD/ReadMail.pm @@ -0,0 +1,131 @@ +###################################################################### +# +# $Id: ReadMail.pm 293 2011-06-21 16:01:33Z alba $ +# +# 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. +# +###################################################################### +package MOD::ReadMail; + +use strict; +use warnings; +use Carp qw( confess ); +use News::Article(); +use Mail::SpamAssassin(); +use MOD::Spamfilter(); +use MOD::DBIUtils(); + +###################################################################### +sub new() +###################################################################### +{ + my ( $class, $configref ) = @_; + my $self = {}; + + $self->{'config'} = $configref || confess; + $self->{'spamutil'} = MOD::Spamfilter->new($configref) || confess; + $self->{'db'} = MOD::DBIUtils->new($configref) || confess; + + bless $self, $class; + return $self; +} + +###################################################################### +sub run_spamassassin($$) +{ + my ( $self, $article ) = @_; + + my $spamutil = $self->{'spamutil'} || confess 'No "spamutil" in $self'; + + # Temporarily redirect STDOUT and STDERR to /dev/null to ignore + # diagnostics printed by Spamassassin. + # Note: SAVE_STDOUT and SAVE_STDERR must be handles. + # ">&$savestdout" does not work, i.e. it will not restore stdout. + + open(SAVE_STDOUT, ">&STDOUT") or warn "Failed to dup STDOUT: $!"; + open(SAVE_STDERR, ">&STDERR") or warn "Failed to dup STDOUT: $!"; + open(STDOUT, '/dev/null') or warn $!; + open(STDERR, '/dev/null') or warn $!; + my $score = $spamutil->spamfilter_spamassassin($article); + open(STDOUT, ">&SAVE_STDOUT") or warn $!; + open(STDERR, ">&SAVE_STDERR") or warn $!; + close SAVE_STDOUT; + close SAVE_STDERR; + + return $score; +} + +###################################################################### +sub add_article($$;$) +###################################################################### +{ + my ( $self, $article, $status ) = @_; + + # broken spam postings + return 0 if ($article->bytes() <= 2); + + my $config = $self->{'config'} || confess 'No "config" in $self'; + my $db = $self->{'db'} || confess 'No "db" in $self'; + my $spamutil = $self->{'spamutil'} || confess 'No "spamutil" in $self'; + + if (!defined($article->header('Newsgroups'))) + { + my $group = $config->{'moderated_group'} || confess 'No "moderated_group" in config.'; + $article->set_headers('Newsgroups', $group); + } + + if ($config->{'followup_to'} && !$article->header('Followup-To')) + { + $article->set_headers('Followup-To', $config->{'followup_to'}); + } + + my $score = 0; + if (!$status) + { + if ($spamutil->blacklist($article)) + { + $score = 100; + $db->enter_table($article, 'spam', $score); + return 0; + } + + if ($config->{'spamassassin'}) + { + $score += $self->run_spamassassin($article); + } + + if ($config->{'subjectcheck'} and + $db->check_subject($article->header('subject'))) + { + my $subjectscore = $config->{'subjectscore'}; + $article->add_headers('X-Subject-Test', $subjectscore); + $score += $subjectscore; + } + + if ($config->{'attachmentcheck'}) + { + $score += $spamutil->spamfilter_attachment($article); + } + + if ($config->{'langcheck'}) + { + $score += $spamutil->spamfilter_language($article); + } + + $status = 'spam' if ($score >= 5); + } + + $status = 'pending' unless($status); + my $rc = $db->enter_table($article, $status, $score); + + return $rc == 1; +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/Spamfilter.pm b/MOD/Spamfilter.pm new file mode 100644 index 0000000..082047c --- /dev/null +++ b/MOD/Spamfilter.pm @@ -0,0 +1,142 @@ +###################################################################### +# +# $Id: Spamfilter.pm 147 2009-10-13 14:46:07Z 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. +# +###################################################################### +# +# this is a spamfilter which checks incoming mails and marks them +# as probable Spam. +# +# Heuristics are added as needed. +# +# The main function "spamfilter" returns +# -1 -> discard (post do de.admin.news.announce) +# 0-5 -> no spam, +# >5 -> spam +# +###################################################################### +package MOD::Spamfilter; + +use strict; +use warnings; +use News::Article; +use Mail::SpamAssassin; +use Text::Language::Guess; + +$MOD::Spamfilter::VERSION = 0.02; + +sub spamfilter; +sub blacklist; +sub spamlearn; +sub new($); +1; + +sub new($) { + my (undef,$configref) = @_; + my $self = {}; + $self->{'config'} = $configref; + bless $self; + return $self; +} + + +sub spamfilter_attachment { + my ($self,$article) = @_; + my $score = 0; + if (defined($article->header('Content-Type')) and $article->header('Content-Type') =~ + /^multipart\/(?:mixed|alternative);.+boundary="(.+?)"$/s) { + my @parts = split($1,(join "\n",$article->body())); + for my $part (@parts) { + if ($part =~ /^\r?\n?Content-Type: (image|video|audio|application|text\/html)/) { + $score = $self->{'config'}->{'attachmentscore'}; + last; + } + } + } + $article->add_headers('X-Attachment-Test',$score); + return $score; + } + + +sub spamfilter_language { + my ($self,$article) = @_; + my $guesser = Text::Language::Guess->new(languages => ['en',$self->{'config'}->{'lang'}]); + my @messagebody = $article->body(); + my $score = 0; + my $lang = $guesser->language_guess_string(join "\n",@messagebody); + if (!defined($lang) or $lang ne $self->{'config'}->{'lang'}) { + $score = $self->{'config'}->{'langscore'}; + } + $article->add_headers('X-Lang-Test',$score); + return $score; +} + +sub spamfilter_spamassassin { + my ($self,$article) = @_; + # use spamassassin + my $spamtest = Mail::SpamAssassin->new(); + my @messageheader = $article->headers(); + my @messagebody = $article->body(); + my $header = join "\n",@messageheader; + my $body = join "\n",@messagebody; + my $status = $spamtest->check_message_text($header . $body); + my $score = $status->get_score(); + $article->add_headers('X-Spamassassin-Test',$score); + return $score; +} + +sub blacklist { + my ($self,$article) = @_; + return 1 if ($article->header('Newsgroups') =~ /de.admin.news.announce/); + return 1 if (defined($article->header('Newsgroups')) and + $article->header('Newsgroups') !~ /$self->{'config'}->{'moderated_group'}/); + return 1 if (!defined($article->header('From'))); + return 1 if (length($article->header('From')) < 2); + return 1 if ($article->bytes() > 100*1024); + # kaputte Postings + for my $headerline (qw(From Reply-To Subject Message-ID)) { + if (defined ($article->header($headerline)) and + length($article->header($headerline)) > 1019) { + return 1; + } + } + if (defined $self->{'config'}->{'blacklistfile'}) { + my $header = join "\n",$article->headers(); + open(my $blacklistfile, $self->{'config'}->{'blacklistfile'}) or die $!; + while (<$blacklistfile>) { + chomp; + next if (length($_) <= 2); + if ($header =~ /$_/s) { + close $blacklistfile; + return 1; + } + } + close $blacklistfile; + } + return 0; +} + +sub spamlearn { + my ($input,$isspam) = @_; + return; +# my $message = Mail::SpamAssassin::Message->new({'message' => $input}); +# my $spamtest = new Mail::SpamAssassin ({ +# 'rules_filename' => '/etc/spamassassin.rules', +# 'userprefs_filename' => $ENV{'HOME'}. '/.spamassassin/user_prefs' +# }); +# my $mail = $spamtest->parse($message); +# my $status = $spamtest->learn($mail,undef,$isspam,0); +# $status->finish(); + +# my $spamobj = Mail::SpamAssassin->new(); +# print defined $spamobj,"\n"; +# $spamobj->learn($message,undef,$isspam,0); +} diff --git a/MOD/Utils.pm b/MOD/Utils.pm new file mode 100644 index 0000000..29afd73 --- /dev/null +++ b/MOD/Utils.pm @@ -0,0 +1,245 @@ +###################################################################### +# +# $Id: Utils.pm 272 2010-05-28 19:46:29Z root $ +# +# Copyright 2007-2009 Roman Racine +# Copyright 2009-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. +# +###################################################################### +# +# This package contains some frequently used routines +# +###################################################################### +package MOD::Utils; + +use warnings; +use strict; +use Carp qw( confess ); +use News::Article(); +use I18N::AcceptLanguage(); + +use MOD::lang::en_us(); + +@MOD::Utils::ISA = qw(Exporter); +@MOD::Utils::EXPORT = qw(); +@MOD::Utils::EXPORT_OK = qw( + read_public_config + read_private_config +); + +###################################################################### + +our @SUPPORTED_LANG; +our %SUPPORTED_LANG; + +# cache of public configuration file +# key = filename, value = [ mtime, r_config ] +our %CONFIG_CACHE; + +###################################################################### +sub get_cache_entry($) +###################################################################### +{ + my $filename = shift || confess 'No parameter $filename'; + my $r_cache = $CONFIG_CACHE{$filename}; + return undef if (!$r_cache); + + my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, + $mtime, $ctime, $blksize, $blocks) = stat($filename); + die "Can't access $filename:$!" if (!$mtime); + + return ($r_cache->[0] < $mtime) ? undef : $r_cache->[1]; +} + +###################################################################### +sub add_cache_entry($$) +###################################################################### +{ + my $filename = shift || confess 'No parameter $filename'; + my $r_config = shift || confess 'No parameter $r_config'; + + $CONFIG_CACHE{$filename} = [ time(), $r_config ]; +} + +###################################################################### +sub read_config_file($$) +###################################################################### +{ + my $filename = shift || confess 'No parameter $filename'; + my $r_hash = shift || confess 'No parameter $r_hash'; + + my $conf; + open($conf, '<', $filename) || + die "Can't open configuration file: \n$!\n$filename"; + while(my $line = <$conf>) + { + next if ($line =~ /^\s*#/); + my ($name, $val) = split (/[ \t]*=[ \t]*/, $line, 2); + # ignore undefined $val and zero-length $val + next if (!$val); + $name =~ s/^\s+//; + $val =~ s/\s+$//; + $val =~ s/^"(.*)"$/$1/; + $r_hash->{$name} = $val; + } +} + +###################################################################### +# Read the public config file, returns a hash of settings. +###################################################################### +sub read_public_config($) +###################################################################### +{ + my $filename = shift || confess 'No parameter $filename'; + my $r_config = get_cache_entry($filename); + if ($r_config) { return %$r_config; } + + my %config_vars = + ( + 'mysql_password' => $ENV{'mysql_password'} + ); + read_config_file($filename, \%config_vars); + add_cache_entry($filename, \%config_vars); + return %config_vars; +} + +###################################################################### +# Read the private config file, returns a hash of settings. +# +# The function first reads the public file to read the values of +# 'UID' and 'priv_config_file'. +# +# The function dies +# - if 'UID' or 'priv_config_file' are not defined +# - if user id (variable "$<") does not match the setting of "UID" +# - if the private file cannot be opened +###################################################################### +sub read_private_config($) +###################################################################### +{ + my $filename = shift || confess 'No parameter $filename'; + my %config_vars = read_public_config($filename); + + my $cfg_uid = $config_vars{'UID'} || + die 'No "UID" in public configuration file $filename"'; + if ($< != $cfg_uid) + { + die "Execution of this function is not allowed for user ID $ undef ); + + my $dirhandle; + + opendir($dirhandle, $pkgdir) || die "opendir $pkgdir: $!"; + for my $lang( grep { /^\w+\.pm$/ && -f "$pkgdir/$_" } readdir($dirhandle) ) + { + $lang =~ s#\.pm$##; + # Perl dows not allow '-' in module names, so we use '_' instead. + # The strings in HTTP_ACCEPT_LANGUAGE use '-', however. + $lang =~ s#_#-#g; + $SUPPORTED_LANG{$lang} = undef; + push @SUPPORTED_LANG, $lang; + } + closedir($dirhandle); + + return @SUPPORTED_LANG; +} + +###################################################################### +sub get_translator_language($$) +###################################################################### +{ + my $lang = shift; + my $negotiate = shift; + + get_supported_translators(); + + if ($negotiate && exists($ENV{ 'HTTP_ACCEPT_LANGUAGE' })) + { + # Sample value for HTTP_ACCEPT_LANGUAGE: + # de-at,en-us;q=0.7,en;q=0.3 + my $a = I18N::AcceptLanguage->new( $lang ); + my $n = $a->accepts($ENV{HTTP_ACCEPT_LANGUAGE}, \@SUPPORTED_LANG); + + $lang = $n if (defined($n) && exists($SUPPORTED_LANG{ $n })); + } + + if ($lang) + { + unless(exists($SUPPORTED_LANG{ $lang })) + { + die "Unsupported language '$lang' (choose one of " . + join(', ', @SUPPORTED_LANG) . ')'; + } + return $lang; + } + + return $SUPPORTED_LANG[0]; +} + +###################################################################### +sub get_translator($) +###################################################################### +{ + my $lang = shift; + if ($lang) + { + unless(exists($SUPPORTED_LANG{ $lang })) + { + die "Unsupported language '$lang' (choose one of " . + join(', ', @SUPPORTED_LANG) . ')'; + } + + # Perl dows not allow '-' in module names, so we use '_' instead. + # The strings in HTTP_ACCEPT_LANGUAGE use '-', however. + $lang =~ s#-#_#g; + + my $module = __PACKAGE__; # value of __PACKAGE__ is "MOD::Utils" + $module =~ s#::[^:]+$##g; # reduce to "MOD" + $module .= '::lang::' . $lang; # extend to "MOD::lang::en" + + eval "use $module;"; + if (length($@) == 0) + { + no strict; + my $get = eval '*{$' . $module . '::{"get_translator"}}{"CODE"}'; + if (length($@) == 0) + { + my $trans = return $get->($lang); + return $trans if $trans; + } + } + } + + return MOD::lang::en_us::get_translator($lang); +} + +###################################################################### +1; +###################################################################### diff --git a/MOD/lang/de.pm b/MOD/lang/de.pm new file mode 100644 index 0000000..2eca331 --- /dev/null +++ b/MOD/lang/de.pm @@ -0,0 +1,104 @@ +##################################################################### +# +# $Id: de.pm 298 2011-09-04 11:11:33Z root $ +# +# Copyright 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. +# +###################################################################### +# +# This file is encoded in iso-8859-1 +# +###################################################################### +package MOD::lang::de; + +use warnings; +use strict; + +###################################################################### +use constant TRANS => +###################################################################### +{ + '_ALREADY_HANDLED' => 'Dieser Eintrag wurde bereits von einem anderen Moderator bearbeitet.', + 'Approved Messages' => 'Zugelassene Postings', + 'Approved' => 'Zugelassen', + 'Approve' => 'Posten', + '_ARRIVAL_NOTICE_BODY' => "In der Moderationsqueue sind noch eines oder mehrere Postings\nvon dir unbearbeitet. Dies ist eine automatische Nachricht.\n", + '_ARRIVAL_NOTICE_SUBJECT' => '[%s] Eingangsbestaetigung', + 'article_sender' => 'Sender', + 'article_status' => 'Status', + 'article_subject' => 'Betreff', + 'Available Actions' => 'Mögliche Aktionen', + 'Back' => 'Zurück', + 'Brief Headers' => 'Header verbergen', + _CROSSPOSTED => 'Vorsicht, dieses Posting ist in mehr als zwei NGs crossgepostet!', + 'Date' => 'Datum', + 'Decision Date' => 'Entscheidungsdatum', + 'Delete and save reason' => 'Löschen und Begründung speichern', + 'Delete and save reason' => 'Löschen und Begründung speichern', + 'Deleted' => 'Gelöscht', + 'Deleted Posts' => 'Gelöschte Postings', + 'Delete' => 'Löschen', + 'Delete Post' => 'Posting löschen', + 'error_count' => 'Fehleranzahl', + 'error_date' => 'Datum', + 'Error' => 'Fehler', + _ERROR_GONE => 'Die Fehlermeldung liegt nicht mehr vor, der Fehler ist behoben.', + _ERROR_INVALID_ADDRESS => 'Ungültige Adresse, Versand eines Mails nicht möglich.', + 'error_message' => 'Fehlermeldung', + 'Error Messages' => 'Fehlermeldungen', + '_EXPLAIN_REASON' => 'Hier kann ein Grund für die Löschung des Artikels angegeben werden. Dieser Text ist nur für die übrigen Moderationsmitglieder sichtbar.', + 'Incoming Date' => 'Eingangsdatum', + 'Messages' => 'Postings', + 'Next page' => 'Vorwärts blättern', + 'No matching records available.' => 'Kein passender Datensatz vorhanden.', + 'No reason stored in database!' => 'Keine Begründung in der Datenbank vorhanden!', + 'No Spam' => 'Kein Spam', + 'No subject' => 'Kein Betreff', + 'Overview of Approved Posts' => 'Überblick über die zugelassenen Postings', + 'Pending' => 'Offen', + 'Pending Posts' => 'Offene Moderationsentscheidungen', + 'Posted' => 'Gesendet', + 'Posted Messages' => 'Gesendete Postings', + 'Previous page' => 'Zurück blättern', + 'Put back in queue' => 'In Moderationsqueue zurück', + 'Reason' => 'Begründung', + 'Rejected' => 'Abgewiesen', + 'Rejected Posts' => 'Zurückgewiesene Postings', + 'Reject Post' => 'Posting zurückweisen', + 'Reject' => 'Zurückweisen', + 'Reply' => 'Antwort', + 'Selected Article' => 'Gewählter Artikel', + 'Sender' => 'Absender', + 'Send Mail' => 'Mail verschicken', + 'Show' => 'Anzeigen', + 'Show Error Message' => 'Fehlermeldung anzeigen', + 'Show Post' => 'Posting anzeigen', + 'Show Reply' => 'Antwort anzeigen', + 'Spam Folder' => 'Spamordner', + 'Subject' => 'Betreff', + '_SUBTITLE_APPROVED' => 'Zugelassene aber noch nicht gesendete Postings.', + '_SUBTITLE_DELETED' => 'Ignorierte Postings.', + '_SUBTITLE_ERROR' => 'Zugelassene Postings die nicht gesendet werden konnten. Wird automatisch wiederholt.', + '_SUBTITLE_PENDING' => 'Postings die auf eine Entscheidung warten.', + '_SUBTITLE_POSTED' => 'Zugelassene Postings die zum Newsserver gesendet wurden.', + '_SUBTITLE_REJECTED' => 'Abgelehnte Postings, bei denen dem Sender eine Begründung geschickt wurde.', + '_SUBTITLE_SPAM' => 'Postings die vom Spamfilter oder einem Moderator als Spam kategorisiert wurden.', + '%s wrote:' => '%s schrieb:', + 'Your post regarding' => 'Dein Posting zum Thema', +}; + +sub get_translator($) +{ + return sub { + my $result = TRANS->{$_[0]}; + return $result ? $result : $_[0]; + }; +} + +1; diff --git a/MOD/lang/de_ch.pm b/MOD/lang/de_ch.pm new file mode 100644 index 0000000..91f7719 --- /dev/null +++ b/MOD/lang/de_ch.pm @@ -0,0 +1,42 @@ +###################################################################### +# +# $Id: de_ch.pm 147 2009-10-13 14:46:07Z alba $ +# +# Copyright 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. +# +###################################################################### +# +# This file is encoded in iso-8859-1 +# +###################################################################### +package MOD::lang::de_ch; + +use warnings; +use strict; +use Carp qw( confess ); +use MOD::lang::de(); + +use constant TRANS => { + 'Pending' => 'Pendent', + 'Pending Posts' => 'Pendente Moderationsentscheidungen', +}; + +sub get_translator($) +{ + my $de = MOD::lang::de::get_translator(@_) || confess; + return sub { + my $result = TRANS->{$_[0]}; + return $result if ($result); + $result = $de->(@_); + return $result if ($result); + return $_[0]; + }; +} + +1; diff --git a/MOD/lang/de_de.pm-disable b/MOD/lang/de_de.pm-disable new file mode 100644 index 0000000..aaa7cba --- /dev/null +++ b/MOD/lang/de_de.pm-disable @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w +# +# $Id: de_de.pm-disable 64 2009-09-02 19:42:41Z alba $ +# +# This file is encoded in iso-8859-1 +# +package MOD::lang::de_de; + +use warnings; +use strict; +use MOD::lang::de_at(); + +@MOD::Utils::ISA = qw(Exporter); +@MOD::Utils::EXPORT = qw(); +@MOD::Utils::EXPORT_OK = qw( get_translator ); + +sub get_translator($) +{ + return MOD::lang::de_at::get_translator(@_); +} + +1; diff --git a/MOD/lang/en_us.pm b/MOD/lang/en_us.pm new file mode 100644 index 0000000..6f36f3b --- /dev/null +++ b/MOD/lang/en_us.pm @@ -0,0 +1,54 @@ +###################################################################### +# +# $Id: en_us.pm 273 2010-05-28 21:22:31Z root $ +# +# Copyright 2009 Roman Racine +# Copyright 2009-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. +# +###################################################################### +# +# This file is encoded in iso-8859-1 +# +###################################################################### +package MOD::lang::en_us; + +use warnings; +use strict; + +use constant TRANS => { + '_ALREADY_HANDLED' => 'This entry was already handled by another moderator.', + '_ARRIVAL_NOTICE_BODY' => "One or more of your posts are pending in the moderation queue.\nThis message was generated automatically.\n", + '_ARRIVAL_NOTICE_SUBJECT' => '[%s] Post received', + 'article_sender' => 'Sender', + 'article_status' => 'Status', + 'article_subject' => 'Subject', + '_CROSSPOSTED' => 'Note that this message is crossposted to more than two groups!', + 'error_count' => 'Error Count', + 'error_date' => 'Date', + '_ERROR_GONE' => 'The error message is gone, probably because its cause is fixed.', + '_ERROR_INVALID_ADDRESS' => 'Invalid address, can\'t send mail.', + 'error_message' => 'Error Message', + '_EXPLAIN_REASON' => 'Here you can state a reason why the message was deleted. This text is visible only to other members of the moderation team.', + '_SUBTITLE_APPROVED' => 'Approved posts that are not sent, yet.', + '_SUBTITLE_DELETED' => 'Posts that are silently ignored.', + '_SUBTITLE_ERROR' => 'Approved posts that could not be sent. Will be retried automatically.', + '_SUBTITLE_PENDING' => 'Posts waiting for your decision.', + '_SUBTITLE_POSTED' => 'Approved posts that were sent to the newsserver.', + '_SUBTITLE_REJECTED' => 'Posts where the sender was sent a reason why they were not approved.', + '_SUBTITLE_SPAM' => 'Posts classified as spam by the spam filter or a moderator.', +}; + +sub get_translator($) +{ + return sub { + my $result = TRANS->{$_[0]}; + return $result ? $result : $_[0]; + }; +} + +1; diff --git a/TODO b/TODO new file mode 100644 index 0000000..ee611be --- /dev/null +++ b/TODO @@ -0,0 +1,12 @@ +- change to status "deleted" immediately, write reply in separate step, use set_reply() +- trigger poster.pl through the web-interface (Unix socket?) +- check whether crosspost is to a moderated group +- make configuration file configurable at run time +- provide internal user management and login form +- installation program +- warn about cancels and supersedes +- lock down state of old posts (spam, deleted) +- don't send mail to .invalid, .example, etc. +- support utf-8 (database, HTML input, HTML output, mail output) +- script to generate summary.txt from configuration files +- announce incoming submissions to moderator, but go sure that only one mail per day is sent diff --git a/bin/autoreply.pl b/bin/autoreply.pl new file mode 100644 index 0000000..519fd1c --- /dev/null +++ b/bin/autoreply.pl @@ -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; + } +} + +###################################################################### diff --git a/bin/fremdcancel.pl b/bin/fremdcancel.pl new file mode 100644 index 0000000..fa1a9c6 --- /dev/null +++ b/bin/fremdcancel.pl @@ -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); + } + } +} diff --git a/bin/ircbot.pl b/bin/ircbot.pl new file mode 100644 index 0000000..c100e48 --- /dev/null +++ b/bin/ircbot.pl @@ -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; diff --git a/bin/ircbot.sh b/bin/ircbot.sh new file mode 100644 index 0000000..0cf7feb --- /dev/null +++ b/bin/ircbot.sh @@ -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 diff --git a/bin/mailget.pl b/bin/mailget.pl new file mode 100644 index 0000000..7fb0d0d --- /dev/null +++ b/bin/mailget.pl @@ -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); + } +} diff --git a/bin/mk-gpg-key.sh b/bin/mk-gpg-key.sh new file mode 100644 index 0000000..934ca5c --- /dev/null +++ b/bin/mk-gpg-key.sh @@ -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 diff --git a/bin/mk-summary.pl b/bin/mk-summary.pl new file mode 100644 index 0000000..f75d024 --- /dev/null +++ b/bin/mk-summary.pl @@ -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 <. + +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 . + +== 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 diff --git a/bin/new-passwd.pl b/bin/new-passwd.pl new file mode 100644 index 0000000..12bc783 --- /dev/null +++ b/bin/new-passwd.pl @@ -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"; diff --git a/bin/poster.pl b/bin/poster.pl new file mode 100644 index 0000000..f409275 --- /dev/null +++ b/bin/poster.pl @@ -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 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 + +=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' ]); + } +} diff --git a/bin/read-mail.pl b/bin/read-mail.pl new file mode 100644 index 0000000..9511405 --- /dev/null +++ b/bin/read-mail.pl @@ -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 $/; ; }; + die "Error: No data on stdin" unless ($text); + my $article = parse_text(\$text) || exit(1); + $fn->($rm, $article, ''); +} +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); + } +} + +###################################################################### diff --git a/bin/removeold.pl b/bin/removeold.pl new file mode 100644 index 0000000..e13e69b --- /dev/null +++ b/bin/removeold.pl @@ -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 diff --git a/bin/statistics.pl b/bin/statistics.pl new file mode 100644 index 0000000..609c4bc --- /dev/null +++ b/bin/statistics.pl @@ -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; diff --git a/cgi-bin/modtable.pl b/cgi-bin/modtable.pl new file mode 100644 index 0000000..bae419e --- /dev/null +++ b/cgi-bin/modtable.pl @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use CGI::Carp 'fatalsToBrowser'; + +$ENV{'CONTENT_TYPE'} = "multipart/form-data"; + +BEGIN { push (@INC, $ENV{'HUHU_DIR'}); } + +use MOD::Handler; +my $h = MOD::Handler->new( $ENV{'HUHU_PUB_CONFIG'} ); +$h->run(); diff --git a/cgi-bin/public.pl b/cgi-bin/public.pl new file mode 100644 index 0000000..47f1fdd --- /dev/null +++ b/cgi-bin/public.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use CGI::Carp 'fatalsToBrowser'; + +$ENV{'CONTENT_TYPE'} = "multipart/form-data"; + +BEGIN { push (@INC, $ENV{'HUHU_DIR'}); } + +require MOD::PublicHandler; + +my $h = MOD::PublicHandler->new( $ENV{'HUHU_PUB_CONFIG'} ); +$h->run(); diff --git a/doc/CONTRIBUTORS b/doc/CONTRIBUTORS new file mode 100644 index 0000000..90c82a1 --- /dev/null +++ b/doc/CONTRIBUTORS @@ -0,0 +1,12 @@ +The following is a list of the people (in roughly chronological order) +who've helped out. + +Roman Racine: + Designed and wrote most of it. + +Alexander Bartolich: + Took over development in autumn 2009, added support for CSS, + multiple languages and procmail. + +Thomas Hochstein: + X-Huhu-Submission-Date, option "Put back in queue" on delete diff --git a/doc/environment.txt b/doc/environment.txt new file mode 100644 index 0000000..66309da --- /dev/null +++ b/doc/environment.txt @@ -0,0 +1,63 @@ +== Operation == + +Required by all commands. + +HUHU_DIR + +== Installation == + +Additional variables required by "sbin/create-procmail-user.sh". + +DIR and URL point to the same location. + +HUHU_WWW_BASE_DIR +HUHU_WWW_BASE_URL + + DIR and URL point to the same location, but in different ways. + DIR is a file system path while URL is the base of the address + used in a web browser. + + Example: + HUHU_WWW_BASE_DIR="/srv/www/albasani.net/html/huhu" + HUHU_WWW_BASE_URL="http://albasani.net/huhu" + +HUHU_EMAIL_DOMAIN + + Right-hand part of the email address used to submit posts. + + Example: + HUHU_EMAIL_DOMAIN="albasani.net" + +HUHU_EMAIL_LIST + + This is a file name. If variable is defined then the submission + address is appended to the file. + + Example: + HUHU_EMAIL_LIST="/etc/amavis/spam_lovers" + +HUHU_EMAIL_POSTFIX_ALIAS + + This is the name of a file defining virtual aliases for Postfix. + If variable is defined then the submission address and the user + name is appended to the file. + + Example: + HUHU_EMAIL_POSTFIX_ALIAS="/etc/postfix/maps/virtual_alias" + +== Skeleton Templates == + +Used internally by "sbin/create-procmail-user.sh" when copying +template files from directory "etc/skel". + +MODERATED_GROUP +MODERATED_GROUP_ABBR +MYSQL_DB +MYSQL_PASSWORD +MYSQL_TABLE +MYSQL_USERNAME +TODAY +USER_HOME +USER_ID +USER_NAME +WWW_DIR diff --git a/doc/extra-modules.txt b/doc/extra-modules.txt new file mode 100644 index 0000000..42e88bf --- /dev/null +++ b/doc/extra-modules.txt @@ -0,0 +1,7 @@ +# Dependencies for CPAN modules +apt-get install libnet-irc-perl +apt-get install liblog-log4perl-perl + +# Modules only available through CPAN +cpan i News::Article::Cancel +cpan i Text::Language::Guess diff --git a/doc/get-perl-modules.sh b/doc/get-perl-modules.sh new file mode 100644 index 0000000..4d3a056 --- /dev/null +++ b/doc/get-perl-modules.sh @@ -0,0 +1,36 @@ +#!/bin/sh +# +# $Id: $ +# +# Search for required Perl modules, translate to required package names. +# +export "LANG=C" +export "LC_ALL=C" +set -o nounset +set -o errexit + +req_modules="required-perl-modules.txt" +req_deb="required-deb-packages.txt" +req_rpm="required-rpm-packages.txt" + +find "${HUHU_DIR}" -type f -name '*.p[lm]' -exec \ +gawk -F '[[:space:]();]+' ' + $1 == "use" && $2 ~ /::/ && $2 !~ /^MOD::/ { print $2 } +' {} \+ | +sort -u > "${req_modules}" + +if [ -f /etc/debian_version ]; then + xargs locate < "${req_modules}" | + sort -u | + xargs -n1 dpkg -S | + sed -ne 's/: .*//p' | + sort -u > "${req_deb}" +elif [ -f /etc/redhat-release ]; then + xargs locate < "${req_modules}" | + sort -u | + xargs rpm -qf | + sed -e '/ /d' | + sort -u > "${req_rpm}" +fi + + diff --git a/doc/html/huhu.css b/doc/html/huhu.css new file mode 100644 index 0000000..3c823f3 --- /dev/null +++ b/doc/html/huhu.css @@ -0,0 +1,208 @@ +@charset "ISO-8859-1"; +/* + * $Id: huhu.css 286 2011-02-18 00:18:19Z alba $ + * + * #d3d3d3 = lightgray + */ +body, html { + height:100%; + text-align:left; + margin:0; + padding:0; + font-family:sans-serif; + background-color:#ccccff; + color:black; +} + +h1 { + font-size:132%; +} + +table.huhuPostList, +table.huhuArticle { + border-collapse:separate; + border-spacing:0; + empty-cells:show; + background-color:white; +} + +table.huhuPostList td, +table.huhuPostList th, +table.huhuArticle th, +table.huhuArticle td { + padding:2px; + margin:0; + border-left:1px #FFFFFF solid; + border-top:1px #FFFFFF solid; + border-right:1px #000000 solid; + border-bottom:1px #000000 solid; +} + +table.huhuPostList th { + text-align:center; + background-color:#d3d3d3; +} + +div.huhuContents { + display:block; + float:left; /* to keep huhuVersion aligned on left border */ + width:84%; + margin-top:0.5em; + margin-left:0.5em; + margin-right:0.5em; + /* border:1px solid black; */ +} + +ul.huhuMainMenu0 { + width:12%; + background-color:#d3d3d3; + margin-left:0.5em; + /* no margin-right, use margin-left of div.huhuContents instead */ + margin-top:0.5em; + margin-bottom:0; + padding:0; + float:left; /* menu on the left, huhuContents on the right */ + /* border:1px solid black; */ +} + +ul.huhuMainMenu0 span { + padding-left:0.5em; + padding-top:0.5ex; + padding-right:0.5em; + padding-bottom:0.5ex; + display:block; + font-weight:bold; +} + +ul.huhuMainMenu1 { + margin:0; + padding:0; +} + +ul.huhuMainMenu1 span { + font-weight:normal; + margin:0; + padding:0; +} + +ul.huhuMainMenu0 li, +ul.huhuMainMenu1 li { + text-indent:0; + list-style-type:none; +} + +ul.huhuMainMenu0 li { + font-size:80%; + border-top:1px #000000 solid; + border-left:1px #000000 solid; + border-right:1px #FFFFFF solid; + border-bottom:1px #FFFFFF solid; +} + +ul.huhuMainMenu1 li { + font-weight:normal; + border-top:1px #FFFFFF solid; + border-left:1px #FFFFFF solid; + border-right:1px #000000 solid; + border-bottom:1px #000000 solid; + padding:4px; +} + +div.huhuNavigation { + padding-top:0.5ex; + padding-bottom:0; + margin-top:1ex; + margin-bottom:0; + margin-left:0; + margin-right:0; +} + +div.huhuNavigation span { + border-top:1px #FFFFFF solid; + border-left:1px #FFFFFF solid; + border-right:1px #000000 solid; + border-bottom:1px #000000 solid; + font-size:80%; + padding:4px; +} + +ul.huhuMainMenu0 li a, +div.huhuNavigation span a { + /* remove underlined attribute for "a href" */ + text-decoration:none; + /* remove color distinction between visited and unvisited links */ + color:black; +} + +ul.huhuMainMenu0 li a:hover, +div.huhuNavigation span a:hover { + /* while mouse is hovering over "a href" */ + color:#FFFFFF; + text-decoration:none; + background-color:black; +} + +div.huhuVersion, +div.huhuArticleInfo { + margin-top:1ex; + font-size:80%; + font-style:italic; +} + +table.huhuArticle { + /* Opera and IE applie margin above caption + * Mozilla between caption and table */ + margin-top:2mm; + + border-top:1px #000000 solid; + border-left:1px #000000 solid; + width:100%; +} + +table.huhuArticle th, +table.huhuArticle td { + padding-left:1ex; + padding-right:1ex; +} + +tr.huhuArticleHeader th, +tr.huhuArticleHeader td { + border-bottom:1px #000000 solid; +} + +tr.huhuArticleHeader th { + background-color:#d3d3d3; + border-right:1px #000000 solid; + text-align:right; + width:10em; +} + +tr.huhuArticleHeader td { + background-color:#FFFFCC; +} + +div.huhuReason, +div.huhuErrorMessage { + margin-bottom:1ex; + padding:1ex; + background-color:white; + border:1px #000000 solid; +} + +tr.huhuFlag { + background-color:#FFCCCC; +} +tr.huhuOdd { + background-color:#FCFCFC; +} +tr.huhuEven { + background-color:#FFFFCC; +} +td.huhuNoRows { + background-color:#ccccff; +} + +div.huhuSubtitle { + font-size:80%; + margin-bottom:0.5ex; +} diff --git a/doc/html/index.html b/doc/html/index.html new file mode 100644 index 0000000..33c5c63 --- /dev/null +++ b/doc/html/index.html @@ -0,0 +1,89 @@ + + + + + +Huhu Overview + + +
+ +

Huhu

+ +

Huhu is a web application to moderate Usenet groups.

+ +

Basic workflow

+
    +
  1. Emails are sent to the submission address
    2. +
  2. Retrieved mails are stored in database
    3. +
  3. The web application visualizes the stored mails
    4. +
  4. Human moderators use the web application to classify mail: +
      +
    • Approved submissions are sent to the news server
      • +
    • For rejected submissions a rejection notice is sent to the author via mail
      • +
    • Submissions can also be silently ignored
      • +
    • Mails classified as spam are silently ignored but also train the spamfilter
      • +
    5. +
+ +

Requirements

+
    +
  • Some kind of Unix (Huhu is developed on Ubuntu Linux)
    • +
  • A way to execute jobs in periodic intervals, e.g. crond
    • +
  • perl 5 (and a list of additional perl modules)
    • +
  • A web server cabaple of executing perl scripts (Huhu is developed on Apache/mod_perl)
    • +
  • A MySQL database
    • +
  • A mail box accessible through POP3 or procmail
    • +
  • NNTP access to a news server that allows to set the header "Approved:"
    • +
+ +

Features

+
    +
  • Spam filtering with Mail::SpamAssassin.
    • +
  • Articles can be signed with a PGP key, using News::Article::sign_pgpmoose.
    • +
  • Submissions can be moderated automatically through procmail rules.
    • +
  • An IRC bot that notifies an IRC channel about pending submissions.
    • +
  • Multiple instances of Huhu can be run with a single installation.
    • +
+ +

Missing features

+
    +
  • Documentation. (Harald Mädl has written a +German user's manual, though.)
    • +
  • UNICODE. (Huhu currently uses ISO-8859-1 throughout.)
    • +
  • Web based installation. (Currently there is only sbin/create-procmail-user.sh).
    • +
+ +

Licence

+

Huhu 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.

+ +

Availability

+

The code is stored in a subversion +repository.

+ +
+
Anonymous read-only access
+ +
svn://svn.schnuerpel.eu/huhu/trunk/
+ +
Web based revision browser
+ +
http://svn.schnuerpel.eu/viewvc.cgi/?root=huhu
+ +
Project home page
+ +
http://huhu.albasani.net/
+
+ +

History

+

Roman Racine developed Huhu in 2007 to moderate de.soc.familie.vaeter.
+In 2009 he adapted it to easily run multiple instances.
+In autumn 2009 Alexander Bartolich took over development, adding support for CSS, multiple languages, and procmail.

+ +
diff --git a/doc/required-deb-packages.txt b/doc/required-deb-packages.txt new file mode 100644 index 0000000..9d72275 --- /dev/null +++ b/doc/required-deb-packages.txt @@ -0,0 +1,8 @@ +libdigest-sha1-perl +libi18n-acceptlanguage-perl +libmail-sendmail-perl +libmailtools-perl +libnet-irc-perl +libnews-article-perl +perl-doc +spamassassin diff --git a/doc/required-perl-modules.txt b/doc/required-perl-modules.txt new file mode 100644 index 0000000..c02bc5b --- /dev/null +++ b/doc/required-perl-modules.txt @@ -0,0 +1,18 @@ +CGI::Carp +CGI::Pretty +Data::Dumper +Digest::SHA1 +I18N::AcceptLanguage +MIME::Base64 +MIME::QuotedPrint +Mail::Mailer +Mail::Sendmail +Mail::SpamAssassin +Net::IRC +Net::NNTP +Net::POP3 +News::Article +News::Article::Cancel +News::Article::Response +Text::Language::Guess +Time::Local diff --git a/doc/security.txt b/doc/security.txt new file mode 100644 index 0000000..4e9dff7 --- /dev/null +++ b/doc/security.txt @@ -0,0 +1,45 @@ +SYSTEM USER ACCOUNTS + +* UID_ROOT ... A priviledged user able to create other users. +* UID_WWW ... The user id of the web server process. +* UID_HUHU ... The user that executes cron scripts and procmail scripts. + +DATABASE USER ACCOUNTS + +* DB_UID_ROOT ... This account is used by UID_ROOT to set up huhu. +* DB_UID_HUHU ... The account used by Huhu itself. + +NEWS SERVER ACCOUNTS + +* NNTP_UID_HUHU ... Used by UID_HUHU to post articles. + +PROGRAMS + +* Shell scripts executed as UID_ROOT + Used to set up Huhu instances + DB_UID_ROOT + sbin/create-procmail-user.sh + +* Procmail script executed as UID_HUHU + DB_UID_HUHU + bin/read-mail.pl + +* Crontab scripts executed as UID_HUHU + DB_UID_HUHU, NNTP_UID_HUHU + bin/* + +* Scripts executed by web server as UID_WWW + Scripts can be run as true CGIs or within mod_perl + DB_UID_HUHU + cgi-bin/* + +FLOW OF CONFIGURATION DATA + +The path to the public configuration file is specified through environment +variable HUHU_PUB_CONFIG. + +TODO + +Authentication is done by the web server. It is recommended to use +"AuthType Digest", so that passwords are not transferred through the +net in plain text. diff --git a/etc/skel/.bashrc b/etc/skel/.bashrc new file mode 100644 index 0000000..03147ca --- /dev/null +++ b/etc/skel/.bashrc @@ -0,0 +1,4 @@ +#!/bin/bash +export HUHU_DIR="@HUHU_DIR@" +export PERL5LIB="${PERL5LIB:+$PERL5LIB:}${HUHU_DIR}" +export PATH="${PATH}:${HUHU_DIR}/bin" diff --git a/etc/skel/.cshrc b/etc/skel/.cshrc new file mode 100644 index 0000000..9d0d768 --- /dev/null +++ b/etc/skel/.cshrc @@ -0,0 +1,10 @@ +#!/bin/csh -x +setenv EDITOR /usr/bin/vim +setenv GREP_OPTIONS '--color=auto' + +setenv LC_CTYPE C +setenv LANGUAGE en_US +setenv LANG "${LANGUAGE}.iso885915" + +setenv HUHU_DIR "@HUHU_DIR@" +setenv PERL5LIB "${HUHU_DIR}" diff --git a/etc/skel/.forward b/etc/skel/.forward new file mode 100644 index 0000000..116d43b --- /dev/null +++ b/etc/skel/.forward @@ -0,0 +1,4 @@ +# +# Save this file as $HOME/.forward to enable $HOME/.procmailrc +# +"|exec /usr/bin/procmail" diff --git a/etc/skel/.my.cnf b/etc/skel/.my.cnf new file mode 100644 index 0000000..757f4be --- /dev/null +++ b/etc/skel/.my.cnf @@ -0,0 +1,3 @@ +[client] +user=@MYSQL_USERNAME@ +password=@MYSQL_PASSWORD@ diff --git a/etc/skel/.procmailrc b/etc/skel/.procmailrc new file mode 100644 index 0000000..6a9676f --- /dev/null +++ b/etc/skel/.procmailrc @@ -0,0 +1,18 @@ +HUHU_DIR="@HUHU_DIR@" + +CONFIG="${HOME}/etc/public.conf" +LOGFILE="${HOME}/var/procmail.log" +PATH="/usr/bin:/bin:${HUHU_DIR}/bin" +PERL5LIB="${HUHU_DIR}" +VERBOSE=yes + +# save mails in backup directory +:0 c +backup + +# trim backup directory +:0 ic +| cd backup && rm -f dummy `ls -t msg.* | sed -e 1,32d` + +:0 +| "${HUHU_DIR}/bin/read-mail.pl" "-config=${CONFIG}" -stdin diff --git a/etc/skel/backup/EMPTY b/etc/skel/backup/EMPTY new file mode 100644 index 0000000..e69de29 diff --git a/etc/skel/bin/poster.sh b/etc/skel/bin/poster.sh new file mode 100644 index 0000000..e5f8cf2 --- /dev/null +++ b/etc/skel/bin/poster.sh @@ -0,0 +1,16 @@ +#!/bin/sh +# +# This script tries to send all messages of status 'moderated' to the +# news server. This should be a safe operation, i.e. it is not possible +# to produce duplicates. +# +# Use this script for testing or after a configuration error. +# +export "LANG=C" +export "LC_CTYPE=C" +set -o nounset +set -o errexit + +export HUHU_DIR="@HUHU_DIR@" +export PERL5LIB="${PERL5LIB:+$PERL5LIB:}${HUHU_DIR}" +"${HUHU_DIR}/bin/poster.pl" "$HOME/etc/public.conf" diff --git a/etc/skel/bin/read-mail.sh b/etc/skel/bin/read-mail.sh new file mode 100644 index 0000000..34dcad0 --- /dev/null +++ b/etc/skel/bin/read-mail.sh @@ -0,0 +1,16 @@ +#!/bin/sh +# +# This script tries to load all messages in the backup directory into the +# database. Because of the md5sum check this should be a safe operation, +# i.e. it is not possible to produce duplicates. +# +# Use this script for testing or in case the procmail rules were defunct. +# +export "LANG=C" +export "LC_CTYPE=C" +set -o nounset +set -o errexit + +export HUHU_DIR="@HUHU_DIR@" +export PERL5LIB="${PERL5LIB:+$PERL5LIB:}${HUHU_DIR}" +"${HUHU_DIR}/bin/read-mail.pl" "-config=$HOME/etc/public.conf" "$HOME/backup"/* diff --git a/etc/skel/bin/statistics.sh b/etc/skel/bin/statistics.sh new file mode 100644 index 0000000..a2f45bd --- /dev/null +++ b/etc/skel/bin/statistics.sh @@ -0,0 +1,10 @@ +#!/bin/sh +export "LANG=C" +export "LC_CTYPE=C" +set -o nounset +set -o errexit + +export HUHU_DIR="@HUHU_DIR@" +export PERL5LIB="${PERL5LIB:+$PERL5LIB:}${HUHU_DIR}" +HTMLDIR=@HUHU_WWW_BASE_DIR@/@WWW_DIR@ +"${HUHU_DIR}/bin/statistics.pl" "${HOME}/etc/public.conf" > "${HTMLDIR}/stats/stats.txt" diff --git a/etc/skel/etc/htdigest b/etc/skel/etc/htdigest new file mode 100644 index 0000000..e69de29 diff --git a/etc/skel/etc/htdigest.sh b/etc/skel/etc/htdigest.sh new file mode 100644 index 0000000..6545cef --- /dev/null +++ b/etc/skel/etc/htdigest.sh @@ -0,0 +1,2 @@ +#!/bin/sh +htdigest "@USER_HOME@/etc/htdigest" "@USER_NAME@" "$@" diff --git a/etc/skel/etc/private.conf b/etc/skel/etc/private.conf new file mode 100644 index 0000000..e83d666 --- /dev/null +++ b/etc/skel/etc/private.conf @@ -0,0 +1,67 @@ +# Private configuration file. Contains sensitive data. +# Should be readable only by to the owner, i.e. by cronjobs +# and the procmail-scripts. + +# for removeold.pl +delete_spam_after=7 +delete_error_after=3 +delete_posting_after=90 + +# Duplicates older than this number of days are OK, +# Note: value must be less equal delete_posting_after. +check_duplicates_age=7 + +# If the public configuration file does not have mysql_password +# then list it here. +mysql_password=@MYSQL_PASSWORD@ + +# for poster.pl +nntp_user= +nntp_pass= +nntp_server=localhost + +# For poster.pl. Note that both passphrase and keyid must be defined +# to sign posts. +pgp_passphrase=@MODERATED_GROUP_ABBR@@YEAR@ +pgp_keyid=Moderation of @MODERATED_GROUP@ <@SUBMISSION_EMAIL@> + +# mailget.pl reads mails from this POP account. (Not used by read-mail.pl) +mod_pop_server= +mod_pop_username= +mod_pop_pass= + +# Use spamassassin: 1 -> Yes, 0 -> No. +spamassassin=1 + +# Compare subject with subjects of classified spam posts? +# subjectcheck: 1 -> Yes, 0 -> No. +subjectcheck=1 +subjectscore=7 + +# Check for binaries and HTML attachments? +# attachmentcheck: 1 -> Yes, 0 -> No. +attachmentcheck=1 +attachmentscore=7 + +# Language of target group (de, en) +lang= + +# Check submissions whether they match the language of the target group +# (works only with German). +# langcheck: 1 -> Yes, 0 -> No. +langcheck=0 +langscore=3 + +# autoreply.pl +# Hours until author of pending post is notified by mail. +min_time_until_autoreply= +# Hours until pending posts are ignored by autoreply.pl +max_time_until_autoreply= + +# ircbot.pl +ircbot_nick=@MODERATED_GROUP_ABBR@-bot +ircbot_realname=ircbot.pl +ircbot_username=@USER_NAME@ +ircbot_server=irc.freenode.net +ircbot_port=6667 +ircbot_channel=#@USER_NAME@ diff --git a/etc/skel/etc/public.conf b/etc/skel/etc/public.conf new file mode 100644 index 0000000..3f1457f --- /dev/null +++ b/etc/skel/etc/public.conf @@ -0,0 +1,50 @@ +# This is the public config file. +# It must be readable by the CGI scripts, i.e. by the web server. +# No sensitive data should be included here. + +# path to the private config file +priv_config_file=@USER_HOME@/etc/private.conf + +# UID required to read private data +UID=@USER_ID@ + +# Approved posts are posted to this group +moderated_group=@MODERATED_GROUP@ + +# Note: Specifying mysql_password here is a security risk since every +# script running in the context of the web server can read it. The +# alternative is the set environment variable 'mysql_password' through +# the Apache configuration. + +mysql_host=localhost +mysql_port=3306 +mysql_username=@MYSQL_USERNAME@ +mysql_table=@MYSQL_TABLE@ +mysql_db=@MYSQL_DB@ + +# posts listed per page +display_per_page=20 + +# Value of header "Approved:" in posts +approve_string=@SUBMISSION_EMAIL@ + +# Right hand side of message IDs in in posts. +# Empty value means that the news server generates the ID. +mid_fqdn= + +# Value of header "From:" in rejection notices. +mailfrom=@SUBMISSION_EMAIL@ + +html_content_type=iso-8859-15 +html_stylesheet_href=/huhu.css +html_language=en-us +http_negotiate_language=0 + +# Available methods +# Digest ... Password are checked by Apache, password file is maintained +# by 'htdigest', see samples/apache-digest.conf +# None ... No password, IP address is taken for username +http_authentication_method=Digest + +# ircbot.pl +ircbot_notify_sock=@USER_HOME@/var/ircbot.socket diff --git a/etc/skel/etc/samples/apache-digest.conf b/etc/skel/etc/samples/apache-digest.conf new file mode 100644 index 0000000..8fa5ab6 --- /dev/null +++ b/etc/skel/etc/samples/apache-digest.conf @@ -0,0 +1,11 @@ + + SetEnv HUHU_PUB_CONFIG "@USER_HOME@/etc/public.conf" + SetEnv mysql_password "@MYSQL_PASSWORD@" + + AuthType Digest + AuthName "@USER_NAME@" + AuthDigestProvider file + AuthUserFile "@USER_HOME@/etc/htdigest" + Require valid-user + + diff --git a/etc/skel/etc/samples/crontab b/etc/skel/etc/samples/crontab new file mode 100644 index 0000000..4b839c6 --- /dev/null +++ b/etc/skel/etc/samples/crontab @@ -0,0 +1,29 @@ +# +# Note: the right hand side of assignments is a literal string, i.e. +# variable references like "$HOME" are not expanded. +# +# MAILTO=administrator@webinterface.site +HUHU_DIR="@HUHU_DIR@" +PERL5LIB="@HUHU_DIR@" +CONFIG="@USER_HOME@/etc/public.conf" +BINDIR="@HUHU_DIR@/bin" +# HTMLDIR=/srv/www/html + +# mailget.pl reads incoming mail via POP3, stores them in database. +# If you use procmailrc then you don't need this. +# */5 * * * * "$BINDIR/mailget.pl" "$CONFIG" + +# Reads database, sends outgoing messages via NNTP. +*/5 * * * * "$BINDIR/poster.pl" "$CONFIG" + +# Show number of posts and reaction time. +# 3 * * * * "$BINDIR/statistics.pl" "$CONFIG" > "$HTMLDIR/stats/stats.txt" + +# Remove old records from database +5 3 * * * "$BINDIR/removeold.pl" "$CONFIG" + +# Reads database, sends reply to authors of pending messages. +# 10 * * * * "$BINDIR/autoreply.pl" "$CONFIG" + +# Reads database, announces incoming mail in IRC channel. +# @reboot "$BINDIR/ircbot.sh" start diff --git a/etc/skel/etc/samples/huhu-directory.html b/etc/skel/etc/samples/huhu-directory.html new file mode 100644 index 0000000..f478060 --- /dev/null +++ b/etc/skel/etc/samples/huhu-directory.html @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + +
GroupLanguageWeb InterfaceStatisticsEstablished
@MODERATED_GROUP@en-uspublicprivatereaction time@TODAY@
diff --git a/etc/skel/etc/samples/summary.txt b/etc/skel/etc/samples/summary.txt new file mode 100644 index 0000000..8346d72 --- /dev/null +++ b/etc/skel/etc/samples/summary.txt @@ -0,0 +1,68 @@ +== 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 . + +== Web Interface == + +The web interface consists of two parts. The public part is accessible +to everybody. It just displays the approved posts. + + @HUHU_WWW_BASE_URL@/@WWW_DIR@/public.pl + +And then there is the private part. This is protected with a login. +using the HTTP digest system. + + @HUHU_WWW_BASE_URL@/@WWW_DIR@/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=@SUBMISSION_EMAIL@ + + # Right hand side of message IDs in in posts. + # Empty value means that the news server generates the ID. + mid_fqdn= + + # Value of header "From:" in rejection notices. + mailfrom=@SUBMISSION_EMAIL@ + +== Usenet Account == + +Username: @SUBMISSION_EMAIL@ +Password: +Server : news.albasani.net + +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. diff --git a/etc/skel/var/EMPTY b/etc/skel/var/EMPTY new file mode 100644 index 0000000..e69de29 diff --git a/samples/crontab b/samples/crontab new file mode 100644 index 0000000..536ea3f --- /dev/null +++ b/samples/crontab @@ -0,0 +1,24 @@ +MAILTO=administrator@webinterface.site +PERL5LIB=/srv/www/huhu +CONFIG=/srv/www/SAMPLE/home/etc/SAMPLE_pub.config +BINDIR=/srv/www/huhu/bin +HTMLDIR=/srv/www/SAMPLE/html + +# mailget.pl reads incoming mail via POP3, stores them in database. +# If you use procmailrc then you don't need this. +# */5 * * * * $BINDIR/mailget.pl $CONFIG + +# Reads database, sends outgoing messages via NNTP. +*/5 * * * * $BINDIR/poster.pl $CONFIG; + +# Show number of posts and reaction time. +3 * * * * $BINDIR/statistics.pl $CONFIG > $HTMLDIR/stats/stats.txt + +# Remove old records from database +5 3 * * * $BINDIR/removeold.pl $CONFIG + +# Reads database, sends reply to sender of mail that message is in queue. +# 10 * * * * $BINDIR/autoreply.pl $CONFIG + +# Reads database, announces incoming mail in IRC channel. +# @reboot $BINDIR/ircbot.pl $CONFIG diff --git a/samples/modtable.pl b/samples/modtable.pl new file mode 100644 index 0000000..2b7dd13 --- /dev/null +++ b/samples/modtable.pl @@ -0,0 +1,15 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +$ENV{'CONTENT_TYPE'} = "multipart/form-data"; + +use CGI::Carp 'fatalsToBrowser'; + +BEGIN { + push (@INC,'/srv/www/huhu'); +} + +use MOD::Handler; +my $h = MOD::Handler->new('/srv/www/sample/home/etc/sample_pub.config'); +$h->run(); diff --git a/samples/mysql/create.sql b/samples/mysql/create.sql new file mode 100644 index 0000000..6ecf883 --- /dev/null +++ b/samples/mysql/create.sql @@ -0,0 +1,86 @@ +# +# $Id: create.sql 304 2011-11-02 14:14:01Z root $ +# +# Create statement for mysql. Replace @sample@ with your table prefix. +# For example: +# sed 's/@sample@/atm/g' < create.sql +# +CREATE TABLE @sample@ ( + ID bigint NOT NULL auto_increment, + # 'spam' ... can be put back to 'pending' queue + # 'moderated' ... tells poster.pl to send the message, + # can be put back to 'pending' queue + # 'rejected' ... a mail was sent to the author - cannot be undone + # 'deleted' ... can be put back to 'pending' queue + # 'posted' ... message was sent to server - cannot be undone + # 'sending' ... poster.pl is trying to send article to server, + # next state is 'moderated', 'posted', or 'broken' + # 'broken' ... poster.pl encountered a fatal error + Status ENUM( + 'pending', + 'spam', + 'moderated', + 'rejected', + 'deleted', + 'posted', + 'sending', + 'broken' + ) NOT NULL, + Sender text NOT NULL, + ReplyTo text, + Subject text NOT NULL, + MessageID text DEFAULT NULL, + Datum DATETIME NOT NULL, + Header longblob NOT NULL, + Body longblob NOT NULL, + Spamcount float DEFAULT 0.0, + Moderator varchar(20), + Moddatum DATETIME, + checksum char(40) UNIQUE, + flag bool DEFAULT 0, + PRIMARY KEY (ID), + KEY(status), + KEY(Datum), + KEY(Moddatum), + KEY(checksum), + KEY(subject(40)), + KEY(flag) +); + +# DROP TABLE @sample@_error; +CREATE TABLE @sample@_error ( + error_id BIGINT NOT NULL AUTO_INCREMENT, + article_id BIGINT, + error_date DATETIME NOT NULL, + # Number of duplicate (article_id,error_message) tuples. + error_count INT(2) DEFAULT 0 NOT NULL, + error_message TEXT, + PRIMARY KEY (error_id), + UNIQUE(article_id, error_message(40)), + FOREIGN KEY (article_id) REFERENCES @sample@(id) ON DELETE CASCADE +); + +CREATE OR REPLACE VIEW @sample@_error_view AS +SELECT id, + flag, + sender AS article_sender, + subject AS article_subject, + status AS article_status, + error_id, + error_date, + error_count, + error_message +FROM @sample@_error AS _error +LEFT JOIN (@sample@ AS _article) +ON _error.article_id = _article.id; + +# DROP TABLE @sample@_reply; +CREATE TABLE @sample@_reply ( + reply_id BIGINT NOT NULL AUTO_INCREMENT, + article_id BIGINT, + reply_date DATETIME NOT NULL, + reply_message TEXT, + PRIMARY KEY (reply_id), + KEY(article_id), + FOREIGN KEY (article_id) REFERENCES @sample@(id) ON DELETE CASCADE +); diff --git a/samples/mysql/update-0.05-to-0.06.sql b/samples/mysql/update-0.05-to-0.06.sql new file mode 100644 index 0000000..9c841e7 --- /dev/null +++ b/samples/mysql/update-0.05-to-0.06.sql @@ -0,0 +1,17 @@ +# +# $Id: update-0.05-to-0.06.sql 102 2009-09-16 18:46:27Z alba $ +# +# Update from version 0.05 to 0.06 + +# Check for errors (should return no rows) +SELECT status,posted FROM @sample@ WHERE posted and status <> 'moderated'; +SELECT status,posted FROM @sample@ WHERE status = 0; + +# Add value 'posted' to column 'status'. +ALTER TABLE @sample@ CHANGE Status Status enum('pending','spam','moderated','rejected','deleted','posted'); + +# Transfer column 'posted' to column 'status'. +UPDATE @sample@ SET Status = 'posted' WHERE posted; + +# Remove column 'posted'. +ALTER TABLE @sample@ DROP column posted; diff --git a/samples/mysql/update-0.06-to-0.07.sql b/samples/mysql/update-0.06-to-0.07.sql new file mode 100644 index 0000000..6081ebe --- /dev/null +++ b/samples/mysql/update-0.06-to-0.07.sql @@ -0,0 +1,22 @@ +# +# $Id: update-0.06-to-0.07.sql 115 2009-09-20 10:09:22Z alba $ +# +# Update from version 0.06 to 0.07 + +# First use create.sql to create table @sample@_error + +# Copy columns errorcount and errormessage to table @sample@_error +INSERT INTO @sample@_error +(article_id, error_date, error_count, error_message) +SELECT a.id, NOW(), a.errorcount, a.errormessage +FROM @sample@ a +WHERE errorcount > 0; + +# Drop columns errorcount and errormessage +ALTER TABLE @sample@ DROP column errorcount; +ALTER TABLE @sample@ DROP column errormessage; + +# Test record: +# INSERT INTO @sample@_error (article_id, error_date, error_count, error_message) VALUES(10, NOW(), 17, 'huhu'); +# INSERT INTO @sample@_error (article_id, error_date, error_count, error_message) VALUES(11, NOW(), 3, 'berta'); +# SELECT * FROM @sample@_error; diff --git a/samples/mysql/update-0.07-0.08.sql b/samples/mysql/update-0.07-0.08.sql new file mode 100644 index 0000000..cf99073 --- /dev/null +++ b/samples/mysql/update-0.07-0.08.sql @@ -0,0 +1,7 @@ +# +# $Id: update-0.07-0.08.sql 121 2009-09-20 15:32:22Z alba $ +# +# Update from version 0.07 to 0.08 + +ALTER TABLE @sample@ CHANGE Status Status ENUM('pending','spam','moderated','rejected','deleted','posted','sending'); + diff --git a/samples/mysql/update-0.08-0.09.sql b/samples/mysql/update-0.08-0.09.sql new file mode 100644 index 0000000..9d1e8bd --- /dev/null +++ b/samples/mysql/update-0.08-0.09.sql @@ -0,0 +1,16 @@ +# +# $Id: update-0.08-0.09.sql 145 2009-10-11 20:00:45Z alba $ +# +# Update from version 0.08 to 0.09 + +# First use create.sql to create table @sample@_reply + +# Copy column Answer to table @sample@_reply +INSERT INTO @sample@_reply +(article_id, reply_date, reply_message) +SELECT a.id, IFNULL(a.Moddatum, NOW()), a.answer +FROM @sample@ a +WHERE a.answer is not null; + +# Drop column Answer +ALTER TABLE @sample@ DROP COLUMN answer; diff --git a/samples/mysql/update-0.09-0.10.sql b/samples/mysql/update-0.09-0.10.sql new file mode 100644 index 0000000..166446d --- /dev/null +++ b/samples/mysql/update-0.09-0.10.sql @@ -0,0 +1,8 @@ +# +# $Id: update-0.07-0.08.sql 121 2009-09-20 15:32:22Z alba $ +# +# Update from version 0.07 to 0.08 + +ALTER TABLE @sample@ CHANGE COLUMN Status +Status ENUM('pending','spam','moderated','rejected','deleted','posted','sending','broken') NOT NULL; + diff --git a/samples/procmailrc b/samples/procmailrc new file mode 100644 index 0000000..0e1719d --- /dev/null +++ b/samples/procmailrc @@ -0,0 +1,19 @@ +# +# Save this file as $HOME/.procmailrc +# +LOGFILE=$HOME/procmail.log +PATH=/usr/bin:/bin +VERBOSE=yes +PERL5LIB=/srv/www/huhu + +# save mails in backup directory +:0 c +backup + +# trim backup directory +:0 ic +| cd backup && rm -f dummy `ls -t msg.* | sed -e 1,32d` + +# add incoming mail to database +:0 +| /srv/www/huhu/bin/read-mail.pl /srv/www/SAMPLE/home/etc/SAMPLE_pub.config diff --git a/samples/public.pl b/samples/public.pl new file mode 100644 index 0000000..d363b29 --- /dev/null +++ b/samples/public.pl @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use CGI::Carp 'fatalsToBrowser'; +$ENV{'CONTENT_TYPE'} = "multipart/form-data"; + +BEGIN { + push (@INC,'/srv/www/huhu/'); +} +require MOD::PublicHandler; + +my $h = MOD::PublicHandler->new('/srv/www/SAMPLE/home/etc/SAMPLE_pub.config'); +$h->run(); diff --git a/sbin/create-functions.sh b/sbin/create-functions.sh new file mode 100644 index 0000000..bfad864 --- /dev/null +++ b/sbin/create-functions.sh @@ -0,0 +1,123 @@ +#!/bin/sh +# +# $Id: create-functions.sh 290 2011-06-20 00:45:51Z alba $ +# +set_mysql_vars() +{ + moderated_group="$1" + + # news.newusers.questions => nnq + moderated_group_abbr=$( echo "${moderated_group}" | + sed 's#\([a-zA-Z]\)[a-zA-Z]*\([^a-zA-Z]\|$\)#\1#g' ) + if [ -z "${moderated_group_abbr}" ]; then + echo "${moderated_group} is not a valid newsgroup" + exit 1 + fi + + # news.newusers.questions => news/newusers/questions + www_dir=$( echo "${moderated_group}" | tr . / ) + + # news.newusers.questions => news-newusers-questions + mysql_db=$( echo "${moderated_group}" | tr . - ) + + mysql_password=$( "${HUHU_DIR}/bin/new-passwd.pl" ) + mysql_table="${moderated_group_abbr}" + mysql_username="${mysql_db}" + + length=$( echo "${mysql_username}" | wc -c ) + if [ "${length}" -gt 16 ]; then + # http://dev.mysql.com/doc/refman/4.1/en/user-names.html + # MySQL user names can be up to 16 characters long. + mysql_username="${moderated_group_abbr}" + fi + + export today=$( date +%Y-%m-%d ) + export year=$( date +%Y ) +} + +create_mysql() +{ + local cmd="DROP USER '${mysql_username}'@'localhost'" + + if echo "${cmd}" | mysql + then echo "${cmd} succeeded." + else echo "${cmd} failed." + fi + + mysqladmin create "${mysql_db}" + ( + echo "CREATE USER '${mysql_username}'@'localhost' IDENTIFIED BY '${mysql_password}';" + echo 'GRANT ALL ON `'${mysql_db}'`.* TO '"'${mysql_username}'@'localhost';" + ) | mysql + + sed "s/@sample@/${mysql_table}/g" \ + < "${HUHU_DIR}/samples/mysql/create.sql" | + mysql "${mysql_db}" + + echo "mysql_db=${mysql_db}" + echo "mysql_table=${mysql_table}" + echo "mysql_username=${mysql_username}" + echo "mysql_password=${mysql_password}" +} + +clean_new_home() +{ + cd "${1}" || exit 1 + + # remove .svn or _svn directories copied from skeleton + find . -type d -name '[._]svn' -exec rm -rf {} \+ + + # remove backup files + find . -type f -name '*~' -exec rm {} \+ + + # property svn:executable is used to set the executable bit, so keep + # u-permissions intact + find . -type f -exec chmod o-rwx,g-rwx {} \+ +} + +install_file() +{ + permissions="$1" + src="$2" + dst="${user_home}/${src}" + + # template file was copied from skeleton by useradd + # set safe permissions before we write sensitive contents into it + chmod "${permissions}" "${dst}" + + awk '{ + gsub(/@HUHU_DIR@/, ENVIRON["HUHU_DIR"]); + gsub(/@HUHU_WWW_BASE_DIR@/, ENVIRON["HUHU_WWW_BASE_DIR"]); + gsub(/@HUHU_WWW_BASE_URL@/, ENVIRON["HUHU_WWW_BASE_URL"]); + gsub(/@MODERATED_GROUP_ABBR@/, ENVIRON["moderated_group_abbr"]); + gsub(/@MODERATED_GROUP@/, ENVIRON["moderated_group"]); + gsub(/@MYSQL_DB@/, ENVIRON["mysql_db"]); + gsub(/@MYSQL_PASSWORD@/, ENVIRON["mysql_password"]); + gsub(/@MYSQL_TABLE@/, ENVIRON["mysql_table"]); + gsub(/@MYSQL_USERNAME@/, ENVIRON["mysql_username"]); + gsub(/@SUBMISSION_EMAIL@/, ENVIRON["user_name"] "@" ENVIRON["HUHU_EMAIL_DOMAIN"]); + gsub(/@TODAY@/, ENVIRON["today"]); + gsub(/@YEAR@/, ENVIRON["year"]); + gsub(/@USER_HOME@/, ENVIRON["user_home"]); + gsub(/@USER_ID@/, ENVIRON["user_id"]); + gsub(/@USER_NAME@/, ENVIRON["user_name"]); + gsub(/@WWW_DIR@/, ENVIRON["www_dir"]); + print $0; + }' "${skel_dir}/${src}" > "${dst}" +} + +create_www_home() +{ + [ -n "${HUHU_WWW_BASE_DIR:-}" ] || return + [ -n "${www_dir:-}" ] || return + + local dir="${HUHU_WWW_BASE_DIR}/${www_dir}/stats" + [ -d "${dir}" ] || mkdir -p "${dir}" + + dir="${HUHU_WWW_BASE_DIR}/${www_dir}" + ( + cd "${dir}" + ln -s "${HUHU_DIR}/cgi-bin/modtable.pl" + ln -s "${HUHU_DIR}/cgi-bin/public.pl" + ) +} diff --git a/sbin/create-mysql.sh b/sbin/create-mysql.sh new file mode 100644 index 0000000..a0539f5 --- /dev/null +++ b/sbin/create-mysql.sh @@ -0,0 +1,12 @@ +#!/bin/sh +# +# $Id: create-mysql.sh 179 2009-11-07 15:19:03Z root $ +# +export "LANG=C" +export "LC_ALL=C" +set -o nounset +set -o errexit + +. "${HUHU_DIR}/sbin/create-functions.sh" +set_mysql_vars "$1" +create_mysql diff --git a/sbin/create-procmail-user.sh b/sbin/create-procmail-user.sh new file mode 100644 index 0000000..8d9f83a --- /dev/null +++ b/sbin/create-procmail-user.sh @@ -0,0 +1,74 @@ +#!/bin/sh -x +# +# $Id: create-procmail-user.sh 290 2011-06-20 00:45:51Z alba $ +# +export "LANG=C" +export "LC_ALL=C" +set -o nounset +set -o errexit + +if [ -z "${1:-}" ]; then + echo "USAGE: create-procmail-user.sh " + exit 0 +fi + +. "${HUHU_DIR}/sbin/create-functions.sh" +set_mysql_vars "$1" +create_mysql + +# mysql_username may be an abbreviation, so use mysql_db +user_name="${mysql_db}" + +skel_dir="${HUHU_DIR}/etc/skel" +if [ ! -d ${skel_dir} ]; then + echo "Skeleton directory \$HUHU_DIR/etc/skel does not exist." + exit 1 +fi + +user_home="${HUHU_HOME_BASE_DIR:-/home}/"$( echo "${user_name}" | sed 's#[-.]#/#g' ) +user_home_parent="${user_home%/*}" +[ -d "${user_home_parent}" ] || mkdir -p "${user_home_parent}" +useradd --home "${user_home}" --create-home --skel "${skel_dir}" "${user_name}" + +user_home=$( awk -F: "/^${user_name}:/ { print \$6 }" /etc/passwd ) + +if [ ! -d "${user_home}" ]; then + echo "Home directory of user ${user_name} does not exist." + exit 1 +fi +user_id=$( awk -F: "/^${user_name}:/ { print \$3 }" /etc/passwd ) + +clean_new_home "${user_home}" +create_www_home + +export moderated_group moderated_group_abbr +export mysql_db mysql_password mysql_table mysql_username +export user_home user_id user_name www_dir + +if [ -n "${HUHU_EMAIL_DOMAIN:-}" ]; then + if [ -n "${HUHU_EMAIL_LIST:-}" -a -w "${HUHU_EMAIL_LIST:-}" ]; then + echo "${user_name}@${HUHU_EMAIL_DOMAIN}" >> "${HUHU_EMAIL_LIST}" + fi + if [ -n "${HUHU_POSTFIX_ALIAS:-}" -a -w "${HUHU_POSTFIX_ALIAS:-}" ]; then + echo "${user_name}@${HUHU_EMAIL_DOMAIN} ${user_name}" >> "${HUHU_POSTFIX_ALIAS}" + fi +fi + +install_file 600 .bashrc +install_file 600 .cshrc +install_file 600 etc/private.conf +install_file 600 etc/samples/apache-digest.conf +install_file 600 etc/samples/crontab +install_file 600 etc/samples/summary.txt +install_file 600 .forward +install_file 600 .my.cnf +install_file 600 .procmailrc +install_file 644 etc/htdigest +install_file 644 etc/public.conf +install_file 644 etc/samples/huhu-directory.html +install_file 755 bin/poster.sh +install_file 755 bin/read-mail.sh +install_file 755 bin/statistics.sh +install_file 755 etc/htdigest.sh + +crontab -u "${user_name}" "${user_home}/etc/samples/crontab"