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