#!/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 = <S>; # 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 (<S>)		# 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 = <STDIN>;
	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 = <STDIN>);
    $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";
$_ = <S>;
if ($opt_d) { print $_; }
# check reply value

foreach (@sys_headers)
{
    print ART "$_: $headers{$_}\n";
}

open(TMP,"<$tmp") || die;
while (<TMP>)
{
    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 (<SIG>)
    { print ART $_; }
    close SIG;
}

print ART "\n.\n";		# send EOT marker
close TMP;
close ART;

# now actually send the article

open(ART,"<$art");
while(<ART>) { print S $_; }
close ART;

$_ = <S>;

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=<HEADER>;
    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 (<TMP>)
    {
	print DEAD $_;
    }
    close TMP;
    close DEAD;

    chmod(0600,$dead);
    
    print STDERR "saved article in $dead\n";
    return;
}
    
# Local Variables:
# mode: perl
# End: