Article 6025 of alt.sources:
Newsgroups: alt.sources,de.admin.news.software,ka.comp.linux
Path: jac.zko.dec.com!nntpd.lkg.dec.com!lead.zk3.dec.com!crl.dec.com!crl.dec.com!bloom-beacon.mit.edu!news.kei.com!news.mathworks.com!europa.chnt.gtegsc.com!howland.reston.ans.net!xlink.net!xlink100!snert!rz.uni-karlsruhe.de!inka.de!bigred.inka.de!not-for-mail
From: Olaf Titz <olaf@bigred.inka.de>
Subject: inews-xt - a faster inews replacement for C News
Date: 23 Jun 1995 11:18:11 GMT
Keywords: cnews
Message-ID: <VN91BCOH@bigred.inka.de>
Followup-To: alt.sources.d,news.software.b,de.admin.news.software
Lines: 551
Organization: private Linux site, southern Germany

Archive-Name: inews-xt
Submitted-By: Olaf Titz <olaf@inka.de>
Environment: cnews, perl, unix

This is a complete rewrite in perl of the "inews" script supplied with
older versions of C News (as of Summer 1993, or C News XT). It is much
faster and can do MIME encoding. The script is self-contained, it
doesn't need the auxiliary stuff in bin/inject. Some options have to
be set at the top of the script before running.

This is the result of a weekend's worth of hacking, surely it's not
perfect but it works for me now. Tell me if you find bugs. (I'm
especially unsure about the proper format of the mailpaths file...)

olaf@inka.de



