control/modules/newgroup.pl

   1 ##  $Id: newgroup.pl 7849 2008-05-25 17:11:32Z iulius $
   2 ##
   3 ##  newgroup control message handler.
   4 ##
   5 ##  Copyright 2001 by Marco d'Itri <md@linux.it>
   6 ##
   7 ##  Redistribution and use in source and binary forms, with or without
   8 ##  modification, are permitted provided that the following conditions
   9 ##  are met:
  10 ##
  11 ##   1. Redistributions of source code must retain the above copyright
  12 ##      notice, this list of conditions and the following disclaimer.
  13 ##
  14 ##   2. Redistributions in binary form must reproduce the above copyright
  15 ##      notice, this list of conditions and the following disclaimer in the
  16 ##      documentation and/or other materials provided with the distribution.
  17
  18 use strict;
  19
  20 sub control_newgroup {
  21     my ($par, $sender, $replyto, $site, $action, $log, $approved,
  22         $headers, $body) = @_;
  23     my ($groupname, $modflag) = @$par;
  24
  25     $modflag ||= '';
  26     my $modcmd = $modflag eq 'moderated' ? 'm' : 'y';
  27
  28     my $errmsg;
  29     $errmsg= local_checkgroupname($groupname) if defined &local_checkgroupname;
  30     if ($errmsg) {
  31         $errmsg = checkgroupname($groupname) if $errmsg eq 'DONE';
  32
  33         if ($log) {
  34             logger($log, "skipping newgroup ($errmsg)", $headers, $body);
  35         } else {
  36             logmsg("skipping newgroup ($errmsg)");
  37         }
  38         return;
  39     }
  40
  41     # Scan active to see what sort of change we are making.
  42     open(ACTIVE, $inn::active) or logdie("Cannot open $inn::active: $!");
  43     my @oldgroup;
  44     while (<ACTIVE>) {
  45         next unless /^(\Q$groupname\E)\s\d+\s\d+\s(\w)/;
  46         @oldgroup = split /\s+/;
  47         last;
  48     }
  49     close ACTIVE;
  50
  51     my $status;
  52     my $ngdesc = 'No description.';
  53     my $olddesc = '';
  54     my $ngname = $groupname;
  55
  56     # If there is a tag line, search whether the description has changed.
  57     my $found = 0;
  58     my $ngline = '';
  59     foreach (@$body) {
  60         if ($found) {
  61             # It is the line which contains the description.
  62             $ngline = $_;
  63             last;
  64         }
  65         $found = 1 if $_ =~ /^For your newsgroups file:\s*$/;
  66     }
  67
  68     if ($found) {
  69       ($ngname, $ngdesc) = split(/\s+/, $ngline, 2);
  70       if ($ngdesc) {
  71           $ngdesc =~ s/\s+$//;
  72           $ngdesc =~ s/\s+\(moderated\)\s*$//i;
  73           $ngdesc .= ' (Moderated)' if $modflag eq 'moderated';
  74       }
  75       # Scan newsgroups to see the previous description, if any.
  76       open(NEWSGROUPS, $inn::newsgroups)
  77           or logdie("Cannot open $inn::newsgroups: $!");
  78       while (<NEWSGROUPS>) {
  79           if (/^\Q$groupname\E\s+(.*)/) {
  80               $olddesc = $1;
  81               last;
  82           }
  83       }
  84       close NEWSGROUPS;
  85     }
  86
  87     if (@oldgroup) {
  88         if ($oldgroup[3] eq 'm' and $modflag ne 'moderated') {
  89             $status = 'be made unmoderated';
  90         } elsif ($oldgroup[3] ne 'm' and $modflag eq 'moderated') {
  91             $status = 'be made moderated';
  92         } else {
  93             if ($ngdesc eq $olddesc) {
  94                 $status = 'no change';
  95             } else {
  96                 $status = 'have a new description';
  97             }
  98         }
  99     } elsif (not $approved) {
 100         $status = 'unapproved';
 101     } else {
 102         $status = 'be created';
 103     }
 104
 105     if ($action eq 'mail' and $status !~ /(no change|unapproved)/) {
 106         my $mail = sendmail("newgroup $groupname $modcmd $sender");
 107         print $mail <<END;
 108 $sender asks for $groupname
 109 to $status.
 110
 111 If this is acceptable, type:
 112   $inn::newsbin/ctlinnd newgroup $groupname $modcmd $sender
 113
 114 And do not forget to update the corresponding description in your
 115 newsgroups file.
 116
 117 The control message follows:
 118
 119 END
 120         print $mail map { s/^~/~~/; "$_\n" } @$headers;
 121         print $mail "\n";
 122         print $mail map { s/^~/~~/; "$_\n" } @$body;
 123         close $mail or logdie("Cannot send mail: $!");
 124     } elsif ($action eq 'log') {
 125         if ($log) {
 126             logger($log, "skipping newgroup $groupname $modcmd"
 127                 . " $sender (would $status)", $headers, $body);
 128         } else {
 129             logmsg("skipping newgroup $groupname $modcmd $sender"
 130                 . " (would $status)");
 131         }
 132     } elsif ($action eq 'doit' and $status ne 'unapproved') {
 133         if ($status ne 'no change') {
 134             # The status 'be made (un)moderated' prevails over
 135             # 'have a new description' so it is executed.
 136             ctlinnd('newgroup', $groupname, $modcmd, $sender)
 137                 if $status ne 'have a new description';
 138             # We know the description has changed.
 139             update_desc($ngname, $ngdesc) if $ngdesc and $ngname eq $groupname;
 140         }
 141
 142         if ($log) {
 143             logger($log, "newgroup $groupname $modcmd $status $sender",
 144                    $headers, $body) if ($log ne 'mail' or $status ne 'no change');
 145         }
 146     }
 147     return;
 148 }
 149
 150 sub update_desc {
 151     my ($name, $desc) = @_;
 152     shlock("$inn::locks/LOCK.newsgroups");
 153     my $tempfile = "$inn::newsgroups.$$";
 154     open(NEWSGROUPS, $inn::newsgroups)
 155         or logdie("Cannot open $inn::newsgroups: $!");
 156     open(TEMPFILE, ">$tempfile") or logdie("Cannot open $tempfile: $!");
 157     while (<NEWSGROUPS>) {
 158         next if (/^\Q$name\E\s+(.*)/);
 159         print TEMPFILE $_;
 160     }
 161     # We now write a pretty line for the description.
 162     if (length $name < 8) {
 163         print TEMPFILE "$name\t\t\t$desc\n";
 164     } elsif (length $name < 16) {
 165         print TEMPFILE "$name\t\t$desc\n";
 166     } else {
 167         print TEMPFILE "$name\t$desc\n";
 168     }
 169     close TEMPFILE;
 170     close NEWSGROUPS;
 171     rename($tempfile, $inn::newsgroups)
 172         or logdie("Cannot rename $tempfile: $!");
 173     unlink("$inn::locks/LOCK.newsgroups", $tempfile);
 174 }
 175
 176 # Check the group name.  This is partially derived from C News.
 177 # Some checks are commented out if I think they're too strict or
 178 # language-dependent.  Your mileage may vary.
 179 sub checkgroupname {
 180     local $_ = shift;
 181
 182     # whole-name checking
 183     return 'Empty group name' if /^$/;
 184     return 'Whitespace in group name' if /\s/;
 185     return 'Unsafe group name' if /[\`\/:;]/;
 186     return 'Bad dots in group name' if /^\./ or /\.$/ or /\.\./;
 187 #    return 'Group name does not begin/end with alphanumeric'
 188 #        if (/^[a-zA-Z0-9].+[a-zA-Z0-9]$/;
 189     return 'Group name begins in control., junk. or to.' if /^(?:control|junk|to)\./;
 190 #    return 'Group name too long' if length $_ > 128;
 191
 192     my @components = split(/\./);
 193     # prevent alt.a.b.c.d.e.f.g.w.x.y.z...
 194     return 'Too many components' if $#components > 9;
 195
 196     # per-component checking
 197     for (my $i = 0; $i <= $#components; $i++) {
 198         local $_ = $components[$i];
 199         return 'all-numeric name component' if /^[0-9]+$/;
 200 #        return 'name component starts with non-alphanumeric' if /^[a-zA-Z0-9]/;
 201 #        return 'name component does not contain letter' if not /[a-zA-Z]/;
 202         return "`all' or `ctl' used as name component" if /^(?:all|ctl)$/;
 203 #        return 'name component longer than 30 characters' if length $_ > 30;
 204 #        return 'uppercase letter(s) in name' if /[A-Z]/;
 205         return 'illegal character(s) in name' if /[^a-z0-9+_\-.]/;
 206         # sigh, c++ etc must be allowed
 207         return 'repeated punctuation in name' if /--|__|\+\+./;
 208 #        return 'repeated component(s) in name' if ($i + 2 <= $#components
 209 #            and $_ eq $components[$i + 1] and $_ eq $components[$i + 2]);
 210     }
 211     return '';
 212 }
 213
 214 1;