#!/usr/bin/perl -w

# news2gale.pl is a bit like the classic `biff`, but for Usenet and gale
# instead of email and a tty.  It is designed to be fed from an INN program
# feed, and sends a brief puff containing From and Subject lines to public
# gale.  The category indicates the newsgroup of the post (puff crossposted
# if Newsgroups line had multiple newsgroups).
#
# Written by Jeffrey M. Vinocur <jeff@litech.org>
# This work is hereby placed in the public domain by its author.
#
# Put the following in INN's $pathetc/newsfeeds, to get alert messages
# about articles posted in local.* on your chosen gale channel (see
# configuration section below).
#
# gale-gateway!\
#         !*,local.*\
#         :Tp:news2gale.pl %s

use strict;

#####################################################
################### Configuration ################### 
#####################################################

my $GSEND = '/usr/local/bin/gsend';
my $PREFIX = '@litech.org/gateway/usenet/'; # probably should end in /
my $SM= '/usr/local/news/bin/sm';           # set to `cat` for INN before 2.3

# I forget why this was necessary in our environment
$ENV{'LOGNAME'}='news';

#####################################################
###################     Code      ################### 
#####################################################

exit 0 if (@ARGV == 0);

my $token = $ARGV[0];

my ($from, $subject, $newsgroups); # = ('', '', '');

open(A, "$SM $token |") || exit 0;

while( <A> ) {
  next if /^\s/;  # skip wrapped header lines
  if( /^([[:upper:]][^:]*): (.*)$/ ) {
    $subject    = "Subject: $2" if( $1 eq 'Subject' );
    $newsgroups = $2            if( $1 eq 'Newsgroups' );
    $from       = "From:    $2" if( $1 eq 'From' );
  }
  else {  # end of headers (or perhaps garbage line)
    last;
  }
}

close(A);

$subject    = substr($subject,0,76) if $subject;
$from       = substr($from,0,76)    if $from;

$newsgroups =~ tr [.] [/];

my @cats = map { "${PREFIX}$_/" } (split(/,/ , $newsgroups));

open(G, '|-') || exec $GSEND, '-c', join(':', @cats);

print G "$from\n";
print G "$subject\n";

close(G);