#!/usr/bin/perl -w
#
# Manually update the newsgroup database.
#
# Copyright 2003, 2006-2009 Russ Allbery <eagle@eyrie.org>
#
# SPDX-License-Identifier: MIT

##############################################################################
# Site configuration
##############################################################################

# Path to the active newsgroup database.
our $ACTIVE = '/srv/control/active.db';

# The log file into which to record actions taken.
our $LOGBASE = '/srv/control/logs/log';
our $LOG;

##############################################################################
# Modules and declarations
##############################################################################

require 5.006;

use strict;
use subs qw(log);

use DB_File ();
use Fcntl qw(LOCK_EX);
use IO::Handle ();
use Net::NNTP ();
use POSIX qw(strftime);

##############################################################################
# Logging
##############################################################################

# Open the log file.
sub openlog {
    $LOG = $LOGBASE . '.' . strftime ('%Y-%m', gmtime);
    open (LOG, ">> $LOG") or die "$0: can't open $LOG: $!\n";
}

# Log a message to the log file.
sub log {
    my $log = $LOGBASE . '.' . strftime ('%Y-%m', gmtime);
    if ($log ne $LOG) {
        close LOG;
	openlog;
    }
    my $date = strftime ('%Y-%m-%d %T', gmtime);
    print LOG "$date [$$] ", @_, " (manual)\n";
    print @_, "\n";
    LOG->flush;
}

##############################################################################
# Actions
##############################################################################

# Add a new newsgroup to the database or update an existing one's mode or
# description.  Takes the newsgroup, the mode, and the description.
sub newgroup {
    my ($group, $mode, $description) = @_;
    my $moderated = ($description =~ /\(Moderated\)$/);
    if (($mode eq 'm' && !$moderated) || ($mode eq 'y' && $moderated)) {
        die "$0: description is inconsistent with group status\n";
    }

    # Update the database.
    my %db;
    open (LOCK, "+> $ACTIVE.lock")
        or die "$0: cannot open $ACTIVE.lock: $!\n";
    flock (LOCK, LOCK_EX) or die "$0: cannot lock $ACTIVE.lock: $!\n";
    tie (%db, 'DB_File', $ACTIVE) or die "$0: cannot tie $ACTIVE: $!\n";
    if (!$db{$group}) {
        log "ACTION: newgroup $group $mode";
    } else {
        my @old = split (' ', $db{$group}, 2);
        if ($old[0] ne $mode) {
            log "ACTION: changegroup $group from $old[0] to $mode";
        } elsif ($old[1] ne $description) {
            log "ACTION: changedesc $group";
        }
    }
    $db{$group} = "$mode $description";
    untie %db;
    close LOCK;
}

# Remove a newsgroup from the database.  Takes the newsgroup name.
sub rmgroup {
    my ($group) = @_;
    my %db;
    open (LOCK, "+> $ACTIVE.lock")
        or die "$0: cannot open $ACTIVE.lock: $!\n";
    flock (LOCK, LOCK_EX) or die "$0: cannot lock $ACTIVE.lock: $!\n";
    tie (%db, 'DB_File', $ACTIVE) or die "$0: cannot tie $ACTIVE: $!\n";
    if ($db{$group}) {
        log "ACTION: rmgroup $group";
        delete $db{$group};
    }
    untie %db;
    close LOCK;
}

