Subject: nntp client inews in perl for rrn

From: [email-masked] (Bill Nickless)
Date: 5 Feb 92 02:33:59 GMT

Here is my first real application for perl.  Assuming you have perl
running already, this simplifies setting up rrn on a new system.  It
avoids having to do any configuration in the nntp tree; just put
this in /usr/local/lib/news/inews and run the Configure script
for rn.  Oh--and no, you can't use our news server milo.mcs.anl.gov--
you should change that line at the beginning.  Better yet, if
someone wanted to add the code to look up the NNTPSERVER from the
environment or the file that rn uses, that would be great.

How well does it work?  Well, it's being used to post this message.  I
make no claim that it will work anywhere else, ever.  :)
---
Bill Nickless   <[email-masked]>  +1 708 252 7390

#!/usr/local/bin/perl

# This is a replacement for the NNTP distribution client inews program; 
# intended to be used with rn.

# Derived from the client example program in the Perl book by Larry Wall
# and Randal L. Schwartz.  Adaptation by William K. Nickless.

# Following are some configuration constants.  They should be made to 
# read the appropriate files as per the Configure script I suppose.

$port = 119;
$them = 'milo.mcs.anl.gov';

# I don't want to deal with command line switches, especially -h.
# The Pnews that comes with rn wants to put it there, but I don't care.

require "getopts.pl";
&Getopts('h');

# Now we get into the socket stuff, stolen straight from the Perl book
# examples chapter.

$AF_INET = 2;
$SOCK_STREAM = 1;

$SIG{'INT'} = 'dokill';
sub dokill {
	kill 9,$child if $child;
}

$sockaddr = 'S n a4 x8';

chop($hostname = `hostname`);

($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
	unless $port =~ /^\d+$/;;
($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);

$this=pack($sockaddr, $AF_INET, 0, $thisaddr);
$that=pack($sockaddr, $AF_INET, $port, $thataddr);

# Make the socket filehandle

if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
#	print "socket ok\n";
} else {
	die $!;
}

# Give the socket an address.

if (bind(S, $this)) {
#	print "bind ok\n";
} else {
	die $!;
}

# Call up the server

if (connect(S,$that)) {
#	print "connect ok\n";
} else {
	die $!;
}

# Set socket to be command buffered.  Also, set standard output to be
# the socket, since the only thing we need to tell the user from here
# on out would be errors.

select(S); $| = 1; 

# Read the first line, getting the input response and the rest of text.

($code,$message) = split(/ /,<S>,2);
die "No can post--server says:",$message unless $code == 200;

# We got the 200 code, so we try to POST now.

print "POST\n";

($code,$message) = split(/ /,<S>,2);
die "No can post--server says:",$message unless $code == 340;

# Start putting the message out to the server.  First, put out the required
# fields.  We will just filter out any user-supplied fields that conflict.

    ($name,$rest)=split(/,/,(getpwuid($<))[6],2);

# The Path: line--

    print "Path: ",$hostname,"!",(getpwuid($<))[0],"\n";

# The Date: line--

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
    print "Date: ";
    print ((Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday]);
    print ", ",$mday," ";
    print ((Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon]);
    print " 19",$year," ";
    print $hour,":",$min,":",$sec," GMT\n";

# The Message-id: line--

    print "Message-id: <",time,$$,"@",$hostname,">\n";

# The Nntp-Posting-Host: line--

    print "Nntp-Posting-Host: ",$hostname,"\n";

# The From: line--

    print "From: ",(getpwuid($<))[0],"@",$hostname;
    print " (",$name,")\n";

# Now print the headers out to the server until a blank line is printed.

while(<>) {
	next if /^Path:/;
	next if /^Date:/;
	next if /^Message-id:/;
	next if /^Nntp-Posting-Host:/;
	next if /^From:/;
	print;
	last if $_ eq "\n";
}

# That's all the headers, so print out the body.  If someone puts a dot
# on a line by itself, put a space-dot first.

while(<>) {
	$_ = " .\n" if $_ eq ".\n";
	print;
}

# That's all the body, so send the period.

print ".\n";

# Get the response from the server

($code,$message) = split(/ /,<S>,2);
die "Post failed--server says:",$message unless $code == 240;

# ...and break the connection.

print "QUIT\n";

($code,$message) = split(/ /,<S>,2);
die "Quit failed--server says:",$message unless $code == 205;

exit 0