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