Initial checkin.

Signed-off-by: Thomas Hochstein <thh@thh.name>

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;
+######################################################################

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;
+######################################################################

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 '<div class="huhuContents">';
+  print $q->h1($title);
+  my $subtitle = $args{'-subtitle'};
+  if ($subtitle)
+  {
+    printf '<div class="huhuSubtitle">%s</div>', $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
+    '<div class="huhuVersion">',
+    join('&nbsp;&middot;&nbsp;', @a),
+    '.</div>',
+    '</div><!-- class="huhuContents" -->',
+    $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 '<div class="huhuError">',
+        $trans->($msg ? $msg : $title),
+	'</div>';
+  $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 '<table class="huhuPostList">';
+  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 "<tr$rowattr>";
+      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'<td>';
+      $self->display_decisionbuttons($decisionref, $ref, \@hidden_columns);
+      print '</td></tr>',"\n";
+     } while ($ref = $dataref->fetchrow_arrayref);
+  }
+
+  if ($row_nr == 0)
+  {
+    printf '<tr><td class="huhuNoRows" colspan="%d">', 1 + $#names;
+    print  $trans->('No matching records available.');
+    print '</td></tr>';
+  }
+
+  print "</table>\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
+    '<div class="huhuReason">',
+    '<pre width="100">', CGI::escapeHTML($reason), '</pre>',
+    '</div>';
+  $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
+    '<div class="huhuNavigation">',
+    '<span>', 
+    $q->a({ href => $q->referer() }, $trans->('Back')),
+    '</span>',
+    '</div>';
+}
+
+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
+      '<div class="huhuArticleInfo">',
+      join('&nbsp;&middot;&nbsp;', @a),
+      '</div>';
+  }
+}
+ 
+######################################################################
+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 '<table class="huhuArticle">';
+  if ($fullheader) {
+     my $header = join "\n",$article->headers();
+     print $q->Tr($q->td({-colspan=>2},'<pre width="100">' . CGI::escapeHTML($header) .'</pre>'));
+  } else {
+    for my $headerline (@{$headerref}) {
+      print
+	'<tr class="huhuArticleHeader">',
+	'<th>', CGI::escapeHTML($headerline), '</th>',
+	'<td>', CGI::escapeHTML($article->header($headerline)), '</td>',
+	'</tr>';
+    }
+  }
+  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},
+		      '<pre width="100">' . CGI::escapeHTML(join ("\n",$article->body())) . '</pre>')),
+       '</table><table class="huhuDecisionButtons"><tr><td>';
+  $self->display_decisionbuttons($decisionref, [ $id ]);
+  print "</td></tr>\n</table>";
+
+  $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 '<div class="huhuErrorMessage"><pre>',
+        CGI::escapeHTML($input),
+	'</pre></div>';
+  $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'
+      }),
+      '<br/>',
+      $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/\&gt;/>/sg;
+  $antwort =~ s/\&lt;/</sg;
+  $antwort =~ s/\&amp;/&/sg;
+  $self->{'db'}->set_rejected('deleted', $id, $self->{'user_name'}, $antwort);
+  return;
+}
+
+######################################################################
+sub send_mail($$)
+######################################################################
+{
+  my ($self,$id) = @_;
+  my $antwort = $self->{'q'}->param('antwort');
+  $antwort =~ s/\&gt;/>/sg;
+  $antwort =~ s/\&lt;/</sg; 
+  $antwort =~ s/\&amp;/&/sg;
+
+  my $trans = $self->{'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
+      '<input type="hidden" name="%s" value="%s"/>',
+      $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 '<div class="huhuNavigation"><span>', 
+        $q->a(
+	  { href => $self_url . '?'. $cmd . ',' . $before },
+	  $trans->('Previous page')
+	),
+        '</span><span>',
+	$q->a(
+	  { href => $self_url . '?'. $cmd . ',' . $next },
+	  $trans->('Next page')
+	),
+        '</span></div>';
+  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 '<ul class="huhuMainMenu%d">', $level;
+  for my $r_definition(@$r_items)
+  {
+    my $submenu = $r_definition->[2];
+    printf
+      '<li><span><a href="%s">%s</a></span>',
+      $self_url . '?' . $r_definition->[0],
+      $trans->( $r_definition->[1] );
+    if ($submenu)
+    {
+      $self->print_menu_items($submenu, $level + 1);
+    }
+    print '</li>';
+  }
+  print '</ul>';
+}
+
+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 '<table class="huhuPostList">';
+  print $q->Tr($q->th({-align=>'left'}, [ 'Key', 'Value' ]));
+
+  my @key = SHOW_CONFIG;
+  for my $key(@key)
+  {
+    printf "<tr><td>%s</td><td>%s</td></tr>", $key, $config->{$key};
+  }
+  print "</table>";
+
+  $self->display_end();
+}
+
+######################################################################
+1;
+######################################################################

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;
+######################################################################

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;
+######################################################################

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 <roman.racine@gmx.net>
+
+
+=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;
+}
+

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;
+######################################################################

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);
+}

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 $<!\n";
+  }
+
+  my $priv_file = $config_vars{'priv_config_file'} ||
+    die "No 'priv_config_file' in public configuration file $filename";
+  read_config_file($priv_file, \%config_vars);
+  return %config_vars;
+}
+
+######################################################################
+sub get_supported_translators()
+######################################################################
+{
+  return @SUPPORTED_LANG if (@SUPPORTED_LANG);
+
+  my $pkgname = __PACKAGE__;    # value of __PACKAGE__ is "MOD::Utils"
+  $pkgname =~ s#.*::##g;        # reduce to "Utils"
+  my $pkgdir = __FILE__;        # __FILE__ is "/srv/www/huhu/MOD/Utils.pm"
+  $pkgdir =~ s#$pkgname\.pm$##; # reduce to "/srv/www/huhu/MOD/"
+  $pkgdir .= 'lang';
+
+  # String constants in this software are written in American English.
+  @SUPPORTED_LANG = ( 'en-us' );
+  %SUPPORTED_LANG = ( 'en-us' => 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;
+######################################################################

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;

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;

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;

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;

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

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;
+  }
+}
+
+######################################################################

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);
+    }
+  }
+}

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;

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

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);
+  } 
+}

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

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 <<EOF;
+== Email ==
+
+The submission address is <$SUBMISSION_EMAIL>.
+
+Messages are directly processed by procmail, so you cannot access it
+with POP or IMAP. (Messages are saved in a backup directory as plain
+files, though.)
+
+You can test Huhu by sending posts directly to this address.
+When tests are finished you should send a message stating that
+<$SUBMISSION_EMAIL> is the new submission address of
+$MODERATED_GROUP to <moderators-request\@isc.org>.
+
+== Web Interface ==
+
+The web interface consists of two parts. The public part is accessible
+to everybody. It just displays the approved posts.
+
+   https://albasani.net/huhu/aus/legal/moderated/public.pl
+
+And then there is the private part. This is protected with a login.
+using the HTTP digest system.
+
+   https://albasani.net/huhu/aus/legal/moderated/modtable.pl
+
+HTTP digest is safe to use on unencrypted connections, but for additional
+paranoia above URLs are also available through https (with a self signed
+certificate).
+
+There is currently no way to handle user management through the web
+interface. I created one account for you:
+
+Username:
+Password:
+
+== Test Mode ==
+
+At the moment this instance of Huhu is in test mode. Approved messages
+are sent to albasani.test.moderated.  This is an internal group, i.e.
+it is not sent to peers. You need an albasani-account to read it.
+
+When you are satisfied with your tests please give me a note.
+I will then switch to $MODERATED_GROUP.
+
+== Configurable Options ==
+
+The following settings are set to default values.
+Please give me a note if you want to have them changed.
+
+  # Value of header "Approved:" in posts
+  approve_string=$APPROVE_STRING
+
+  # Right hand side of message IDs in in posts.
+  # Empty value means that the news server generates the ID.
+  mid_fqdn=$MID_FQDN
+
+  # Value of header "From:" in rejection notices.
+  mailfrom=$MAILFROM
+
+== Usenet Account ==
+
+Username: $NNTP_USER
+Password: $NNTP_PASS
+Server  : $NNTP_SERVER
+
+It has permissions to send approved posts to albasani.test.moderated
+and $MODERATED_GROUP. Use it to bypass the moderation (e.g. send FAQs
+or cancel messages) or to read the internal albasani.* groups.
+EOF

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";

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 <Pfad zum Configfile> aufgerufen
+Dasselbe Programm mit unterschiedlichen Konfigurationsfiles
+aufgerufen kann zur Moderation mehrerer Gruppen eingesetzt werden.
+
+=head1 REQUIREMENTS
+
+Net::NNTP
+
+News::Article
+
+MOD::*
+
+=head1 AUTHOR
+
+Roman Racine <roman.racine@gmx.net>
+
+=head1 VERSION
+
+10. Februar 2007
+
+=cut
+
+######################################################################
+
+use strict;
+use warnings;
+use Carp qw(confess);
+
+use Net::NNTP();
+use News::Article;
+
+use MOD::Utils;
+use MOD::DBIUtils;
+
+use constant DEBUG => 0;
+
+######################################################################
+sub connect_nntp($)
+######################################################################
+{
+  my $r_config = shift || confess;
+
+  my $cfg_nntp_server = $r_config->{'nntp_server'} ||
+    die 'No "nntp_server" in configuration file';
+  my $nntp = new Net::NNTP($cfg_nntp_server, 'DEBUG' => DEBUG) ||
+    die "Can't connect to news server $cfg_nntp_server";
+
+  my $cfg_nntp_user = $r_config->{'nntp_user'} ||
+    die 'No "nntp_user" in configuration file';
+  my $cfg_nntp_pass = $r_config->{'nntp_pass'} ||
+    die 'No "nntp_pass" in configuration file';
+
+  # authinfo does not return a value
+  $nntp->authinfo($cfg_nntp_user, $cfg_nntp_pass);
+
+  return $nntp;
+}
+
+######################################################################
+# MAIN
+######################################################################
+
+my %config = MOD::Utils::read_private_config($ARGV[0]);
+my $approve_string = $config{'approve_string'} ||
+  die 'No "approve_string" in $config';
+
+my $moderated_group = $config{'moderated_group'};
+my $pgp_passphrase = $config{'pgp_passphrase'};
+my $pgp_keyid = $config{'pgp_keyid'};
+my $sign_pgpmoose = ($moderated_group && $pgp_passphrase && $pgp_keyid);
+
+if ($sign_pgpmoose && DEBUG > 1)
+{
+  print "News::Article::sign_pgpmoose enabled.\n";
+}
+
+my Net::NNTP $nntp = connect_nntp(\%config);
+my $dbi = MOD::DBIUtils->new(\%config) ||
+  die "Can't connect to database";
+
+# Select all posts that have been approved but not posted,
+# i.e. all posts in the state 'moderated'.
+my $dataref = $dbi->select_unposted();
+
+#Schleife ueber alle selektierten Postings
+#Einlesen des Postings, Header anpassen,anschliessend posten
+#und das das posted-Bit in der Datenbank setzen.
+
+while (my $ref = $dataref->fetchrow_arrayref)
+{
+  my ($id,$posting) = @{$ref};
+  next unless($dbi->set_status($id, 'sending', [ 'moderated' ]));
+
+# Posting einlesen.
+  my $article = News::Article->new(\$posting);
+  next if (!defined($article->header('Newsgroups')));
+
+  { # Save original date header
+    my $date = $article->header('Date');
+    if ($date)
+      { $article->set_headers('X-Huhu-Submission-Date', $date); }
+  }
+
+  # Drop superfluous headers
+  $article->drop_headers(
+    'Approved',
+    'Date',
+    'Delivery-date',
+    'Delivered-To',
+    'Errors-To',		# Mailman
+    'Envelope-to',
+    'Injection-Info',		# defined by INN 2.6.x and Schnuerpel 2010
+    'Lines',			# defined by INN 2.5.x or older
+    'NNTP-Posting-Date',	# defined by INN 2.5.x or older
+    'NNTP-Posting-Host',	# defined by INN 2.5.x or older
+    'Path',
+    'Precedence',		# Mailman
+    'Received',
+    'Status',
+    'Return-Path',
+    'To',
+    'X-Antivirus',
+    'X-Antivirus-Status',
+    'X-Attachment-Test',
+    'X-Beenthere',		# Mailman
+    'X-Complaints-To',		# defined by INN 2.5.x or older
+    'X-Lang-Test',
+    'X-Mailman-Version',	# Mailman
+    'X-MSMail-Priority',	# Outlook
+    'X-NNTP-Posting-Host',	# set by Schnuerpel 2009 or older
+    'X-Originating-IP',
+    'X-Priority',		# Outlook
+    'X-Provags-ID',		# GMX/1&1
+    'X-Spamassassin-Test',
+    'X-Spam-Checker-Version',
+    'X-Spam-Level',
+    'X-Spam-Report',
+    'X-Spam-Score',
+    'X-Spam-Status',
+    'X-Subject-Test',
+    'X-Trace',			# defined by INN 2.5.x or older
+    'X-User-ID',		# set by Schnuerpel 2009 or older
+    'X-Virus-Scanned',
+    'X-Y-Gmx-Trusted',		# GMX/1&1
+    'X-Zedat-Hint',		# Uni Berlin/Individual?
+  );
+
+#albasani-workaround fuer @invalid
+  if ($article->header('From') =~ /\@invalid[> ]/i) {
+      my $newfrom = $article->header('From');
+      $newfrom =~ s/\@invalid/\@invalid.invalid/i;
+      $article->set_headers('From',$newfrom);
+  }      
+# albasani-workaround fuer leere User-Agent headerzeilen
+  if (defined $article->header('User-Agent') and $article->header('User-Agent') !~ /\w/) {
+     $article->drop_headers(('User-Agent'));
+  }
+
+#Neue Message-ID und Approved-Header erzeugen
+ my $mid = defined($article->header('Message-ID')) ? $article->header('Message-ID') :
+          '<' . substr (rand() . '-' . time(), 2) . '@' . $config{'mid_fqdn'} . '>';
+ $article->set_headers('Message-ID', $mid, 'Approved', $approve_string);
+
+#signieren
+  if ($sign_pgpmoose)
+  {
+    my @msg = $article->sign_pgpmoose($moderated_group, $pgp_passphrase, $pgp_keyid);
+    if (@msg)
+    {
+      print join("\n", 'News::Article::sign_pgpmoose ', @msg); 
+    }
+  }
+
+  my @articleheaders = $article->header('References');
+  eval {
+# Workaround fuer Buggy Software, die kaputte References erzeugt
+   my @references = $article->header('References');
+   if (@references > 1) {
+       $article->set_headers('References', join "\n ", @references);
+   } 
+#posten
+  $article->post($nntp) or die $!;
+#posted-Bit setzen, aktuelle MID in DB eintragen (wird in Zukunft vielleicht mal von einer Zusatzfunktion benoetigt)
+  $dbi->set_posted_status($id,$mid);
+ }; 
+  # Fehler in Datenbank festhalten, sofern einer aufgetreten ist
+  if ($@) {
+    $dbi->increase_errorlevel($id, $@);
+    $dbi->set_status($id, 'moderated', [ 'sending' ]);
+  }
+}

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 $/; <STDIN>; };
+  die "Error: No data on stdin" unless ($text);
+  my $article = parse_text(\$text) || exit(1);
+  $fn->($rm, $article, '<STDIN>');
+}
+else
+{
+  for my $name(@ARGV)
+  {
+    my $file;
+    open($file, '<', $name) || die "Error: Can't open $name\n$!";
+    my $text = do { local $/; <$file>; };
+    close($file);
+    my $article = parse_text(\$text) || next;
+    $fn->($rm, $article, $name);
+  }
+}
+
+######################################################################

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

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;

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();

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();

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

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

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

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
+
+

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;
+}

