#!/usr/local/bin/perl 
# 
# FAQueue - A crappy FAQ poster by Bryan Kolodziej 
#           using code mostly cut and pasted from pInews by 
#           Patrick M. Ryan (pat@jaameri.gsfc.nasa.gov), whose 
#           server connection code was taken from pgnews by 
#           Jeffrey B. McGough (mcgough@wrdis01.af.mil) 
# 
#           Pretty lame that I had to patch this together from something 
#           that was patched together from something else that was 
#           probably patched together, huh? 
# 

# Any requirements for this program to run go here.  If I were really 
# cool I would have written this in strictly perl5-ish fashion, but I 
# am not cool, so I didn't. 

require 'date.pl'; 

# Variable definitions go here; if there's anything that needs to be 
# customized to make this run elsewhere, this is presumably where those 
# changes should go. 
$nntpserver = "news.webicommerce.com"; 
$host = "badideas.webicommerce.com"; 
$faqsdir = "/tmp/FAQs"; 
$user = "The Hurdy Gurdy Man <bryan\@badideas.webicommerce.com>"; 
$organization = "UC San Diego"; 

# The stuff below here, as far as I can tell, shouldn't need to be changed 
# even if this is going to run someplace else other than on the system I 
# designed this to run on. 
$port = 119; 
$summary = "FAQ"; 
$keywords = "FAQ"; 
$useragent = "FAQueue v. 0.002a"; 

# Set this if you want debugging turned on.  Granted, I could just have this 
# as a command line option, but in most cases there's no reason why you'd 
# want anything but the most silent of output anyhow.  Maybe someday I'll 
# add in some real debug options, but really, for an alpha-alpha program 
# like this, you're lucky if it even works. 
# $debug = 1; 

# Network socket configuration stuff, stolen from pInews. 
$sockaddr = 'S n a4 x8'; # Pack format 
$DOMAIN = 2; 
$STYLE = 1; 

# Read in the list of FAQs that are going to be posted. 
opendir FAQDIR, "$faqsdir" or die "Unable to open FAQ directory: $!\n"; 
@faqlist = grep !/^\./, readdir FAQDIR; 
closedir FAQDIR; 

$counter = 0; 
foreach (@faqlist) 
{ 
        # The following line is a bug workaround.  For some reason on 
        # the FreeBSD machine I tested this on, it kept screwing up what 
        # it thought the value of $faqlist[$counter] was, causing the 
        # thing to just plain not work.  So, by just setting $groupname 
        # to $_ in the beginning, it works fine.  Go figger. 
        $groupname = $_; 
        open FAQTEXT, "<$faqsdir/$groupname" or die "Unable to open $faqsdir/$groupname: $!\n"; 

        $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); 

        if ($debug) {print "Connecting to $nntpserver.\n";} 
        socket(S, $DOMAIN, $STYLE, $proto) or die "Unable to open socket: $!\n"; 
        connect(S, $sock) or die "Unable to connect: $!\n"; 
        select(S); $| = 1; select(STDOUT); 
        alarm(0); 

        # 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.\n"; 
                exit 1; 
        } 
  
        # Read one line to see if we got a good connection. 
        $_ = <S>; 

        if ($_ !~ /^200/) 
        { 
                print; 
                print S 'quit\n'; 
                print $_,"\n"; 
                die "Service unavailable.\n"; 
        } 
        if ($debug) {print "Posting article.\n";} 
        print S "post\n"; 
        $_ = <S>; 

        # Headers for the message go here.  You really don't need all these 
        # headers, but I have included them for completeness sake.  If you 
        # don't want some of them, just comment them out.  Please at least 
        # leave the "User-Agent" header in there though so people can see 
        # that you used this program. Although, if people do realize you've 
        # used this program, you run the risk of them laughing at you. 
        print S "From: $user\n"; 
        print S "Newsgroups: $groupname\n"; 
        print S "Subject: FAQueue test post to $groupname\n"; 
        print S "Date: ", &date(time(),"%d %h %Y %T %Z"), "\n"; 
        print S "Organization: $organization\n"; 
        print S "Summary: $summary\n"; 
        print S "Keywords: $keywords\n"; 
        print S "User-Agent: $useragent\n"; 
        print S "\n"; # Blank line after header. 
  

        while (<FAQTEXT>) 
        { 
                if ($_ eq ".\n") 
                { print S "..\n"; } # Extraneous period workaround. 
                else 
                { print S $_; } 
        } 
        print S ".\n"; 

        $_ = <S>; 

        if ($_ !~ /^240/) 
        { 
                print STDERR $_; 
        } 
        else 
        { 
                if ($debug) {print "Article posted successfully.\n";} 
        } 

        print S "quit\n"; 

        close S; 
        close FAQTEXT; 
  
        sleep 2; # Sleep for a few seconds to be polite to the NNTP server. 
  
        ++$counter; 
} 

sub handler 
{ 
        local($sig) = @_; 
        print "Caught a SIG$sig -- aborting.\n"; 
        exit(0); 
}