#!/usr/bin/perl
# SPDX-License-Identifier: BSD-3-Clause-CMU
# See COPYING file at the root of the distribution for more details.

require 5;

#use strict; # XXX does not compile with strict :(
use warnings;

use Getopt::Long;
use Cyrus::IMAP;
use Cyrus::IMAP::Admin;

$| = 1;

my ($help, $noop, $config, $active, $user, $wild, $part, $acl, $pause) =
    (0, 0, "/etc/imapd.conf", "./active", $ENV{USER}, "*", undef, "", 0);

GetOptions("h|help!" => \$help,
           "n|noop!" => \$noop,
           "C|config=s" => \$config,
           "f|active=s" => \$active,
           "u|user=s" => \$user,
           "w|wild=s" => \$wild,
           "p|part=s" => \$part,
           "a|acl=s" => \$acl,
           "pause=s" => \$pause);

if ($help || !($server = shift)) {
    print "\n";
    print "mknewsgroups [-h] [-n] [-C <config-file>] [-f <active-file>] [-u <user>]\n";
    print "             [-w <wildmats>] [-p <part>] [-a <acls>] <server>\n";
    print "\n";
    print "\t-h  print this help message\n";
    print "\t-n  print the IMAP commands, but don't execute them\n";
    print "\t-C  use the config in <config-file> instead of /etc/imapd.conf\n";
    print "\t-f  use the newsgroups in <active-file> instead of ./active\n";
    print "\t    (get current file from ftp://ftp.isc.org/usenet/CONFIG/active)\n";
    print "\t-u  authenticate as <user> instead of the current shell user\n";
    print "\t-w  only create the newsgroups specified by <wildmats>.  <wildmats>\n";
    print "\t    is a comma-separated list of wildmat pattern (eg, \"*,!alt.*\")\n";
    print "\t-p  create the newsgroup mailboxes on partition <part>\n";
    print "\t-a  set <acls> on the newsgroup.  <acls> is a whitespace-separated list\n";
    print "\t    of cyradm-style userid/rights pairs (eg, \"anyone +p  news write\")\n";
    print "\n";
    exit;
}

# convert wildmat to regex
$wild =~ s/\./\\./g;
$wild =~ s/\?/\./g;
$wild =~ s/\*/\.\*/g;

# split acl into a hash of ids and rights
while ($acl =~ /^\s*([^\s]+)\s+([^\s]+)/) {
    $aclhash{$1} = $2;
    $acl =~ s/^\s*([^\s]+)\s+([^\s]+)//;        # skip this id/rights pair
}

my ($newsprefix, $unixhierarchysep) = (undef, 0);

open CONF, $config or die "can't open $config";
print "reading configure file...\n";
while (<CONF>) {
    if (/^#/) {
        next;
    }
    if (/^newsprefix:\s+(.*)$/) {
        $newsprefix = $1;
        print "you are using \"$newsprefix\" as your news prefix.\n";
    }
    if (/^unixhierarchysep:\s+(1|t|yes|on)/) {
        $unixhierarchysep = 1;
        print "i will deal with unix hierarchy separator.\n";
    }
}
print "done\n";
close CONF;

my $client;

if (!$noop) {
    print "connecting... ";
    $client = Cyrus::IMAP::Admin->new($server);
    print "authenticating... ";
    $client->authenticate(-user => $user);
    print "done\n";
}

open (INPUT,"<$active");
while( <INPUT> )
{
    chop;
    my $g;

    if (/((\w|\.|\-|\+)+)\s+(.*)/) {
        $mbox = $1;

        # compare group to each part of wildmat
        my $match = 0;
        foreach my $w (split(/,/, $wild)) {
            my $not = substr($w, 0, 1) eq "!";
            $w = substr($w, 1) if ($not);
            $match = !$not if ($mbox =~ /^$w$/);
        }

        if ($match) {
            # add newsprefix if necessary
            $mbox = $newsprefix . "." . $mbox if (defined($newsprefix));

            # switch to unixhierarchysep if necessary
            $mbox =~ s^\.^/^g if ($unixhierarchysep);

            if ($noop) {
                $part = "" if (!defined($part));
                print "C01 CREATE \"$mbox\" $part\n";
                my $n = 1;
                while (($id,$rights) = each(%aclhash)) {
                    printf "S%02d SETACL \"$mbox\" $id $rights\n", $n++;
                }
            } else {
                $g = 0;
                print "creating $mbox... ";
                if ($client->create($mbox, $part)) {
                    while (($id,$rights) = each(%aclhash)) {
                        $client->setacl($mbox, $id => $rights);
                    }
                    $g = 1;
                }
                print "done\n";
                sleep($pause) if ($g);
            }
        }
    }
}

close(INPUT);