doc/html/index.html

@@ -0,0 +1,89 @@
+<?xml version="1.0" encoding="ISO-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<!-- $Id: index.html 301 2011-09-28 04:43:06Z alba $ -->
+<html xmlns="http://www.w3.org/1999/xhtml" lang="de" xml:lang="de">
+<head>
+<title>Huhu Overview</title>
+<style type="text/css" media="all">@import "huhu.css";</style>
+</head>
+<body><div id="huhuContents">
+
+<h2>Huhu</h2>
+
+<p>Huhu is a web application to moderate Usenet groups.</p>
+
+<h3>Basic workflow</h3>
+<ol>
+  <li>Emails are sent to the submission address</li>
+  <li>Retrieved mails are stored in database</li>
+  <li>The web application visualizes the stored mails</li>
+  <li>Human moderators use the web application to classify mail:
+  <ul>
+    <li>Approved submissions are sent to the news server</li>
+    <li>For rejected submissions a rejection notice is sent to the author via mail</li>
+    <li>Submissions can also be silently ignored</li>
+    <li>Mails classified as spam are silently ignored but also train the spamfilter</li>
+  </ul></li>
+</ol>
+
+<h3>Requirements</h3>
+<ul>
+  <li>Some kind of Unix (Huhu is developed on Ubuntu Linux)</li>
+  <li>A way to execute jobs in periodic intervals, e.g. crond</li>
+  <li>perl 5 (and a list of additional perl modules)</li>
+  <li>A web server cabaple of executing perl scripts (Huhu is developed on Apache/mod_perl)</li>
+  <li>A MySQL database</li>
+  <li>A mail box accessible through POP3 or procmail</li>
+  <li>NNTP access to a news server that allows to set the header "Approved:"</li>
+</ul>
+
+<h3>Features</h3>
+<ul>
+  <li>Spam filtering with <tt>Mail::SpamAssassin</tt>.</li>
+  <li>Articles can be signed with a PGP key, using <tt>News::Article::sign_pgpmoose</tt>.</li>
+  <li>Submissions can be moderated automatically through procmail rules.</li>
+  <li>An IRC bot that notifies an IRC channel about pending submissions.</li>
+  <li>Multiple instances of Huhu can be run with a single installation.</li>
+</ul>
+
+<h3>Missing features</h3>
+<ul>
+  <li>Documentation. (Harald M&auml;dl has written a
+<a href="http://usenet-moderation.net/moderation_software_huhu.htm"
+>German user's manual</a>, though.)</li>
+  <li>UNICODE. (Huhu currently uses ISO-8859-1 throughout.)</li>
+  <li>Web based installation. (Currently there is only <tt>sbin/create-procmail-user.sh</tt>).</li>
+</ul>
+
+<h3>Licence</h3>
+<p>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.</p>
+
+<h3>Availability</h3>
+<p>The code is stored in a <a href="http://subversion.tigris.org/">subversion</a>
+repository.</p>
+
+<dl>
+  <dt>Anonymous read-only access</dt>
+  <!-- svn://albasani.net/huhu/trunk/ -->
+  <dd><a href="svn://svn.schnuerpel.eu/huhu/trunk/"
+  >svn://svn.schnuerpel.eu/huhu/trunk/</a></dd>
+
+  <dt>Web based revision browser</dt>
+  <!-- http://albasani.net/viewvc.cgi/?root=huhu -->
+  <dd><a href="http://svn.schnuerpel.eu/viewvc.cgi/?root=huhu"
+  >http://svn.schnuerpel.eu/viewvc.cgi/?root=huhu</a></dd>
+
+  <dt>Project home page</dt>
+  <!-- http://albasani.net/huhu/ -->
+  <dd><a href="http://huhu.albasani.net/">http://huhu.albasani.net/</a></dd>
+</dl>
+
+<h3>History</h3>
+<p>Roman Racine developed Huhu in 2007 to moderate de.soc.familie.vaeter.<br>
+In 2009 he adapted it to easily run multiple instances.<br>
+In autumn 2009 Alexander Bartolich took over development, adding support for CSS, multiple languages, and procmail.</p>
+
+</div></body></html>

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

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

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.

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"

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}"