# Process a checkgroups.  Takes the prefix affected by the checkgroups and
# reads the actual checkgroups from standard input.
sub checkgroups {
    my ($prefix) = @_;
    $prefix .= '.' unless $prefix =~ /\.$/;
    my $pattern = qr/^\Q$prefix\E/;
    my %checkgroups;

    # First, process the body of the checkgroups and build a hash of valid
    # groups in the hierarchy in the same format as our database.
    local $_;
  LINE:
    while (<STDIN>) {
        next unless /$pattern/;
        my ($group, $desc) = split (' ', $_, 2);
        $desc = 'No description.' unless $desc;
        $desc =~ s/\s+$//;
        next if $desc =~ /[\x00-\x1f]/;
        next unless ($group =~ /^[a-z0-9+_.-]+$/);
        next if ($group =~ /^\.|\.\.|\.$/);
        next if length ($group) > 80;
        my @components = split (/\./, $group);
        for (@components) {
            next LINE if /^\d+$/;
            next LINE if /^(?:all|ctl)$/;
            next LINE if length ($_) > 30;
        }
        my $mode = ($desc =~ /\(Moderated\)$/) ? 'm' : 'y';
        $checkgroups{$group} = "$mode $desc";
    }

    # Now, open the database and take a first pass through all groups for that
    # same hierarchy that are in the database, fixing modes and descriptions
    # and removing any groups that aren't in the new checkgroups.
    my %db;
    open (LOCK, "+> $ACTIVE.lock")
        or die "$0: cannot open $ACTIVE.lock: $!\n";
    flock (LOCK, LOCK_EX) or die "$0: cannot lock $ACTIVE.lock: $!\n";
    tie (%db, 'DB_File', $ACTIVE) or die "$0: cannot tie $ACTIVE: $!\n";
    my ($group, $old);
    while (($group, $old) = each %db) {
        next unless $group =~ /$pattern/;
        if (!$checkgroups{$group}) {
            log "ACTION: rmgroup $group";
            delete $db{$group};
        } elsif ($db{$group} ne $checkgroups{$group}) {
            my @old = split (' ', $old, 2);
            my ($mode, $description) = split (' ', $checkgroups{$group}, 2);
            if ($old[0] ne $mode) {
                log "ACTION: changegroup $group from $old[0] to $mode";
            } elsif ($old[1] ne $description) {
                log "ACTION: changedesc $group";
            }
            $db{$group} = $checkgroups{$group};
        }
    }

    # Now, take a final pass through the checkgroups to add any groups that we
    # were missing.
    for (keys %checkgroups) {
        unless ($db{$_}) {
            my ($mode, $description) = split (' ', $checkgroups{$_}, 2);
            log "ACTION: newgroup $_ $mode";
            $db{$_} = $checkgroups{$_};
        }
    }
    untie %db;
    close LOCK;
}

# Bulk-populate the database with a file in checkgroups format.  This only
# adds groups, never removes or modifies them, and it doesn't log its actions.
# It's intended primarily for bootstrapping the database.  The groups are read
# from standard input.
sub bulkload {
    my %db;
    open (LOCK, "+> $ACTIVE.lock")
        or die "$0: cannot open $ACTIVE.lock: $!\n";
    flock (LOCK, LOCK_EX) or die "$0: cannot lock $ACTIVE.lock: $!\n";
    tie (%db, 'DB_File', $ACTIVE) or die "$0: cannot tie $ACTIVE: $!\n";

    # Walk through the input, filtering out illegal groups and add them to the
    # database.
    local $_;
  LINE:
    while (<STDIN>) {
        my ($group, $desc) = split (' ', $_, 2);
        $desc =~ s/\s+$//;
        $desc =~ s/\t/ /g;
        next if $desc =~ /[\x00-\x1f]/;
        next unless ($group =~ /^[a-z0-9+_.-]+$/);
        next if ($group =~ /^\.|\.\.|\.$/);
        my @components = split (/\./, $group);
        for (@components) {
            next LINE if /^\d+$/;
            next LINE if /^(?:all|ctl)$/;
        }
        my $mode = ($desc =~ /\(Moderated\)$/) ? 'm' : 'y';
        $db{$group} = "$mode $desc" unless $db{$group};
    }
    untie %db;
    close LOCK;
}

# Download an active file from a remote server, filter out any groups that
# don't start with prefix, and generate a checkgroups file from it.
sub download {
    my ($server, $prefix) = @_;
    $prefix .= '.' unless $prefix =~ /\.$/;
    my $pattern = qr/^\Q$prefix\E/;
    my $nntp = Net::NNTP->new ($server)
        or die "$0: cannot connect to $server: $!\n";
    my $groups = $nntp->list;
    unless (defined $groups) {
        die "$0: failed to download list: ", $nntp->message, "\n";
    }
  LINE:
    for my $group (sort keys %$groups) {
        next unless ($group =~ /$pattern/);
        next unless ($group =~ /^[a-z0-9+_.-]+$/);
        next if ($group =~ /^\.|\.\.|\.$/);
        my @components = split (/\./, $group);
        for (@components) {
            next LINE if /^\d+$/;
            next LINE if /^(?:all|ctl)$/;
        }
        my $description = 'No description.';
        if ($$groups{$group}[2] =~ /^m/) {
            $description .= ' (Moderated)';
        }
        print "$group $description\n";
    }
}

##############################################################################
# Main routine
##############################################################################

# Trim extraneous garbage from the path.
my $fullpath = $0;
$0 =~ s%.*/%%;

# Get permissions right.
umask 007;

# Open the log file.
openlog;