#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  inews
# Wrapped by olaf@bigred.inka.de on Fri Jun 23 13:17:47 1995
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'inews' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'inews'\"
else
echo shar: Extracting \"'inews'\" \(15217 characters\)
sed "s/^X//" >'inews' <<'END_OF_FILE'
X#!/usr/bin/perl
X#                                                                  -*- perl -*-
X
X# A rewrite of the ugly old C News inews (as of Jul.23, 1993 or C News XT 1.3)
X# Fast and MIME conformant.
X# Written by Olaf Titz <olaf@inka.de>, Jun 95. Public domain.
X# $Id: inews,v 1.5 1995/06/23 11:16:06 olaf Exp $
X
X# This is supposed to work like the original, except for the following
X# additional features:
X# - Adds MIME headers if article has 8-bit characters.
X# - Encodes quoted-printable if needed.
X# - Encodes headers as of MIME if they have 8-bit characters.
X# - Encodes using "iso2asc" if needed (see below)
X# - Deletes redundant/forbidden distributions.
X# ...and missing features:
X# - The 64k size limit.
X# - Rewriting of obsolete control message syntax (get your readers fixed)
X# - Mailing if group is moderated even with -N.
X# Options like -d and -x may appear only once due to getopts usage.
X
X# -----------------------------------------------------------------------------
X# Configurable options. Tailor this!
X
X$Charset = "iso-8859-1";
X$Encoding = "8bit"; # or "quoted-printable";
X*MakeID = MakeID_xt; # or _simple, see below
X*MakeAddr = MakeAddr_1; # or _2, see below
X$newsctl = "/var/lib/news";
X$newsbin = "/var/lib/news/bin";
X$newsmaster = "news";
Xumask(0077);
X$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin:$newsbin/relay:$newsbin";
X
X# -----------------------------------------------------------------------------
X$home=$ENV{HOME};
X@Month=("Jan", "Feb", "Mar", "Apr", "May", "Jun",
X	"Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
Xselect STDOUT; $|=1;
Xrequire "getopts.pl";
X&Getopts("pd:ANVWx:hMDt:n:e:F:d:a:f:o:C:");
X
X# inews -p : just feed given files to relaynews
Xif ($opt_p) {
X    $_ = join(" ", @ARGV);
X    exec "cat $_ | relaynews -r";
X}
Xif ($opt_C) { # this is long gone
X    print STDERR "Use addgroup or generate a proper control message!\n";
X    exit 1;
X}
X
X$SIG{HUP}=$SIG{INT}=$SIG{PIPE}=$SIG{TERM}="Signal";
X# Temporary files
X$tmpdir=$ENV{TMPDIR}; $tmpdir="/tmp" unless $tmpdir;
X$tmphdr="$tmpdir/in.$$.hdr";
X$tmpinb="$tmpdir/in.$$.inb";
X$tmpbdy="$tmpdir/in.$$.bdy";
X$tmpres="$tmpdir/in.$$.res";
Xopen(HEAD, ">$tmphdr") || &Bailout("");
X# Touch $tmpbdy for the benefit of dead.article
X# Article is assembled in $tmpinb first and then moved over to $tmpbdy
Xopen(BODY, ">$tmpbdy") || &Bailout("");
Xopen(BODY, ">$tmpinb") || &Bailout("");
Xselect BODY; $|=1; print BODY "\n";
X
X# -----------------------------------------------------------------------------
X# Try and find out the poster's name and host, like "anne.jones" did
Xif (open(F,"<$newsctl/mailname")) {
X    $host=<F>; close F;
X} else {
X    $host=`newshostname`;
X    if ($host=~tr/.//c) { $host.=".UUCP"; }
X}
X$host=~tr/\021-\176//cd;
X$user=$ENV{LOGNAME};
Xif (!$user) {
X  Tty: foreach $i (3,0,1,2) {
X      if (-t $i) {
X	  if ($user=`who am i <&$i`) { last Tty; }
X      }
X  }
X    if (!$user) { $user=`who am i </dev/null`; }
X    if (!$user) { $user="nobody"; } # the last resort
X    $user=~s/\s.*//; $user=~s/[\!]*!//;
X}
X$name=$ENV{NAME};
Xif (!$name) {
X    if (open(F, "<$home/.name")) {
X	$name=<F>; $name=~tr/\021-\176//cd; close F;
X    } else {
X	$name=`grep "^$user:" /etc/passwd || ypmatch "$user" passwd`;
X	split(/:/, $name); $name=$_[4]; $name=~s/,.*$//;
X	# Tailor: for BTL RJE format, use this:
X	# $name=~s/^[^-]*-\s*//; $name=~s/ \(.*$//;
X	# otherwise, Berkeley "&" notation: capitalized login name
X        $name=~s/&/\u$user/;
X    }
X}
Xif ($name=~tr/()<>@,;:\".[]//) {  # rfc822 quoting
X    $name=~s/[\"]/\\$1/g;
X    $name="\"$name\"";
X}
X
X# -----------------------------------------------------------------------------
X# Construct the standard headers.
X@_=gmtime;
X$org=$opt_o ? $opt_o : $ENV{ORGANIZATION};
X$from=&MakeAddr($name, $user, $host);
X%hdr=(
X      "path", "not-for-mail", # yes, this is standard usage by now
X      "from", $from,
X      "message-id", sprintf('<%s@%s>', &MakeID, $host),
X      "date", sprintf('%02d %s %04d %02d:%02d:%02d GMT',
X		      $_[3], $Month[$_[4]], $_[5]+1900, $_[2], $_[1], $_[0]),
X      "organization", $org,
X      );
X@hdr=(control, newsgroups, path, from, subject, message-id, date, sender);
X
Xif ($opt_a) { $hdr{approved} = $opt_a; }
Xif ($opt_c) { $hdr{control} = $opt_c; }
Xif ($opt_d) { $hdr{distribution} = $opt_d; }
Xif ($opt_e) { $hdr{expires} = $opt_e; }
Xif ($opt_f) { $hdr{from} = $opt_f; }
Xif ($opt_n) { $hdr{newsgroups} = $opt_n; }
Xif ($opt_r) { $hdr{reply-to} = $opt_r; }
Xif ($opt_t) { $hdr{subject} = $opt_t; }
Xif ($opt_F) { $hdr{references} = $opt_F; }
X
X# -----------------------------------------------------------------------------
X# Read the input. First see if there are headers (ignore -h anyway)
X$inbody=$lines=$contentlen=$UseMIME=0; $lasthdr="";
XLine: while(<>) {
X    if ($inbody) {
X	tr/\001-\007\013\015-\037//d; # no dirty tricks here
X	if (($inbody==1) && (tr/ \010\012//c)) { $inbody=2; }
X	# Ignore blank lines, including lines consisting entirely
X	# of whitespace, at start of body.
X	if ($inbody>1) {
X	    print BODY; ++$lines; $contentlen+=length;
X	    if (tr/\200-\377//) { $UseMIME=1; }
X	}
X    } else {
X	chop;
X	if (/^\s/) {
X	    if ($lasthdr) { # header continuation line
X		s/\s*//; $hdr{$lasthdr}.=$_; next Line;
X	    } else { # first line not a header
X		$inbody=1; $_.="\n"; redo Line;
X	    }
X	}
X	if (/^$/) {
X	    $inbody=1;
X	} elsif (/^([^ :]+):\s+(.*)/) { # Header syntax
X	    $lasthdr=$1; $lasthdr=~tr/A-Z/a-z/; $hdr{$lasthdr}=$2;
X	} else {
X	    if ($lasthdr) { # Non-header lines in header?
X		&Bailout("Header syntax error");
X	    } else { # Article starts with body
X		$inbody=1; $_.="\n"; redo Line;
X	    }
X	}
X    }
X}
X
X# -----------------------------------------------------------------------------
X# Input is done. Do the rest in the background.
Xif (!($opt_N||$opt_W)) {
X    if (fork()>0) {
X	exit 0;
X    }
X}
X
X# Append signature, 4 lines is enough
Xif (open(F, "<$home/.signature")) {
X    print BODY "-- \n"; $siglines=1;
X  Sig: while(<F>) {
X      tr/\001-\007\013\015-\037//d; 
X      print BODY;
X      if (tr/\200-\377//) { $UseMIME=1; }
X      if (++$siglines>4) { last Sig; }
X  }
X    close F; $lines+=$siglines;
X}
Xclose BODY;
X
X# Additional header manipulations...
Xif (!$hdr{organization}) {
X    if (open(F, "<$newsctl/organization")) {
X	$hdr{organization}=<F>; chop $hdr{organization};
X	close F;
X    }
X}
X$hdr{path}=~s/$host\!//g; # for silly readers
Xif ($hdr{from} ne $from) { $hdr{sender}=$from; }
X$hdr{lines}=$lines;
X$hdr{distribution}=~s/^(world)|(de)$//; # Take out forbidden distribs
X$ngs=$hdr{newsgroups}; $subj=$hdr{subject}; # save for later
X
X# -----------------------------------------------------------------------------
X# Output the headers, required standard headers first
Xforeach $i (@hdr) {
X    printf HEAD "%s: %s\n", &canonhdr($i), &mimehdr($hdr{$i}) if ($hdr{$i});
X    delete $hdr{$i};
X}
Xforeach $i (keys %hdr) {
X    printf HEAD "%s: %s\n", &canonhdr($i), &mimehdr($hdr{$i}) if ($hdr{$i});
X}
Xclose HEAD;
X
X# -----------------------------------------------------------------------------
X# Do additional encoding of the body, if required.
X$encoded=0;
Xif ($UseMIME && !$hdr{content-type}) {
X    # encode if this article isn't MIME already, but needs encoding
X    if ($Encoding eq "quoted-printable") {
X	# Quoted-printable encoding
X	open(F, "<$tmpinb") || &Bailout("");
X	open(BODY, ">$tmpbdy") || &Bailout("");
X	while(<F>) {
X	    chop; s/=/=3D/g; s/ $/=20/; s/\t$/=09/;
X	    while( /([^\021-\176])/ ) {
X		$_=sprintf("%s=%02X%s", $`, ord($1), $');
X	    }
X	    while (length>76) {
X		printf BODY "%s=\n", substr($_,0,75);
X		substr($_,0,75)="";
X	    }
X	    print BODY "$_\n";
X	}
X	close F; close BODY; $encoded=1;
X    } else {
X	# Somewhat local hack:
X	# If a program "$newsctl/allow-eight" exist, call it with the headers
X	# and if it returns false, pipe the body thru "iso2asc 2".
X	# Intended purpose: Kill high-order characters in selected groups.
X	if (-x "$newsctl/allow-eight") {
X	    if (system("$newsctl/allow-eight <$tmphdr")>0) {
X		if (!system("iso2asc 2 <$tmpinb >$tmpbdy")) {
X		    $encoded=1; $UseMIME=0; # no MIME headers now
X		}
X	    }
X	}
X    }
X}
Xif (!$encoded) {
X    unlink($tmpbdy);
X    link($tmpinb, $tmpbdy) || &Bailout("");
X}
X
X# -----------------------------------------------------------------------------
X# Output additional headers.
Xif ($UseMIME && (!$hdr{content-type})) {
X    open(HEAD, ">>$tmphdr") || &Bailout;
X    print HEAD "MIME-Version: 1.0
XContent-Type: text/plain; charset=$Charset
XContent-Transfer-Encoding: $Encoding\n";
X    # oops, this is nonstandard: Content-Length: $contentlen
X    close HEAD;
X}
X
X# Check the required headers etc.
X# Do this now that we have the header/body files for saving to dead.article.
Xif (!$ngs) { &Bailout("Required Newsgroups header missing"); }
Xif (!$subj) { &Bailout("Required Subject header missing"); }
Xif (!$contentlen) { &Bailout("Empty article"); }
Xif ($ngs=~/\s/) { &Bailout("warning: whitespace in Newsgroups header"); }
X
X# -----------------------------------------------------------------------------
X# Now determine what to do with the article.
X# Look for the proper newsgroups
X$p=$hdr{control} ? "control" : $ngs;
X$p=~s/([].*+()[])/\\$1/g; $p=~tr/,/|/; # make the newsgroups an egrep pattern
Xopen(F, "egrep -e '^($p) ' $newsctl/active |") ||
X    &Bailout("Can't search the active file");
X# egrep has proven to be faster than doing the search here
X$valid=0;
Xwhile (<F>) {
X    $valid=1;
X    ($i,$x,$y,$f)=split;
X    if ($f=~/^[nx]/) {
X	&Bailout("Posting to $i is not allowed");
X    }
X    if (($f=~/^m/) && (!$hdr{approved}) && (!$mailto)) {
X	# Determine where the moderator is.
X	open(M, "<$newsctl/mailpaths") ||
X	    &Bailout("Can't open the mailpaths file!");
X      Mpath: while(<M>) {
X	  ($p,$m)=split;
X	  # This makes valid mailpaths lines:
X	  # group.name string
X	  # where string may contain at most one %s
X	  # Substring "all" counts as in the sys file, hierarchies
X	  # count as in the sys file
X	  # First match counts, "backbone" matches everything
X	  $p=~s/\.all\./\\..*\\./g; $p=~s/\.all$//;
X	  if (($p eq "backbone") || ($i=~/^$p/)) {
X	      $i=~tr/./-/;
X	      $mailto=sprintf($m, $i);
X	      last Mpath;
X	  }
X      }
X    }
X}
Xclose F;
Xif (!$valid) {
X    &Bailout("No valid newsgroups in $ngs");
X}
X
X# -----------------------------------------------------------------------------
X# Just print it
X# This is incompatible with C News as this won't mail an article to the
X# moderator if -N is given. I think this is more logical.
Xif ($opt_N) {
X    if ($mailto) {
X	print STDOUT "# Would mail article to $mailto\n";
X    }
X    system "cat $tmphdr $tmpbdy";
X    &Cleanup(0);
X}
X
X# -----------------------------------------------------------------------------
X# Mail it to the moderator
Xif ($mailto) {
X    $ret=system("cat $tmphdr $tmpbdy | mail $mailto") >>8;
X    if ($ret) {
X	&Bailout("Mail returned $ret");
X    } else {
X	print STDOUT "inews: Mailing your article to $mailto\n";
X	&Cleanup(0);
X    }
X}
X
X# -----------------------------------------------------------------------------
X# Look if we've got enough space. Wait for it if -A given.
Xif ($opt_A) {
X    $rpt=0;
X    while (`spacefor 1 articles` < 1) {
X	if (++$rpt==5) {
X	    if (open(F, "|mail $newsmaster")) {
X		print F "Subject: Out of disk space\n\n";
X		print F "There is too little space for inews!";
X		close F;
X	    }
X	}
X	sleep 30;
X    }
X} else {
X    if (`spacefor 1 articles` < 1) {
X	&Bailout("Out of disk space while posting");
X    }
X}
X
X# -----------------------------------------------------------------------------
X# Finally, post the article.
X$ropts="-s";
Xif (!$opt_V) { $ropts.=" -i"; }
Xif ($opt_x) { $ropts.=" -x $opt_x"; }
Xif ($opt_d) { $ropts.=" -d $opt_d"; }
X
Xif (open(F, "<$newsctl/server")) {
X    $server=<F>; $server=~tr/\021-\176//cd; close F;
X    $me=`hostname`; $me=~tr/\021-\176//cd;
X    if ($server eq $me) { $server=""; }
X}
Xif ($server) {
X    # Post via rsh on the server machine.
X    open(F, ">$tmpres") || &Bailout("");
X    select F; $|=1;
X    print F "PATH=$ENV{PATH}\nexport PATH\ntmpf=/tmp/irsh\$\$\n";
X    print F "sed -e 's/^-//' >\$tmpf <<!\n";
X    close F;
X    system("cat $tmphdr $tmpbdy | sed -e 's/^/-/' >>$tmpres");
X    open(F, ">>$tmpres") || &Bailout("");
X    print F "!\nrelaynews $ropts <\$tmpf\necho status \$?\nrm -f \$tmpf\n";
X    close F; select STDOUT;
X    open(F, "rsh $server /bin/sh <$tmpres |") ||
X	&Bailout("Can't rsh to $server");
X    while(<F>) {
X	if (/^status (.*)/) { $ret=$1; } else { print STDOUT; }
X    }
X    close F;
X} else {
X    $ret=system("cat $tmphdr $tmpbdy | relaynews $ropts") >>8;
X}
Xif ($ret) { &Bailout("relaynews returned $ret"); }
Xif (!-s "$newsctl/sys") {
X   &Bailout("warning: Article posted but won't be distributed - no sys file"); 
X}
X
X&Cleanup(0);
X
X# -----------------------------------------------------------------------------
X# Subroutines
X
X# --- Canonicalize header string
Xsub canonhdr
X{
X    local($_)=@_;
X    y/A-Z/a-z/; s/^(.)/\u$1/; s/-(.)/-\u$1/g;
X    if ($_ eq "Message-Id") { $_="Message-ID"; }
X    # defhdrs.awk claimed this is the correct spelling
X    return $_;
X}
X
X# --- RFC1522ize header contents
Xsub mimehdr
X{
X    local($_)=@_;
X    if (tr/\021-\176//c) {
X	# $UseMIME=1; the author of rfc1522 explicitly confirms that
X	# a MIME-Version header is unnecessary just for marking an rfc1522
X	# encoded header line!
X	s/=/=3D/g;
X	while( /([^\x20\x21\x23-\x26\x2a\x2b\x2d-\x3e\x40-\x5b\x5d-\x7e])/ ) {
X	    $_=sprintf("%s=%02X%s", $`, ord($1), $');
X	}
X	if (length($_)+length($Charset)>68) {
X	    # Split long fields. This is rather suboptimal and doesn't obey
X	    # the length limit in all cases, but better than nothing...
X	    split;
X	    foreach $i (@_) {
X		if ($i=~tr/=//) {
X		    $i=sprintf("=?%s?q?%s?=", $Charset, $i);
X		}
X	    }
X	    $_=join(" ", @_);
X	    s/\?= =\?$Charset\?q\?/_/go; # Squash adjacent encoded-words
X	    return $_;
X	}
X	s/ /_/g;
X	return sprintf("=?%s?q?%s?=", $Charset, $_);
X    }
X    return $_;
X}
X
X# --- Generate Message-ID string
X
X# Newer C News algorithm (?)
Xsub MakeID_simple
X{
X    return sprintf("%ld.%d", time, $$);
X}
X
X# C News XT algorithm
Xsub MakeID_xt
X{
X    $MakeID_xt="ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890";
X    $nMakeID_xt=length($MakeID_xt);
X    return &pMakeID_xt(int(time-627672773)/60) . &pMakeID_xt($$);
X}
Xsub pMakeID_xt
X{
X    local($n,$_)=@_;
X    do {
X	$_.=substr($MakeID_xt,int($n%$nMakeID_xt),1);
X	$n=int($n/$nMakeID_xt);
X    } while($n);
X    return $_;
X}
X
X# --- Generate address string
X# gives From: Real Name <user@host>
Xsub MakeAddr_1
X{
X    local($n,$u,$h)=@_;
X    return sprintf('%s%s<%s@%s>', &mimehdr($n), $n?" ":"", $u, $h);
X}
X# gives From: user@host (Real Name)
Xsub MakeAddr_2
X{
X    local($n,$u,$h)=@_;
X    if ($n) {
X	return sprintf('%s@%s (%s)', $u, $h, &mimehdr($n));
X    }
X    return sprintf('%s@%s', $u, $h);
X}
X
X# --- Clean-up
Xsub Signal
X{
X    &Bailout("Got SIG$_[0]");
X}
X
Xsub Bailout
X{
X    local($_)=@_;
X    $_="Can't open temporary file" unless $_; # common case
X    print STDERR "inews: $_\n";
X    close HEAD; close BODY;
X    if (system "cat $tmphdr $tmpbdy >> $home/dead.article") {
X	print STDERR "inews: can't write $home/dead.article\n";
X    } else {
X	print STDERR "inews: article in $home/dead.article\n";
X    }
X    &Cleanup(1);
X}
X
Xsub Cleanup
X{
X    unlink $tmphdr,$tmpinb,$tmpbdy,$tmpres;
X    exit $_[0];
X}
X# -----------------------------------------------------------------------------
END_OF_FILE
if test 15217 -ne `wc -c <'inews'`; then
    echo shar: \"'inews'\" unpacked with wrong size!
fi
chmod +x 'inews'
# end of 'inews'
fi
echo shar: End of shell archive.
exit 0
-- 
___        Olaf.Titz@inka.de or @{stud,informatik}.uni-karlsruhe.de       ____
__ o           <URL:http://www.inka.de/~bigred/>     <IRC:praetorius>
__/<_              >> Just as long as the wheels keep on turning round
_)>(_)______________ I will live for the groove 'til the sun goes down << ____


