From wiml@hhhh.org Thu Aug 29 10:07:10 EDT 1996
Article: 4835 of alt.sources
Path: news.math.psu.edu!news.iag.net!news.sgi.com!sloc223.cds.sloc.net!news.sprintlink.net!news-chi-13.sprintlink.net!news.accessone.com!news
From: wiml@hhhh.org (W Lewis)
Newsgroups: alt.sources
Subject: makefeeds.pl - automatically generate INN newsfeeds patterns
Date: 28 Aug 1996 23:32:12 -0700
Organization: The Seattle Group
Lines: 419
Sender: wiml@foo.hhhh.org
Message-ID: <wlwwwyilmz7.fsf@foo.hhhh.org>
NNTP-Posting-Host: foo.hhhh.org
X-Newsreader: Gnus v5.1

Archive-name: makefeeds

-----BEGIN PGP SIGNED MESSAGE-----

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	makefeeds.README
#	makefeeds.pl
# This archive created: Wed Aug 28 23:05:23 1996
export PATH; PATH=/bin:$PATH
echo shar: extracting "'makefeeds.README'" '(2399 characters)'
if test -f 'makefeeds.README'
then
	echo shar: will not over-write existing file "'makefeeds.README'"
else
sed 's/^X//' << \SHAR_EOF > 'makefeeds.README'
XWHAT IT DOES:
X
XMakefeeds reads two active files and generates a set of patterns
Xsuitable for inclusion in an INN newsfeeds entry, such that the
Xfeed site sends only those groups that the fed site wants. It attempts
Xto use wildcards to shorten the pattern; as a side effect this should
Xalso help control messages propagate correctly.
X
XMakefeeds is designed to be run on the feed's machine; it reads the
Xfeed's active file from /usr/lib/news/active, and can read the fed
Xsite's active file either from disk, or via NNTP from the fed site
Xitself. Example:
X
Xperl makefeeds.pl -N news.client.site.org
X
Xwill read your active file, and the active file from news.client.site.org,
Xand spit out a newsfeeds entry you can use for your feed to
Xclient.site.org.
X
XYou can also ask it to generate a reverse entry (which you could then
Xmail to your feed's administrator).
X
XREQUIRES:
X
XPerl 5 (it uses references and my(); it probably wouldn't be too hard
Xto refit it to perl 4, since I'm not really using most of the stuff in
Xperl 5.), and sys/socket.ph.
X
XSHORTCOMINGS AND STUFF TO DO:
X
XWhen trying to shorten the feed patterns, makefeeds only does certain
Xsimple kinds of wildcarding. As a result the pattern is probably
Xlonger than it could be. On the other hand, an absolutely minimal
Xpattern would probably be hard for a human to read, whereas the
Xpatterns makefeeds puts out are pretty easy to understand.
X
XMy original goal for makefeeds was a script that could be run from
Xcron, once a week or so, which would read the newsfeeds file, look for
Xspecially marked entries, and automatically update them. I never got
Xaround to that, and I no longer have much of a need for it, but I
Xstill think it's a neat idea.
X
XI'm not entirely sure that makefeeds' pattern generating algorithm is
Xwithout bugs, so you should probably read over the patterns it
Xgenerates before putting them in your newsfeeds entry.
X
XThe only real documentation for what makefeeds can do is the source
Xcode. If you're not comfortable with that, you probably shouldn't be
Xusing it, at least not in this release.
X
XMISCELLANEOUS:
X
XMakefeeds.pl was written by me, Wim Lewis <wiml@hhhh.org>. If you have
Xany feedback on it, especially bugfixes and improvements, please send
Xit to me at that address.
X
XHere are some checksums:
X
Xmd5sum: 0462980f31479eadf62a657cf74a5cf6  makefeeds.pl
Xbrik -G: 1259699542      makefeeds.pl
Xsum: 08819     8 makefeeds.pl
SHAR_EOF
if test 2399 -ne "`wc -c < 'makefeeds.README'`"
then
	echo shar: error transmitting "'makefeeds.README'" '(should have been 2399 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'makefeeds.pl'" '(7675 characters)'
if test -f 'makefeeds.pl'
then
	echo shar: will not over-write existing file "'makefeeds.pl'"
else
sed 's/^X//' << \SHAR_EOF > 'makefeeds.pl'
X#
X# makefeeds.pl --- create or update an INN newsfeeds entry based on
X#                  active files
X#
X# Written by wiml@hhhh.org. Feel free to use this code in any way that
X# makes you happy. However, it would be nice if you:
X#   - sent any bugfixes, improvements, etc. back to me and
X#   - didn't claim you wrote anything you didn't.
X#
X# Release 1, 28th August 1996
X#
X
X%feed = ();
X%feedG = ();
X%fed = ();
X%fedG = ();
X$verbose = 0;
X$rootstem = '';
X
X$defaultFeed = '/usr/lib/news/active';
X$reverseIt = 0;
X@fedSites = ();
X
X$Usage = <<"EOT";
XUsage: $0 [-rRv] [-a active] [-s stem] { filename | -N hostname } ...
X\t-a   Use the named active file instead of $defaultFeed
X\t-r   Reverse the roles of feed and fed sites
X\t-v   Verbose. Two -v's makes it even more verbose.
X
XThe remote (fed) site's active file is read from the supplied
Xfile, or via NNTP from the given host if -N is used.
XEOT
X
X# parse args
X@args = @ARGV;
Xwhile($arg = shift @args) {
X  if($arg eq '-a') {
X    $defaultFeed = shift @args;
X  } elsif($arg eq '-N') {
X    push(@fedSites, '-' . (shift @args));
X  } elsif($arg eq '-r') {
X    $reverseIt = 1;
X  } elsif($arg eq '-R') {
X    $reverseIt = 2;
X  } elsif($arg eq '-s') {
X    $rootstem = shift @args;
X  } elsif($arg eq '-v') {
X    $verbose ++;
X  } elsif($arg =~ /^\-/) {
X    print STDERR "Unknown option $arg\n$Usage\n";
X    exit 1;
X  } else {
X    push(@fedSites, $arg);
X  }
X}
X
X# read our active file into %feed and %feedG
X&readActive(\%feedG, \%feed, $defaultFeed);
X
Xif(!@fedSites) {
X  print STDERR "No fed sites?\n$Usage\n";
X  exit 1;
X}
X
Xforeach $fedSite (@fedSites) {
X  if($fedSite =~ /^\-/) {
X    $hostname = substr($fedSite, 1);
X    &readNNTPActive(\%fedG, \%fed, $hostname);
X  } else {
X    print STDERR "Reading $fedSite ...\n";
X    &readActive(\%fedG, \%fed, $fedSite);
X  }
X
X  print STDERR "Calculating patterns...\n";
X  if($reverseIt != 1) {
X    ($pos, $neg) = &getPats($rootstem);
X    $pos = &wraplines($pos, 65, ',', '        ', "\\\n");
X    print "fwd:\n$pos\n\n";
X  }
X  if($reverseIt != 0) {
X    %tmp = %fed;   %fed  = %feed;   %feed  = %tmp;
X    %tmp = %fedG;  %fedG = %feedG;  %feedG = %tmp;
X
X    ($pos, $neg) = &getPats($rootstem);
X    $pos = &wraplines($pos, 65, ',', '        ', "\\\n");
X    print "rev:\n$pos\n";
X
X    %feedG = %fedG;
X    %feed  = %fed;
X  }
X}
X
Xexit 0;
X
X# this does all the work. Call it with a stem (with leading '.'),
X# and it returns two patterns: one to use if the hierarchy is by
X# default not selected, and one to use if it is selected by default
Xsub getPats
X{
X  my($stem) = @_;
X  my(@feed, @fed, @pos, @neg, $pos, $neg, $subexpr);
X
X  @feed = split(' ', $feed{$stem});
X  @fed = split(' ', $fed{$stem});
X
X  print "$stem 0: [", join(',',@feed), "] [", join(',',@fed), "]\n"
X        if $verbose > 1;
X
X  print "$stem -: [", join(',',grep($feedG{$stem.'.'.$_},@feed)),
X	       "] [", join(',',grep($fedG{$stem.'.'.$_},@fed)), "]\n"
X        if $verbose > 1;
X
X  foreach $part (@feed)
X  {
X    $subexpr = $stem.'.'.$part;
X
X    if($feedG{$subexpr}) { # a group?
X      if($fedG{$subexpr}) {
X        push(@neg, substr($subexpr, 1));
X      } else {
X        push(@pos, '!'.substr($subexpr, 1));
X      }
X    }
X
X    if($feed{$subexpr}) {  # a hierarchy?
X      if(grep($_ eq $part, @fed)) {  # does the fed site want any of it?
X        ($pos, $neg) = &getPats($subexpr);
X	push(@neg, $neg) if $neg ne '';
X        push(@pos, $pos) if $pos ne '';
X      } else {  # fed site wants none of the hierarchy
X        push(@pos, ('!'.substr($subexpr, 1).'.*'));
X      }
X    }
X  }
X
X  $pos = join(',', @pos);
X  $neg = join(',', @neg);
X
X  print "$stem 1: [$pos][$neg]\n" if $verbose > 1;
X
X  # see if we can shorten the expressions
X
X  if((length($neg) + length($stem) + 2) < length($pos)) {
X    $pos = '!'.substr($stem, 1).'.*'.(length($neg)?',':'').$neg;
X  }
X
X  if((length($pos) + length($stem) + 1) < length($neg)) {
X    $neg = substr($stem, 1).'.*'.(length($pos)?',':'').$pos;
X  }
X
X  print "$stem 2: [$pos][$neg]\n" if $verbose > 1;
X
X  ($pos, $neg);
X}
X
X
X# Reads an active file. Stops on either EOF or a line beginning with a dot,
X# so that it can be used to process NNTP responses.
Xsub readFHActive
X{
X  my($grps, $hier, $fh) = @_;
X  my($stem, $grp, $c1, $c2, $sub, @parts, $part);
X
X  while(<$fh>) {
X    last if /^\./;
X    ($grp, $c1, $c2, $sub) = split;
X    next if $sub eq 'n';
X    @parts = split(/\./, $grp);
X    $stem = '';
X    while($part = shift @parts) {
X        if($$hier{$stem}) {
X            $$hier{$stem} .= $part.' ' if index($$hier{$stem}, " $part ") < $[;
X        } else {
X            $$hier{$stem} = " $part ";
X        }
X	$stem .= '.'.$part;
X    }
X    $$grps{'.'.$grp} = $sub;
X  }
X}
X
X# Reads active file from named file.
Xsub readActive
X{
X  my($gref, $href, $fname) = @_;
X
X  open(ACTIVE, $fname) || die "Can't read $fname: $!\n";
X  print STDERR "Reading active file from $fname...\n";
X  &readFHActive($gref, $href, ACTIVE);
X  close(ACTIVE);
X}
X
X# Reads active file from named host via NNTP.
Xsub readNNTPActive
X{
X  my($gref, $href, $hostname) = @_;
X
X  require 'sys/socket.ph'; # don't require it if they don't use -N
X
X  print STDERR "Connecting to NNTP server on $hostname...\n";
X  &tcp_open(NNTP, $hostname, 'nntp');
X
X  # get the "Hiya!" line
X  ($code, $msg) = &doNNTPCmd(NNTP, '');
X  die "Can't get active from $hostname: $msg\n" unless $code =~ /^2/;
X
X  print STDERR "Retrieving active file\n";
X  ($code, $msg) = &doNNTPCmd(NNTP, 'LIST ACTIVE');
X  die "Can't get active from $hostname: $msg\n" unless $code =~ /^2/;
X
X  &readFHActive($gref, $href, NNTP);
X
X  print STDERR "Closing connection\n";
X  ($code, $msg) = &doNNTPCmd(NNTP, 'QUIT');
X  print STDERR "Error on close: $msg\n" unless $code =~ /^2/;
X
X  close(NNTP);
X}
X
X# Slightly generalized text-wrapping routine.
Xsub wraplines
X{
X  my($text, $width, $break, $lborder, $rborder) = @_;
X  my($ix, $out);
X
X  $width = 75 unless $width;
X  $break = ' ' unless $break;
X  $lborder = '' unless $lborder;
X  $rborder = "\n" unless $rborder;
X
X  $out = '';
X  while(length($text) > $width)
X  {
X    $ix = rindex($text, $break, $width);
X    $ix = index($text, $break, $width-1) if $ix < 0;
X    last if $ix < 0;
X    $out .= $lborder . substr($text, 0, $ix+length($break)) . $rborder;
X    substr($text, 0, $ix + length($break)) = '';
X  }
X  $out .= $lborder . $text . $rborder unless $text eq '';
X
X  $out;
X}
X
X########################################################################
X# doNNTPCmd
X#
X# extremely basic NNTP rpc from nntpsiphon.pl
X#
X
Xsub doNNTPCmd
X{
X  local($fh, $cmd) = @_;
X  local($resp, $code, $msg);
X
X  if(length($cmd)) {
X    print "--> $cmd\n" if $verbose;
X    print $fh $cmd."\r\n";
X  }
X
X  $resp = <$fh>;
X  $resp =~ s/\s+$//;
X  print "<-- $resp\n" if $verbose;
X
X  $code = substr($resp, 0, 3);
X  $msg = substr($resp, 4);
X  while(substr($resp, 3, 1) eq '-') {
X    $resp = <$fh>;
X    $resp =~ s/\s+$//;
X    print "<-- $resp\n" if $verbose;
X    $msg .= ' '.substr($resp, 4);
X  }
X
X  ($code, $msg);
X}
X
X
X########################################################################
X# tcpopen.pl
X#
X# Nice all-singing all-dancing TCP stream open routine.
X#
X#
X# require 'sys/socket.ph';
X
Xsub tcp_open
X{
X local($handle, $host, $port) = @_;
X local($proto, $paddr, $t1, $t2);
X
X $port = (getservbyname($port, 'tcp'))[2] if $port =~ /\D/;
X
X if($host =~ /\d+\.\d+\.\d+\.\d+/)
X {
X   $paddr = pack('S n CCCC x8', &AF_INET, $port, split(/\./,$host));
X }
X else {
X   (@hostbyname = gethostbyname($host)) || die "Can't look up $host.\n";
X   $paddr = pack('S n a4 x8', &AF_INET, $port, $hostbyname[4]);
X }
X
X socket($handle, &PF_INET, &SOCK_STREAM, (getprotobyname('tcp'))[2])
X  || die "socket: $!\n";
X connect($handle, $paddr)
X  || die "connect($host, $port): $!\n";
X $t1 = select($handle); $| = 1; select($t1);
X
X 1;
X}
SHAR_EOF
if test 7675 -ne "`wc -c < 'makefeeds.pl'`"
then
	echo shar: error transmitting "'makefeeds.pl'" '(should have been 7675 characters)'
fi
fi # end of overwriting check
#	End of shell archive
exit 0

-----BEGIN PGP SIGNATURE-----
Version: 2.6.2

iQCVAwUBMiUzL18UnN8n93LBAQHhsgQAksOfcqs+JzLmibTtF8dnZE6FjQ++D7Ye
VEqJ/Oj2HJPJxES0KWllBY3krClQndmKx/r1K4rXR0VOcgyk3zfviCnNSSdjyNIZ
OvLzSSBwkSjdqBJRfSn2SDqopYVFJ8DJXV/bZ56Zo1+YbFiA6dPHcVvcOAwR6WsO
n6jOnpDhlds=
=R7rR
-----END PGP SIGNATURE-----