#!/usr/local/bin/perl
# newgroup.pl - The newgroup control message.
# Version 0.2, 31-AUG-1998
#  Parameters: params sender reply-to token site action[=log] approved
sub control_newgroup {
    my $SM;
    if (-e "$inn::newsbin/sm") { $SM = "$inn::newsbin/sm -q" }
    else { $SM = "cat" }

    my @params = split(/\s+/,shift);
    my $sender = shift;
    my $replyto = shift;
    my $token = shift;
    my $site = shift;
    my ($action, $logging) = split(/=/, shift);
    my $approved = shift;

    my $groupname = $params[0];
    my $modflag = $params[1];

    my $pid = $$;
    my $tempfile = "$inn::tmpdir/newgroup.$pid";

    my ($errmsg, $status, $nc, @component, @oldgroup, $locktry,
        $ngname, $ngdesc, $modcmd);
    
    $modcmd = "y";
    $modcmd = "m" if ($modflag eq "moderated");

    # Check the group name.  This is partially derived from C News.
    # Some checks are commented out if I think they're too strict or
    # language-dependent.  Your mileage may vary.
    NEWGROUPSANITY:
    for ($groupname) {
        # whole-name checking
        if (/^$/) {
            $errmsg = "Empty group name";
        }
        elsif (/\s/) {
            $errmsg = "Whitespace in group name";
        }
        elsif (/[\`\/:]/) {
            $errmsg = "Unsafe group name";
        }
        elsif (/^\./ || /\.$/ || /\.\./) {
            $errmsg = "Bad dots in group name";
        }
        #elsif (/^[a-zA-Z0-9].+[a-zA-Z0-9]$/) {
        #    $errmsg = "Group name does not begin/end with alphanumeric";
        #}
        elsif (/^(junk|control)\./) {
            $errmsg = "Group name begins in control. or junk.";
        }
        #elsif (length($groupname) > 128) {
        #    $errmsg = "Group name too long";
	#}
        else {
            $errmsg = "";
        }

        if ($errmsg) { last NEWGROUPSANITY }
        
        # per-component checking
        $nc = (@component = split(/\./));
        for ($i = 0; $i <= $nc; $i++) {
            $c = $component[$i];
            if ($c =~ /^[0-9]+$/) {
                $errmsg = 'all-numeric name component';
            }
            #elsif ($c !~ /^[a-zA-Z0-9]/) {# A-Z caught later
            #    $errmsg = 'name component starts with non-alphanumeric';
            #}
            #elsif ($c !~ /[a-zA-Z]/) {# A-Z caught later
            #    $errmsg = 'name component does not contain letter';
            #}
            elsif ($c eq 'all' || $c eq 'ctl') {
                $errmsg = "`all' || `ctl' used as name component";
            }
            #elsif (length($c) > 30) {
            #    $errmsg = 'name component longer than 30 characters';
            #}
            elsif ($c =~ /[A-Z]/) {
                $errmsg = 'uppercase letter(s) in name';
            }
            #elsif ($c =~ /[^a-z0-9+_\-]/) {
            #    $errmsg = 'illegal character(s) in name';
            #}
            elsif ($c =~ /--|__|\+\+./) { # sigh, c++ etc must be allowed
                $errmsg = 'repeated punctuation in name';
            }
            #elsif (($c eq $component[$i + 1]) && ($c eq $component[$i + 2])) {
            #    $errmsg = 'repeated component(s) in name';
            #}
        }

        if ((! $errmsg) && ($nc > 9)) { #prevent alt.a.b.c.d.e.f.g.w.x.y.z...
            $errmsg = "Too many components";
        }        
    }

    if ($errmsg) {print $errmsg,"\n"};

    # Did our group name survive?
    if (! $errmsg) {
        # Scan active to see what sort of change we are making.
        open ACTIVE, $inn::active;
        @oldgroup = grep(/^$groupname\s/, <ACTIVE>);
        @oldgroup = split(/\s+/, $oldgroup[0]);
        #print "newgroup: $oldgroup[0] $oldgroup[1] $oldgroup[2] $oldgroup[3] $modflag\n";
        close ACTIVE;
        if (scalar @oldgroup) {
            if (($oldgroup[3] eq "m") && ($modflag ne "moderated")) {
                $status = "made unmoderated";
            }
            elsif (($oldgroup[3] ne "m") && ($modflag eq "moderated")) {
                $status = "made moderated";
            }
            else {
                $status = "no change";
            }
        }
        elsif (! $approved) {
            $status = "unapproved";
        }
        else {
            $status = "created";
        }

        if ($action eq "mail" && ($status !~ /(no change|unapproved)/)) {
            open(TEMPFILE, ">$tempfile");
            print TEMPFILE ("$sender asks for $groupname\n");
            print TEMPFILE ("to be $status.\n\n");
            print TEMPFILE ("If this is acceptable, type:\n");
            print TEMPFILE ("  $inn::newsbin/ctlinnd newgroup ",
                            "$groupname $modcmd $sender\n\n");
            print TEMPFILE ("The control message follows:\n\n");
            open(ARTICLE, "$SM $token|");
            while (<ARTICLE>) { print TEMPFILE $_ }
            close(ARTICLE);
            close(TEMPFILE);
            logger($tempfile, "mail",
                   "newgroup $groupname $modcmd $sender\n");
            unlink($tempfile);
        }
        elsif ($action eq "log") {
            if (!$logging) {
                print "skipping newgroup $groupname ",
                       "$modcmd $sender (would be $status)\n";
            }
            else {
                logger($token, $logging,
                        "skipping newgroup $groupname " .
                        "$modcmd $sender (would be $status)");
            }
        }
        elsif (($action eq "doit") && ($status !~ /(no change|unapproved)/)) {
            # Create the group.  Meow!
            system("$inn::newsbin/ctlinnd " .
                   "-s newgroup $groupname $modcmd $sender");

            # If there's a tag line, update newsgroups too.
            open(ARTICLE, "$SM $token|");
            NEWSGROUPS:
            while (<ARTICLE>) {
                chomp;
                if (/^For your newsgroups file:$/) {
                    $ngline = (<ARTICLE>);
                    chomp $ngline;
                    last NEWSGROUPS;
                }
            }
            ($ngname, $ngdesc) = split(/\s+/, $ngline, 2);
            if ($ngdesc) {
                $ngdesc =~ s/\s+(moderated)$//i;
                if ($modflag eq "moderated") { $ngdesc .= " (Moderated)" }
            }
            if (($ngdesc) && ($ngname eq $groupname)) {
                # Get a lock on newsgroups
                $locktry = 0;
                GETNGLOCK:
                while ($locktry < 60) {
                    if (system("$inn::newsbin/shlock -p $pid -f " .
                                "$inn::locks/LOCK.newsgroups")) {
                        $locktry++;
                        sleep(2);
                    }
                    else {
                        $locktry = -1;
                        last GETNGLOCK;
                    }
                }

                if ($locktry > -1) {
                    print "Cannot get lock $inn::locks/LOCK.newsgroups";
                }
                else {
                    open(NEWSGROUPS, "<$newsgroups");
                    open(TEMPFILE, ">$tempfile");
                    while (<NEWSGROUPS>) {
                        if (! /$groupname\s/) { print TEMPFILE $_ }
                    }
                    print TEMPFILE ($ngname, "\t", $ngdesc, "\n");

                    open(TEMPFILE, "<$tempfile");
                    open(NEWSGROUPS, ">$newsgroups");
                    while (<TEMPFILE>) { print NEWSGROUPS $_ }
                    close TEMPFILE;
                    close NEWSGROUPS;
                    unlink "$inn::locks/LOCK.newsgroups";
                }
            } # update newsgroups

            # Now, log what we did.
            if ($logging) {
                $errmsg = "newgroup $groupname ";
                if ($modflag eq "moderated") {
                    $errmsg .= "m ";
                }
                else {
                    $errmsg .= "y ";
                }
                $errmsg .=  $status . " " . $sender;
                logger($token, $logging, $errmsg);
            }
        }
    }
}