# Parse the command line and run the appropriate command.
my ($command, @args) = @ARGV;
if ($command eq 'newgroup') {
    if (@args != 3) {
        die "Usage: update-control newgroup <group> <mode> <description>\n";
    }
    newgroup (@args);
} elsif ($command eq 'rmgroup') {
    if (@args != 1) {
        die "Usage: update-control rmgroup <group>\n";
    }
    rmgroup (@args);
} elsif ($command eq 'checkgroups') {
    if (@args != 1) {
        die "Usage: update-control checkgroups <prefix> < <checkgroups>\n";
    }
    checkgroups (@args);
} elsif ($command eq 'bulkload') {
    if (@args != 0) {
        die "Usage: update-control bulkload < <checkgroups>\n";
    }
    bulkload;
} elsif ($command eq 'download') {
    if (@args != 2) {
        die "Usage: update-control download <server> <prefix>\n";
    }
    download (@args);
} else {
    die "Usage: update-control (newgroup|rmgroup|checkgroups|bulkload)\n";
}

##############################################################################
# Documentation
##############################################################################

=head1 NAME

update-control - Manually update the newsgroup database

=head1 SYNOPSIS

update-control newgroup I<group> I<mode> I<description>

update-control rmgroup I<group>

update-control checkgroups I<prefix> < I<checkgroups>

update-control bulkload < I<checkgroups>

=head1 DESCRIPTION

This program supplements B<process-control>, which handles automatic
processing of control messages, by allowing manual changes to be made to
the same database, locking properly and making the same sorts of log
entries.

newgroup creates a new group with the specified mode (which should be
either C<y> or C<m>) and description (which for moderated groups must end
with C<(Moderated)>).  Note that the description generally contains
whitespace and therefore must be quoted for the shell.  If the newsgroup
already exists in the database, this command can still be used to change
the mode or description of the group.

rmgroup removes the specified group from the database.

checkgroups applies a checkgroups for the given prefix, which should be
the common prefix shared by all of the groups in the checkgroups message.
A period will be appended to I<prefix> and then only groups in the
checkgroups that start with that prefix will be processed.
B<update-control> will expect on standard input a file in checkgroups
format (one line per group in the format group name, whitespace, group
description, where the description ends with C<(Moderated)> if the group
is moderated).  Any discrepancies with the newsgroup database will be
corrected.

bulkload does the same thing as checkgroups except that it doesn't take a
prefix, processes all groups in its input, refuses to remove groups or
change the mode or description of existing groups, and doesn't log.  It's
used for bootstrapping a database from a newsgroups file.

download uses the LIST command to get a list of newsgroups in a particular
hierarchy from a remote server and prints to standard output a checkgroups
file for that hierarchy.  It doesn't attempt to retrieve group
descriptions.

The log messages will also be printed to standard output if any action is
taken.

Please note that to work properly, B<update-control> has to have write
permissions to the database and log files, the same as B<process-control>.

=head1 EXAMPLES

Add the new newsgroup example.test:

    update-control newgroup example.test y 'Testing examples.'

Add the new moderated newsgroup example.moderated:

    update-control newgroup example.moderated m \
        'Moderated examples. (Moderated)'

Remove example.moderated:

    update-control rmgroup example.moderated

Bootstrap the database from a previous newsgroups file:

    update-control bulkload < newsgroups

Apply a checkgroups for the example.* hierarchy:

    % cat | update-control checkgroups example
    example.moderated           Moderated examples. (Moderated)
    example.test                Testing examples.
    <Ctrl-D>

(The % indicates a Unix shell prompt and is not part of the command.  The
Ctrl-D indicates that keypress.  This is an example of someone typing the
checkgroups in to the program; normally, one would instead save just the
body of a checkgroups message in a file and then pipe it into
B<update-control> as in the previous example.)

=head1 FILES

=over 4

=item F</srv/control/active.db>

The database of active groups, updated as described above.  It is locked
against simultaneous access by using fcntl locking on a file by the same
name but with C<.lock> appended.

=item F</srv/control/logs/log.%Y-%m>

Where actions are logged.  %Y is replaced by the current four-digit year
and %m by the current two digit month.

=back

=head1 AUTHOR

Russ Allbery <eagle@eyrie.org>

=head1 SEE ALSO

process-control(1)

This script is part of the control-archive package.  The control-archive web
page at L<https://www.eyrie.org/~eagle/software/control-archive/> will have
the current version of the package.

=cut
