chiark / gitweb /
debugging for thing that crashed
[innduct.git] / control / modules / rmgroup.pl
1 ##  $Id: rmgroup.pl 7743 2008-04-06 10:04:43Z iulius $
2 ##
3 ##  rmgroup 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_rmgroup {
21     my ($par, $sender, $replyto, $site, $action, $log, $approved,
22         $headers, $body) = @_;
23     my ($groupname) = @$par;
24
25     # Scan active to see what sort of change we are making.
26     open(ACTIVE, $inn::active) or logdie("Cannot open $inn::active: $!");
27     my @oldgroup;
28     while (<ACTIVE>) {
29         next unless /^(\Q$groupname\E)\s\d+\s\d+\s(\w)/;
30         @oldgroup = split /\s+/;
31         last;
32     }
33     close ACTIVE;
34     my $status;
35     if (not @oldgroup) {
36         $status = 'no change';
37     } elsif (not $approved) {
38         $status = 'unapproved';
39     } else {
40         $status = 'removed';
41     }
42
43     if ($action eq 'mail' and $status !~ /(no change|unapproved)/) {
44         my $mail = sendmail("rmgroup $groupname $sender");
45         print $mail <<END;
46 $sender asks for $groupname
47 to be $status.
48
49 If this is acceptable, type:
50   $inn::newsbin/ctlinnd rmgroup $groupname
51
52 And do not forget to remove the corresponding description, if any,
53 from your newsgroups file.
54
55 The control message follows:
56
57 END
58         print $mail map { s/^~/~~/; "$_\n" } @$headers;
59         print $mail "\n";
60         print $mail map { s/^~/~~/; "$_\n" } @$body;
61         close $mail or logdie("Cannot send mail: $!");
62     } elsif ($action eq 'log') {
63         if ($log) {
64             logger($log, "skipping rmgroup $groupname"
65                 . " $sender (would be $status)", $headers, $body);
66         } else {
67             logmsg("skipping rmgroup $groupname $sender (would be $status)");
68         }
69     } elsif ($action eq 'doit' and $status !~ /(no change|unapproved)/) {
70         ctlinnd('rmgroup', $groupname);
71         # Update newsgroups too.
72         shlock("$inn::locks/LOCK.newsgroups");
73         open(NEWSGROUPS, $inn::newsgroups)
74             or logdie("Cannot open $inn::newsgroups: $!");
75         my $tempfile = "$inn::newsgroups.$$";
76         open(TEMPFILE, ">$tempfile") or logdie("Cannot open $tempfile: $!");
77         while (<NEWSGROUPS>) {
78             print TEMPFILE $_ if not /^\Q$groupname\E\s/;
79         }
80         close TEMPFILE;
81         close NEWSGROUPS;
82         rename($tempfile, $inn::newsgroups)
83             or logdie("Cannot rename $tempfile: $!");
84         unlink "$inn::locks/LOCK.newsgroups";
85         unlink $tempfile;
86
87         logger($log, "rmgroup $groupname $status $sender", $headers, $body)
88             if $log;
89     }
90 }
91
92 1;