#!/usr/bin/perl
#
# Copyright (c) 1994-2008 Carnegie Mellon University.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in
#    the documentation and/or other materials provided with the
#    distribution.
#
# 3. The name "Carnegie Mellon University" must not be used to
#    endorse or promote products derived from this software without
#    prior written permission. For permission or any legal
#    details, please contact
#      Carnegie Mellon University
#      Center for Technology Transfer and Enterprise Creation
#      4615 Forbes Avenue
#      Suite 302
#      Pittsburgh, PA  15213
#      (412) 268-7393, fax: (412) 268-7395
#      [email protected]
#
# 4. Redistributions of any form whatsoever must retain the following
#    acknowledgment:
#    "This product includes software developed by Computing Services
#     at Carnegie Mellon University (http://www.cmu.edu/computing/)."
#
# CARNEGIE MELLON UNIVERSITY DISCLAIMS ALL WARRANTIES WITH REGARD TO
# THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS, IN NO EVENT SHALL CARNEGIE MELLON UNIVERSITY BE LIABLE
# FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING
# OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

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