#!/usr/local/bin/perl
#
# $Header: /home/pat/perl/RCS/pnews,v 0.5 1993/08/23 19:51:26 pat Exp pat $
#
# pnews - Perl News (or maybe Pats News)
# a simple NNTP news posting client
#
# references:
# RFC 850
# RFC 977
#
#
#
# server connection code taken from pgnews written by
# Jeffrey B. McGough mcgough@wrdis01.af.mil
#
#
# bug reports, fixes, fan mail, cash donations to:
# pryan@stx.com (patrick m. ryan)
#
eval 'exec perl $0 -S ${1+"$@"}'
if $running_under_some_shell;
($version,$patchlevel) = ($] =~ /(\d+)\.(\d+)/);
if ($version >= 5) {	# Perl 5
$cmd = "use Socket";
eval { $cmd; }
} else {	# Perl 4
eval {
sub AF_INET {2;}
sub PF_INET {2;}
sub SOCK_STREAM {2;} #1
}
}
require 'getopts.pl';
require 'ctime.pl';
require 'date.pl';
&Getopts('h:s:dt');
$rcsid = q!$Id: pnews,v 0.5 1993/08/23 19:51:26 pat Exp pat $!;
$v = (split(/\s+/,$rcsid))[2];
$version = "pnews [v. $v]";
print "This is $version\n\n";	# toot our own horn
if ($opt_d)
{ print $rcsid,"\n"; }
# hostname must be available
chop($host = `hostname`); 
if (!$host) { die "could not determine hostname\n"; }
# if we do not contain a "." then assume we are not a FQDN
if ($host !~ /\./)
{
$domain = "gsfc.nasa.gov";
if (!$domain) { die "no domain set\n"; }
$host .= ".$domain";
$host =~ s/\.+/./g;	# remove any redundant .s
}
$fullname = (getpwuid($<))[6];
if ($fullname =~ /,/)	# strip out any extra gcos stuff
{
$fullname = (split(/,/,$fullname))[0];
}
# get user name
$user = (getpwuid($<))[0] ||
## getlogin() ||
$ENV{USER} || $ENV{LOGNAME} ||
die "who are you?\n";
# get user home directory 
$home = (getpwuid($<))[7] || $ENV{HOME} ||
die "you are homeless!\n";
# connect with the NNTP server
$port = 119;	# for NNTP
$nntpserver = $opt_h || $ENV{NNTPSERVER};
if (!$nntpserver && -f '/etc/nntpserver')
{
chop ($nntpserver = `cat /etc/nntpserver`);
}
if (!$nntpserver) { $nntpserver='localhost'; } # last resort
# Pack format...
$sockaddr = 'S n a4 x8';
$DOMAIN = 2;
$STYLE = 1;
$rin = $rout = '';
($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $type, $len, $hostaddr) = gethostbyname($nntpserver);
$sock = pack($sockaddr, $DOMAIN, $port, $hostaddr);
$SIG{'ALRM'} = 'handler';
alarm(60);
print "connecting to $nntpserver...";
##socket(S, $DOMAIN, $STYLE, $proto) || die $!;
socket(S, &PF_INET, &SOCK_STREAM, $proto) || die $!;
connect(S, $sock) || die $!;
select(S); $| = 1; select(STDOUT);
alarm(0);
print "\n";
# set up for select
vec($rin, fileno(S), 1) = 1;
# this select will block until the server gives us something.
$nfound = select($rout=$rin, undef, undef, 900);
if ($nfound == 0)
{
print "Socket timed out...";
exit 1;
}
$SIG{'QUIT'} = 'handler';
$SIG{'INT'} = 'handler';
$status = ; # read one line to see if we established a good connection.
if ($opt_d) { print $_; }
if ($status !~ /^20[01]/)
{
print;
print S 'quit\n';
$status && print $status;
##	die "Service unavailable";
exit 1;
}
if ($opt_t)	# just test a few things
{
while (@ARGV)	# send arguments to NNTP server
{
$cmd = shift(@ARGV);
print "sending command \"$cmd\"\n";
print S $cmd,"\n";
# watch out. not all commands end in \n.\n
while ()	# get response from command
{
if (/^\./) { last; }
print;
}
}
exit 0;
}
if ($status =~ /^201/)
{
print STDERR "sorry, no posting allowed on host $nntpserver\n";
exit 1;
}
$tmpdir = $ENV{TMPDIR} || '/tmp';
$tmp = $tmpdir . '/.pinews.t.'.$$;
$art = $tmpdir . '/.pinews.a.'.$$;
$editor = $ENV{VISUAL} || $ENV{EDITOR} || "vi";
$dead = $home."/dead.article";
# list of required headers from RFC850
%headers = (
'From','',
'Date','',
##	'Relay-Version','',
##	'X-Newsreader','',
'X-Posting-Version',$version,
'Newsgroups','',
'Subject','',
'Message-ID','',
'Path','',
);
###$header{'NNTP-Posting-Host'} = $host;
$headers{From} = "$user@$host";
if ($fullname)
{ $headers{From} .= " ($fullname)"; }
# grab personal headers, if any
$prc = $home."/.prc";
$sig = $home."/.signature";
%my_headers=();
if ( -f $prc )
{
(%my_headers) = &split_headers($prc);
@my_headers = keys(%my_headers);
foreach (@my_headers)	# stick them into the big list
{ $headers{$_} = $my_headers{$_}; }
}
# now ask the user for a few headers 
@ask_headers = ();	# make a list of headers for which to ask
# use these as newsgroups
if (@ARGV)
{
$headers{Newsgroups} = join(',',@ARGV);
}
else
{
push(@ask_headers,'Newsgroups');
}
# check to see if subject was specified
if ($opt_s)
{
$headers{Subject} = $opt_s;
}
else
{
push(@ask_headers,'Subject');
}
foreach (@ask_headers)
{
print "$_: ";
$r="";
until ($r)
{
$r = ;
chop $r;
}
$headers{$_} = $r;
}
# try to weed out any junk from the Newsgroups line
$headers{Newsgroups} =~ s/\s+//g;
$headers{Newsgroups} =~ s/,+/,/g;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= gmtime(time);
@months=('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
$TZ='GMT';
$mon = $months[$mon];
if ($year < 1900) { $year += 1900; }
$mon = $months[$mon];
$d = sprintf "%2d %s %4d %02d:%02d:%02d",$mday,$mon,$year,$hour,$min,$sec;
$headers{Date} = $d;
if ($opt_d)
{
print "\nheaders:\n";
while (($key,$value) = each %headers)
{
print "\t$key: $value\n";
}
}
# construct header stuff
@edit_headers = (Newsgroups,Subject,@my_headers);
@sys_headers = (From,Date,'X-Posting-Version');
if ($opt_d)
{
print "edit headers: ";
foreach (@edit_headers) { print "$_ "; }
print "\n";
}
$head = '';
foreach (@edit_headers)
{
$head .= "$_: $headers{$_}";
if ($headers{$_} !~ /\n$/)	# if necessary, append a newline
{ $head .= "\n"; }
}
# touch the file so that it is not world readable
open(TMP,">$tmp");
chmod(0600,$tmp);
close TMP;
# open it again and stick in the headers
open(TMP,">$tmp");
print TMP $head;
print TMP "\n";	# blank line after header
close TMP;
# invoke the editor for create the article
$cmd = "$editor $tmp";
if ($opt_d) { print $cmd,"\n"; }
system $cmd;
if ($?>>8)	# error from system()
{
print STDERR "error executing \"$cmd\"\n";
if ( -s $tmp )
{
&save_article($tmp,$dead);
}
unlink $tmp;
print S "quit\n";
exit 1;
}
# ask what to do with the article
$done=0;
until ($done)
{
print "(p)ost, (i)spell, (e)edit, (q)uit? (p) ";
chop ($r = );
$r =~ s/^\s*//;
if ($r =~ /i/i)
{
$cmd = "ispell $tmp";
if ($opt_d)
{ print $cmd,"\n"; }
system $cmd;
}
elsif ($r =~ /q/i)
{
print "ok. not posting\n";
&save_article($tmp,$dead);
unlink $tmp;
print S 'quit\n';
exit 0;
}
elsif ($r =~ /e/i)
{
$cmd = "$editor $tmp";
if ($opt_d) { print $cmd,"\n"; }
system $cmd;
}
elsif ($r =~ /p/i || $r eq '')
{
$done=1;
}
else
{
print "$r: unrecognized command\n";
}
}
# now try to send the article
print "posting article...\n";
# put everything in another temp file
open(ART,">$art");
close ART;
chmod(0600,$art);
open(ART,">$art");
print S "post\n";
$_ = ;
if ($opt_d) { print $_; }
# check reply value
foreach (@sys_headers)
{
print ART "$_: $headers{$_}\n";
}
open(TMP,"<$tmp") || die;
while ()
{
if ($_ eq ".\n")
{ print ART "..\n"; }	# this looks like an EOT marker
else
{ print ART $_; }
}
if ( -f $sig && -r $sig )	# append .sig file
{
open(SIG,"<$sig");
print ART "--\n";
while ()
{ print ART $_; }
close SIG;
}
print ART "\n.\n";	# send EOT marker
close TMP;
close ART;
# now actually send the article
open(ART,"<$art");
while() { print S $_; }
close ART;
$_ = ;
if ($opt_d) { print $_; }
if ($_ !~ /^240/)
{
print STDERR $_;
&save_article($art,$dead);
}
else
{
print "article posted\n";
}
print S "quit\n";
unlink $tmp;
unlink $art;
exit 0;
sub handler
{
local($sig) = @_;
print "\nCaught a SIG$sig--aborting\n";
unlink $tmp;
exit(0);
}
#
# [this was yanked out of my .deliver file]
# generates an associative array containing all of the header
# information from a mail message.
# 
# bugs:
# doesn't handle multiple instances of the same field.
# right now, it just concatenates them.
# usually, this doesn't matter.
sub split_headers
{
local($file)=@_;
local(%headers,$tmp,@lines);
# swallow the entire header file. yum, yum...
open(HEADER,"<$file");
@lines=
;
close(HEADER);
%headers=();
while (@lines)
{
$_ = shift(@lines);
if (/^\s*\n$/o) { last; } # this is an empty line
# split header line as "field: value"
##	($field,$value) = /^([^:]+):\s*(.*\n)/o ;
($field,$value) = split(/\s*:\s*/,$_,2);
if (( !$field ) || (!$value)) { next; } # unrecognized header
$tmp='';
# need to change field to all same case?
# append multiply defined headers
$headers{$field} .= $value;
# append any continuation lines
while ($lines[0] =~ /^\s+/o)
{
$headers{$field} .= shift(@lines);
}
}
# 
return (%headers);
}
sub save_article
{
local($tmp,$dead) = @_;
$ok=1;
open(DEAD,">$dead") || die "couldn't save article\n";
print DEAD "\n";
open(TMP,"<$tmp");
while ()
{
print DEAD $_;
}
close TMP;
close DEAD;
chmod(0600,$dead);
print STDERR "saved article in $dead\n";
return;
}
# Local Variables:
# mode: perl
# End: