exec perl -x -S $0 ${1+"$@"}
if ($] !~ /^5\..*/) {
foreach (split(/:/, $ENV{PATH})) { exec("$_/perl5", "-x", "-S", $0, @ARGV) if (-x "$_/perl5");
}
die "Your perl is too old; I need perl 5.\n";
}
eval join("\n", <DATA>);
if ($@) { die "$@"; }
__END__
require 5;
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;
}
$wild =~ s/\./\\./g;
$wild =~ s/\?/\./g;
$wild =~ s/\*/\.\*/g;
while ($acl =~ /^\s*([^\s]+)\s+([^\s]+)/) {
$aclhash{$1} = $2;
$acl =~ s/^\s*([^\s]+)\s+([^\s]+)//; # skip this id/rights pair
}
my ($newsprefix, $unixhiersep) = (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)/) {
$unixhiersep = 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;
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) {
$mbox = $newsprefix . "." . $mbox if (defined($newsprefix));
$mbox =~ s^\.^/^g if ($unixhiersep);
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);