chiark / gitweb /
get-kernel: Only move 'linux' out of the way if it exists as a symbolic
[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 <cjw44@cam.ac.uk>.
64
65 =cut
66
67 use strict;
68
69 use Date::Format;
70 use Digest::MD5 qw(md5_base64);
71 use Getopt::Long;
72 use Sys::Syslog qw(:DEFAULT setlogsock);
73
74 $ENV{PATH} = '/usr/bin:/bin';
75
76 # Use syslog(3) for error output.
77
78 setlogsock 'unix';
79 openlog 'mail2news', 'pid', 'news';
80
81 sub syslogdie(@)
82 {
83     syslog 'err', @_;
84     closelog;
85     exit;
86 }
87
88 # Option processing.
89
90 my $tostdout = 0;
91 my ($approved, $distribution, $newsgroups, $organization);
92 my $subject = 'no subject';
93 my $path = 'gateway';
94
95 Getopt::Long::Configure qw(bundling bundling_override);
96 GetOptions(
97     "stdout" => \$tostdout,
98     "approved|a=s" => \$approved,
99     "distribution|d=s" => \$distribution,
100     "newsgroups|n=s" => \$newsgroups,
101     "organization|o=s" => \$organization,
102     "subject|s=s" => \$subject,
103     "path|x=s" => \$path);
104
105 # Read headers.
106
107 my $headerblock = '';
108 my $extra = '';
109 my %headers = ();
110 my ($hname, $hvalue);
111 my $overridden = 0;
112
113 while (<>)
114 {
115     if (/^$/)
116     {
117         syslogdie 'No headers found, aborting' unless defined $hname;
118         $headers{lc $hname} = $hvalue;
119         last;
120     }
121     elsif (/From /)
122     {
123         next;
124     }
125     elsif (/^(\s.*)/)
126     {
127         my $line = $1;
128         syslogdie "Continuation line at start of headers: '$line'"
129             unless defined $hvalue;
130         $hvalue .= $line;
131     }
132     elsif (/^(.*?):[ \t](.*)/)
133     {
134         $headers{lc $hname} = $hvalue if defined $hname;
135         $overridden = 0;
136         $hname = $1;
137         $hvalue = $2;
138         if ($hname =~ /newsgroups/i && defined $newsgroups)
139         {
140             $hname = 'X-Mail2News-Newsgroups';
141             $headerblock .= "Newsgroups: $newsgroups\n";
142             $headers{newsgroups} = $newsgroups;
143             $overridden = 1;
144         }
145         elsif ($hname =~ /path/i && defined $path)
146         {
147             $hvalue = "$path!$hvalue";
148         }
149         $_ = "$hname: $hvalue\n";
150     }
151     elsif (/^(.*?):\n/)
152     {
153         $headers{lc $hname} = $hvalue if defined $hname;
154         $overridden = 0;
155         $hname = $1;
156         $hvalue = '';
157         if ($hname =~ /newsgroups/i && defined $newsgroups)
158         {
159             $hname = 'X-Mail2News-Newsgroups';
160             $headerblock .= "Newsgroups: $newsgroups\n";
161             $headers{newsgroups} = $newsgroups;
162             $overridden = 1;
163         }
164         elsif ($hname =~ /path/i && defined $path)
165         {
166             $hvalue = $path;
167         }
168         $_ = "$hname: $hvalue\n";
169     }
170     else
171     {
172         my $line = $_;
173         syslogdie "Invalid header line: '$line'";
174     }
175         
176     if ($overridden)    { $extra .= $_; }
177     else                { $headerblock .= $_; }
178 }
179
180 local $/ = undef;
181 my $body .= <>;
182
183 # Headers from command line
184
185 $extra .= "Approved: $approved\n"
186     if defined $approved                and not defined $headers{approved};
187 $extra .= "Distribution: $distribution\n"
188     if defined $distribution            and not defined $headers{distribution};
189 $extra .= "Newsgroups: $newsgroups\n"
190     if defined $newsgroups              and not defined $headers{newsgroups};
191 $extra .= "Organization: $organization\n"
192     if defined $organization            and not defined $headers{organization};
193 $extra .= "Subject: $subject\n"
194     if defined $subject                 and not defined $headers{subject};
195 $headerblock = "Path: $path\n$headerblock"
196     if defined $path                    and not defined $headers{path};
197
198 # Other required header checks
199
200 syslogdie 'No From: line, aborting'     unless defined $headers{from};
201 $extra .= time2str 'Date: %a, %e %h %Y %T GMT' . "\n", time, 'GMT'
202                                         unless defined $headers{date};
203 $extra .= sprintf "Message-ID: <mail2news.\%x.\%s\@riva.ucam.org>\n",
204             time, md5_base64($body)     unless defined $headers{'message-id'};
205
206 # Output to stdout or rnews.
207
208 if ($tostdout)
209 {
210     print $headerblock, $extra, "\n", $body;
211 }
212 else
213 {
214     $SIG{PIPE} = 'IGNORE';
215     open RNEWS, '| rnews -v 2>/dev/null'    or syslogdie "can't fork: \%m";
216     print RNEWS $headerblock, $extra, "\n", $body
217                                             or syslogdie "can't write: \%m";
218     close RNEWS                             or syslogdie "can't close: \%m";
219 }
220
221 closelog;
222