chiark / gitweb /
Add __oop-read-copy.c
[inn-innduct.git] / backends / news2mail.in
1 #! /usr/bin/perl
2 # fixscript will replace this line with require innshellvars.pl
3
4 # news to mail channel backend
5 #
6 # INN gives us
7 #       @token@ addrs
8 # for each article that needs to be mailed.  We invoke sm on the
9 # localhost to get the actual article and stuff
10 # it down sendmail's throat.
11
12 # This program expect to find a file that maps listname to listaddrs,
13 #       @prefix@/etc/news2mail.cf
14 # which must contain address mapping pairs such as
15 #
16 #       big-red-ants@ucsd.edu   big-red-ants-digest@ucsd.edu            
17 #
18 # where the first token is the name fed to us from INN, and which is
19 # also placed in the To: header of the outgoing mail.  It's probably
20 # the subscriber's list submittal address so that replies go to the
21 # right place.  The second token is the actual address sendmail ships
22 # the article to.
23 #
24 # In the INN newsfeeds file, you need to have a channel feed:
25 #       n2m!:!*:Tc,Ac,Wn*:@prefix@/bin/news2mail
26 # and a site for each of the various mailing lists you're feeding,
27 # such as
28 #       big-red-ants@ucsd.edu:rec.pets.redants.*:Tm:n2m!
29 #
30 # Error handling is nearly nonexistent.
31 #
32 #       - Brian Kantor, UCSD Aug 1998
33
34 require 5.006;
35
36 use FileHandle;
37 use Sys::Syslog;
38 use strict;
39
40 my $cfFile = $inn::pathetc . "/news2mail.cf" ;
41 my $sendmail = $inn::mta ;
42 my $sm = $inn::pathbin . "/sm" ;
43 my %maddr = ();
44
45 #
46 # the syslog calls are here but don't work on my system
47 #
48 openlog('news2mail', 'pid', 'mail');
49
50 syslog('info', 'begin');
51
52 #
53 # load the list names and their mail addresses from cf file
54 # #comments and blank lines are ignored
55 #
56 unless (open CF, "< $cfFile") {
57                 syslog('notice', 'CF open failed %m');
58                 die "bad CF";
59                 }
60
61 while ( <CF> ) {
62         next if /^#|^\s+$/;
63         my ( $ln, $ma ) = split /\s+/;
64         $maddr{ $ln } = $ma;
65         }
66 close CF;
67
68 #
69 # for each incoming line from the INN channel
70 #
71 while ( <STDIN> ) {
72         chomp;
73
74         syslog('info', $_);
75
76         my ($token, $lnames) = split /\s+/, $_, 2;
77         my @addrs = split /\s+/, $lnames;
78
79         my @good = grep {  defined $maddr{$_} } @addrs;
80         my @bad  = grep { !defined $maddr{$_} } @addrs;
81
82         if (! @good) {
83                 syslog('notice', "unknown listname $_");
84                 next;
85                 }
86
87         if (@bad) {
88                 syslog('info', 'skipping unknown lists: ', join(' ', @bad));
89                 }
90         mailto($token, $lnames, @maddr{@good});
91         }
92
93 syslog ("info", "end") ;
94
95 exit 0;
96
97 sub mailto {
98         my($t, $l, @a) = @_ ;
99
100         my $sendmail = $inn::mta ;
101         $sendmail =~ s!\s*%s!! ;
102         my @command = (split (' ', $sendmail), '-ee', '-fnews', '-odq', @a);
103 #       @command[0] = '/usr/local/bin/debug';
104
105         syslog('info', join(' ', @command));
106
107         unless (open(SM, '|-', @command)) {
108                 syslog('notice', join(' ', '|', @command), 'failed!');
109                 die "bad $sendmail";
110                 }
111
112         my $smgr = "$sm -q $t |";
113
114         unless (open(SMGR, $smgr)) {
115             syslog('notice', "$smgr failed!");
116             die "bad $smgr";
117         }
118
119         # header
120         while ( <SMGR> ) {
121                 chomp;
122
123                 # empty line signals end of header
124                 if ( /^$/ ) {
125                         print SM "To: $l\n\n";
126                         last;   
127                         }
128
129                 #
130                 # skip unnecessary headers
131                 #
132                 next if /^NNTP-Posting-Date:/i;
133                 next if /^NNTP-Posting-Host:/i;
134                 next if /^X-Trace:/i;
135                 next if /^Xref:/i;
136                 next if /^Path:/i;
137
138                 #
139                 # convert Newsgroups header into X-Newsgroups
140                 #
141                 s/^Newsgroups:/X-Newsgroups:/i;
142
143                 print SM "$_\n";
144                 }
145
146         # body
147         while ( <SMGR> ) {
148                 print SM $_;
149         }
150
151         close(SMGR);
152         close(SM);
153         }