1 ## $Id: newgroup.pl 7849 2008-05-25 17:11:32Z iulius $
3 ## newgroup control message handler.
5 ## Copyright 2001 by Marco d'Itri <md@linux.it>
7 ## Redistribution and use in source and binary forms, with or without
8 ## modification, are permitted provided that the following conditions
11 ## 1. Redistributions of source code must retain the above copyright
12 ## notice, this list of conditions and the following disclaimer.
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.
20 sub control_newgroup {
21 my ($par, $sender, $replyto, $site, $action, $log, $approved,
22 $headers, $body) = @_;
23 my ($groupname, $modflag) = @$par;
26 my $modcmd = $modflag eq 'moderated' ? 'm' : 'y';
29 $errmsg= local_checkgroupname($groupname) if defined &local_checkgroupname;
31 $errmsg = checkgroupname($groupname) if $errmsg eq 'DONE';
34 logger($log, "skipping newgroup ($errmsg)", $headers, $body);
36 logmsg("skipping newgroup ($errmsg)");
41 # Scan active to see what sort of change we are making.
42 open(ACTIVE, $inn::active) or logdie("Cannot open $inn::active: $!");
45 next unless /^(\Q$groupname\E)\s\d+\s\d+\s(\w)/;
46 @oldgroup = split /\s+/;
52 my $ngdesc = 'No description.';
54 my $ngname = $groupname;
56 # If there is a tag line, search whether the description has changed.
61 # It is the line which contains the description.
65 $found = 1 if $_ =~ /^For your newsgroups file:\s*$/;
69 ($ngname, $ngdesc) = split(/\s+/, $ngline, 2);
72 $ngdesc =~ s/\s+\(moderated\)\s*$//i;
73 $ngdesc .= ' (Moderated)' if $modflag eq 'moderated';
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+(.*)/) {
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';
93 if ($ngdesc eq $olddesc) {
94 $status = 'no change';
96 $status = 'have a new description';
99 } elsif (not $approved) {
100 $status = 'unapproved';
102 $status = 'be created';
105 if ($action eq 'mail' and $status !~ /(no change|unapproved)/) {
106 my $mail = sendmail("newgroup $groupname $modcmd $sender");
108 $sender asks for $groupname
111 If this is acceptable, type:
112 $inn::newsbin/ctlinnd newgroup $groupname $modcmd $sender
114 And do not forget to update the corresponding description in your
117 The control message follows:
120 print $mail map { s/^~/~~/; "$_\n" } @$headers;
122 print $mail map { s/^~/~~/; "$_\n" } @$body;
123 close $mail or logdie("Cannot send mail: $!");
124 } elsif ($action eq 'log') {
126 logger($log, "skipping newgroup $groupname $modcmd"
127 . " $sender (would $status)", $headers, $body);
129 logmsg("skipping newgroup $groupname $modcmd $sender"
130 . " (would $status)");
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;
143 logger($log, "newgroup $groupname $modcmd $status $sender",
144 $headers, $body) if ($log ne 'mail' or $status ne 'no change');
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+(.*)/);
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";
167 print TEMPFILE "$name\t$desc\n";
171 rename($tempfile, $inn::newsgroups)
172 or logdie("Cannot rename $tempfile: $!");
173 unlink("$inn::locks/LOCK.newsgroups", $tempfile);
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.
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;
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;
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]);