etc/skel/.forward

@@ -0,0 +1,4 @@
+#
+# Save this file as $HOME/.forward to enable $HOME/.procmailrc
+#
+"|exec /usr/bin/procmail"

etc/skel/.my.cnf

@@ -0,0 +1,3 @@
+[client]
+user=@MYSQL_USERNAME@
+password=@MYSQL_PASSWORD@

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

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"

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"/*

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"

etc/skel/etc/htdigest.sh

@@ -0,0 +1,2 @@
+#!/bin/sh
+htdigest "@USER_HOME@/etc/htdigest" "@USER_NAME@" "$@"

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@

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

etc/skel/etc/samples/apache-digest.conf

@@ -0,0 +1,11 @@
+<Directory "@HUHU_WWW_BASE_DIR@/@WWW_DIR@">
+    SetEnv HUHU_PUB_CONFIG	"@USER_HOME@/etc/public.conf"
+    SetEnv mysql_password	"@MYSQL_PASSWORD@"
+    <Files "modtable.pl">
+	AuthType Digest
+	AuthName "@USER_NAME@"
+	AuthDigestProvider file
+	AuthUserFile "@USER_HOME@/etc/htdigest"
+	Require valid-user
+    </Files>
+</Directory>

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

etc/skel/etc/samples/huhu-directory.html

@@ -0,0 +1,17 @@
+<table class="huhuPostList">
+<tr>
+  <th>Group</th>
+  <th>Language</th>
+  <th colspan="2">Web Interface</th>
+  <th>Statistics</th>
+  <th>Established</th>
+</tr>
+<tr>
+  <td>@MODERATED_GROUP@</td>
+  <td>en-us</td>
+  <td><a href="@HUHU_WWW_BASE_URL@/@WWW_DIR@/public.pl">public</a></td>
+  <td><a href="@HUHU_WWW_BASE_URL@/@WWW_DIR@/modtable.pl">private</a></td>
+  <td><a href="@HUHU_WWW_BASE_URL@/@WWW_DIR@/stats/stats.txt">reaction time</a></td>
+  <td>@TODAY@</td>
+</tr>
+</table>

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 <moderators-request@isc.org>.
+
+== Web Interface ==
+
+The web interface consists of two parts. The public part is accessible
+to everybody. It just displays the approved posts.
+
+   @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.

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

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();

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
+);

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;

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;

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');
+

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;

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;
+

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

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();

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"
+  )
+}

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

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 <moderated_group>"
+  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"