2 require "/usr/local/news/lib/innshellvars.pl";
4 ## $Id: controlchan.in 7591 2006-11-22 07:20:46Z eagle $
6 ## Channel feed program to route control messages to an appropriate handler.
8 ## Copyright 2001 by Marco d'Itri <md@linux.it>
10 ## Redistribution and use in source and binary forms, with or without
11 ## modification, are permitted provided that the following conditions
14 ## 1. Redistributions of source code must retain the above copyright
15 ## notice, this list of conditions and the following disclaimer.
17 ## 2. Redistributions in binary form must reproduce the above copyright
18 ## notice, this list of conditions and the following disclaimer in the
19 ## documentation and/or other materials provided with the distribution.
21 ## Give this program its own newsfeed. Make sure that you've created
22 ## the newsgroup control.cancel so that you don't have to scan through
23 ## cancels, which this program won't process anyway.
25 ## Make a newsfeeds entry like this:
28 ## :!*,control,control.*,!control.cancel\
30 ## :@prefix@/bin/controlchan
35 delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
38 my ($cachedctl, $curmsgid);
43 # setup logging ###########################################################
44 # do not log to syslog if stderr is connected to a console
46 eval { require INN::Syslog; import INN::Syslog; $use_syslog = 1; };
47 eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1; }
52 eval "sub Sys::Syslog::_PATH_LOG { '/dev/log' }" if $^O eq 'dec_osf';
53 Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf|freebsd|darwin/;
54 openlog('controlchan', 'pid', $inn::syslog_facility);
58 # load modules from the control directory #################################
59 opendir(CTL, $inn::controlprogs)
60 or logdie("Cannot open $inn::controlprogs: $!", 'crit');
61 foreach (readdir CTL) {
62 next if not /^([a-z\.]+\.pl)$/ or not -f "$inn::controlprogs/$_";
63 eval { require "$inn::controlprogs/$1" };
68 logmsg("loaded $inn::controlprogs/$1", 'debug');
72 # main loop ###############################################################
75 my ($token, $sitepath, $msgid) = split(/\s+/, $_);
76 next if not defined $token;
78 $curmsgid = $msgid || '';
80 my $artfh = open_article($token);
81 next if not defined $artfh;
83 # suck in headers and body, normalize the strange ones
84 my (@headers, @body, %hdr);
85 if (not parse_article($artfh, \@headers, \@body, \%hdr)) {
89 close $artfh or logdie('sm died with status ' . ($? >> 8));
91 next if not exists $hdr{control};
93 $curmsgid = $hdr{'message-id'};
94 my $sender = cleanaddr($hdr{sender} || $hdr{from});
95 my $replyto = cleanaddr($hdr{'reply-to'} || $hdr{from});
97 my (@progparams, $progname);
98 if ($hdr{control} =~ /\s/) {
99 $hdr{control} =~ /^(\S+)\s+(.+)?/;
101 @progparams = split(/\s+/, lc $2) if $2;
103 $progname = lc $hdr{control};
106 next if $progname eq 'cancel';
108 if ($progname !~ /^([a-z]+)$/) {
109 logmsg("Naughty control in article $curmsgid ($progname)");
114 # Do we want to process the message? Let's check the permissions.
115 my ($action, $logname, $newsgrouppats) =
116 ctlperm($progname, $sender, $progparams[0],
117 $token, \@headers, \@body);
119 next if $action eq 'drop';
121 if ($action eq '_pgpfail') {
123 if ($progname and $progname eq 'newgroup') {
124 if ($progparams[1] and $progparams[1] eq 'moderated') {
130 logmsg("skipping $progname $type$sender"
131 . "(pgpverify failed) in $curmsgid");
135 # used by checkgroups. Convert from perl regexp to grep regexp.
136 if (local $_ = $newsgrouppats) {
145 # find the appropriate module and call it
146 my $subname = "control_$progname";
147 my $subfind = \&$subname;
148 if (not defined &$subfind) {
150 logger($logname, "Unknown control message by $sender",
153 logmsg("Unknown \"$progname\" control by $sender");
158 my $approved = $hdr{approved} ? 1 : 0;
159 logmsg("$subname, " . join(' ', @progparams)
160 . " $sender $replyto $token, $sitepath, $action"
161 . ($logname ? "=$logname" : '') .", $approved");
163 &$subfind(\@progparams, $sender, $replyto, $sitepath,
164 $action, $logname, $approved, \@headers, \@body);
167 closelog() if $use_syslog;
170 print $inn::most_logs.$inn::syslog_facility.$inn::mta.
171 $inn::newsmaster.$inn::locks; # lint food
173 # misc functions ##########################################################
175 my ($artfh, $headers, $body, $hdr) = @_;
177 my %uniquehdr = map { $_ => 1 } qw(date followup-to from message-id
178 newsgroups path reply-to subject sender);
184 if (/^(\S+):\s+(.+)/) {
186 if (exists $hdr->{$h}) {
187 if (exists $uniquehdr{$h}) {
188 logmsg("Multiple $1 headers in article $curmsgid");
191 $hdr->{$h} .= ' ' . $2;
196 } elsif (/^\s+(.+)/) {
198 $hdr->{$h} .= ' ' . $1;
202 logmsg("Broken headers in article $curmsgid");
206 # article is empty or does not exist
207 return 0 if not @$headers;
209 chop (@$body = <$artfh>);
213 # Strip a mail address, innd-style.
216 s/(\s+)?\(.*\)(\s+)?//g;
218 s/[^-a-zA-Z0-9+_.@%]/_/g; # protect MTA
219 s/^-/_/; # protect MTA
223 # Read and cache control.ctl.
225 my $mtime = (stat($inn::ctlfile))[9];
226 return $cachedctl if $lastctl == $mtime; # mtime has not changed.
230 open(CTLFILE, $inn::ctlfile)
231 or logdie("Cannot open $inn::ctlfile: $!", 'crit');
234 # Not a comment or blank? Convert wildmat to regex
235 next if not /^(\s+)?[^\#]/ or /^$/;
236 if (not /:(?:doit|doifarg|drop|log|mail|verify-.*)(?:=.*)?$/) {
238 logmsg("$_ is not a valid action for control.ctl", 'err');
241 # Convert to a : separated list of regexps
253 logmsg('warning: control.ctl is empty!', 'err') if not @ctllist;
254 return $cachedctl = [ reverse @ctllist ];
257 # Parse a control message's permissions.
259 my ($type, $sender, $newsgroup, $token, $headers, $body) = @_;
261 my $action = 'drop'; # default
262 my ($logname, $hier);
264 # newgroup and rmgroup require newsgroup names; check explicitly for that
265 # here and return drop if the newsgroup is missing (to avoid a bunch of
266 # warnings from undefined values later on in permission checking).
267 if ($type eq 'newgroup' or $type eq 'rmgroup') {
268 unless ($newsgroup) {
269 return ('drop', undef, undef);
273 my $ctllist = readctlfile();
274 foreach (@$ctllist) {
275 my @ctlline = split /:/;
276 # 0: type 1: from@addr 2: group.* 3: action
277 if ($type =~ /$ctlline[0]/ and $sender =~ /$ctlline[1]/i and
278 ($type !~ /(?:new|rm)group/ or $newsgroup =~ /$ctlline[2]/)) {
279 $action = $ctlline[3];
280 $action =~ s/\^(.+)\$/$1/;
282 $hier = $ctlline[2] if $type eq 'checkgroups';
287 ($action, $logname) = split(/=/, $action);
289 if ($action =~ /^verify-(.+)/) {
291 if ($inn::pgpverify and $inn::pgpverify =~ /^(?:true|on|yes)$/i) {
292 my $pgpresult = defined &local_pgpverify ?
293 local_pgpverify($token, $headers, $body) : pgpverify($token);
294 if ($keyowner eq $pgpresult) {
297 $action = '_pgpfail';
304 return ($action, $logname, $hier);
307 # Write stuff to a log or send mail to the news admin.
309 my ($logfile, $message, $headers, $body) = @_;
311 if ($logfile eq 'mail') {
312 my $mail = sendmail($message);
313 print $mail map { s/^~/~~/; "$_\n" } @$headers;
314 print $mail "\n" . join ('', map { s/^~/~~/; "$_\n" } @$body)
316 close $mail or logdie("Cannot send mail: $!");
320 if ($logfile =~ /^([^.\/].*)/) {
323 logmsg("Invalid log file: $logfile", 'err');
324 $logfile = 'control';
327 $logfile = "$inn::most_logs/$logfile.log" unless $logfile =~ /^\//;
328 my $lockfile = $logfile;
329 $lockfile =~ s#.*/##;
330 $lockfile = "$inn::locks/LOCK.$lockfile";
333 open(LOGFILE, ">>$logfile") or logdie("Cannot open $logfile: $!");
334 print LOGFILE "$message\n";
335 foreach (@$headers, '', @$body, '') {
336 print LOGFILE " $_\n";
342 # write to syslog or errlog
344 my ($msg, $lvl) = @_;
346 return if $lvl and $lvl eq 'debug' and not $debug;
348 syslog($lvl || 'notice', '%s', $msg);
350 print STDERR (scalar localtime) . ": $msg\n";
354 # log a message and then die
356 my ($msg, $lvl) = @_;
358 $msg .= " ($curmsgid)" if $curmsgid;
359 logmsg($msg, $lvl || 'err');
363 # wrappers executing external programs ####################################
365 # Open an article appropriately to our storage method (or lack thereof).
369 if ($token =~ /^\@.+\@$/) {
370 my $pid = open(ART, '-|');
371 logdie('Cannot fork: ' . $!) if $pid < 0;
373 exec("$inn::newsbin/sm", '-q', $token) or
374 logdie("Cannot exec sm: $!");
378 return *ART if open(ART, $token);
379 logmsg("Cannot open article $token: $!");
387 if ($token =~ /^\@.+\@$/) {
388 open(PGPCHECK, "$inn::newsbin/sm -q $token "
389 . "| $inn::newsbin/pgpverify |") or goto ERROR;
391 open(PGPCHECK, "$inn::newsbin/pgpverify < $token |") or goto ERROR;
393 my $pgpresult = <PGPCHECK>;
394 close PGPCHECK or goto ERROR;
399 logmsg("pgpverify failed: $!", 'debug');
404 my ($cmd, @args) = @_;
406 my $st = system("$inn::newsbin/ctlinnd", '-s', $cmd, @args);
407 logdie('Cannot run ctlinnd: ' . $!) if $st == -1;
408 logdie('ctlinnd returned status ' . ($st & 255)) if $st > 0;
412 my $lockfile = shift;
415 while ($locktry < 60) {
416 if (system("$inn::newsbin/shlock", '-p', $$, '-f', $lockfile) == 0) {
424 if (open(LOCKFILE, $lockfile)) {
425 $lockreason = 'held by ' . (<LOCKFILE> || '?');
430 logdie("Cannot get lock $lockfile: $lockreason");
434 # If $body is not defined, returns a file handle which must be closed.
435 # Don't forget checking the return value of close().
436 # $addresses may be a scalar or a reference to a list of addresses.
437 # If not defined, $inn::newsmaster is the default.
438 # parts of this code stolen from innmail.pl
440 my ($subject, $addresses, $body) = @_;
441 $addresses = [ $addresses || $inn::newsmaster ] if not ref $addresses;
442 $subject ||= '(no subject)';
444 # fix up all addresses
445 my @addrs = map { s#[^-a-zA-Z0-9+_.@%]##g; $_ } @$addresses;
449 $sm = sprintf($sm, join(' ', @addrs));
451 $sm .= ' ' . join(' ', @addrs);
454 # fork and spawn the MTA whitout using the shell
455 my $pid = open(MTA, '|-');
456 logdie('Cannot fork: ' . $!) if $pid < 0;
458 exec(split(/\s+/, $sm)) or logdie("Cannot exec $sm: $!");
461 print MTA 'To: ' . join(",\n\t", @addrs) . "\nSubject: $subject\n\n";
462 return *MTA if not defined $body;
463 $body = join("\n", @$body) if ref $body eq 'ARRAY';
464 print MTA $body . "\n";
465 close MTA or logdie("Execution of $sm failed: $!");