chiark / gitweb /
testing-blockages: Script from Anthony Towns to print a brief analysis of
[bin.git] / m2n.pl
1 #! /usr/bin/perl -w
2
3 =head1 NAME
4
5 m2n - a mail2news(1) replacement
6
7 =head1 SYNOPSIS
8
9 m2n.pl [I<options>]
10
11 =head1 DESCRIPTION
12
13 A replacement for I<mail2news> from the newsgate package. Uses I<rnews> instead
14 of I<inews> by default, and is much less insistent on removing useful headers.
15
16 =head1 OPTIONS
17
18 Long option names may be abbreviated to uniqueness.
19
20 =over 8
21
22 =item B<--stdout>
23
24 Send output to standard output rather than directly to I<rnews>.
25
26 =item B<-a>, B<--approved>=I<approved>
27
28 Approved: line, if none is specified.
29
30 =item B<-d>, B<--distribution>=I<distribution>
31
32 Distribution: line, if none is specified.
33
34 =item B<-n>, B<--newsgroups>=I<newsgroups>
35
36 Newsgroups: line, overriding any such provided. Newsgroups: lines in the input
37 will be saved in X-Mail2News-Newsgroups: lines.
38
39 =item B<-o>, B<--organization>=I<organization>
40
41 Organization: line, if none is specified.
42
43 =item B<-s>, B<--subject>=I<subject>
44
45 Subject: line, if none is specified; the default is "no subject".
46
47 =item B<-x>, B<--path>=I<path>
48
49 Path: prefix, if none is specified; the default is "gateway".
50
51 =back
52
53 =head1 ERROR REPORTING
54
55 Errors will be logged using syslog(3).
56
57 =head1 SEE ALSO
58
59 mail2news(1).
60
61 =head1 AUTHOR
62
63 I<m2n> and this manual page were written by Colin Watson
64 E<lt>cjwatson@flatline.org.ukE<gt>.
65
66 =cut
67
68 use strict;
69
70 use Date::Format;
71 use Digest::MD5 qw(md5_base64);
72 use Getopt::Long;
73 use Sys::Syslog qw(:DEFAULT setlogsock);
74
75 $ENV{PATH} = '/usr/bin:/bin';
76
77 # Use syslog(3) for error output.
78
79 setlogsock 'unix';
80 openlog 'mail2news', 'pid', 'news';
81
82 sub syslogdie(@)
83 {
84     syslog 'err', @_;
85     closelog;
86     exit;
87 }
88
89 # Option processing.
90
91 my $tostdout = 0;
92 my ($approved, $distribution, $newsgroups, $organization);
93 my $subject = 'no subject';
94 my $path = 'gateway';
95
96 Getopt::Long::Configure qw(bundling bundling_override);
97 GetOptions(
98     "stdout" => \$tostdout,
99     "approved|a=s" => \$approved,
100     "distribution|d=s" => \$distribution,
101     "newsgroups|n=s" => \$newsgroups,
102     "organization|o=s" => \$organization,
103     "subject|s=s" => \$subject,
104     "path|x=s" => \$path);
105
106 # Read headers.
107
108 my $headerblock = '';
109 my $extra = '';
110 my %headers = ();
111 my ($hname, $hvalue);
112 my $overridden = 0;
113
114 while (<>)
115 {
116     if (/^$/)
117     {
118         syslogdie 'No headers found, aborting' unless defined $hname;
119         $headers{lc $hname} = $hvalue;
120         last;
121     }
122     elsif (/From /)
123     {
124         next;
125     }
126     elsif (/^(\s.*)/)
127     {
128         my $line = $1;
129         syslogdie "Continuation line at start of headers: '$line'"
130             unless defined $hvalue;
131         $hvalue .= $line;
132     }
133     elsif (/^(.*?):[ \t](.*)/)
134     {
135         $headers{lc $hname} = $hvalue if defined $hname;
136         $overridden = 0;
137         $hname = $1;
138         $hvalue = $2;
139         if ($hname =~ /newsgroups/i && defined $newsgroups)
140         {
141             $hname = 'X-Mail2News-Newsgroups';
142             $headerblock .= "Newsgroups: $newsgroups\n";
143             $headers{newsgroups} = $newsgroups;
144             $overridden = 1;
145         }
146         elsif ($hname =~ /path/i && defined $path)
147         {
148             $hvalue = "$path!$hvalue";
149         }
150         $_ = "$hname: $hvalue\n";
151     }
152     elsif (/^(.*?):\n/)
153     {
154         $headers{lc $hname} = $hvalue if defined $hname;
155         $overridden = 0;
156         $hname = $1;
157         $hvalue = '';
158         if ($hname =~ /newsgroups/i && defined $newsgroups)
159         {
160             $hname = 'X-Mail2News-Newsgroups';
161             $headerblock .= "Newsgroups: $newsgroups\n";
162             $headers{newsgroups} = $newsgroups;
163             $overridden = 1;
164         }
165         elsif ($hname =~ /path/i && defined $path)
166         {
167             $hvalue = $path;
168         }
169         $_ = "$hname: $hvalue\n";
170     }
171     else
172     {
173         my $line = $_;
174         syslogdie "Invalid header line: '$line'";
175     }
176         
177     if ($overridden)    { $extra .= $_; }
178     else                { $headerblock .= $_; }
179 }
180
181 local $/ = undef;
182 my $body .= <>;
183
184 # Headers from command line
185
186 $extra .= "Approved: $approved\n"
187     if defined $approved                and not defined $headers{approved};
188 $extra .= "Distribution: $distribution\n"
189     if defined $distribution            and not defined $headers{distribution};
190 $extra .= "Newsgroups: $newsgroups\n"
191     if defined $newsgroups              and not defined $headers{newsgroups};
192 $extra .= "Organization: $organization\n"
193     if defined $organization            and not defined $headers{organization};
194 $extra .= "Subject: $subject\n"
195     if defined $subject                 and not defined $headers{subject};
196 $headerblock = "Path: $path\n$headerblock"
197     if defined $path                    and not defined $headers{path};
198
199 # Other required header checks
200
201 syslogdie 'No From: line, aborting'     unless defined $headers{from};
202 $extra .= time2str 'Date: %a, %e %h %Y %T GMT' . "\n", time, 'GMT'
203                                         unless defined $headers{date};
204 $extra .= sprintf "Message-ID: <mail2news.\%x.\%s\@riva.ucam.org>\n",
205             time, md5_base64($body)     unless defined $headers{'message-id'};
206
207 # Output to stdout or rnews.
208
209 if ($tostdout)
210 {
211     print $headerblock, $extra, "\n", $body;
212 }
213 else
214 {
215     $SIG{PIPE} = 'IGNORE';
216     open RNEWS, '| rnews -v 2>/dev/null'    or syslogdie "can't fork: \%m";
217     print RNEWS $headerblock, $extra, "\n", $body
218                                             or syslogdie "can't write: \%m";
219     close RNEWS                             or syslogdie "can't close: \%m";
220 }
221
222 closelog;
223