FAQueue Usenet FAQ Auto-Poster

I REALLY don't know what I must have been smoking to make me want to write this script.  Fortunately, it's basically just hacked together from other people's scripts for the most part.  I did have to do a lot of formatting of the code and all that, but when you really get down to it I didn't do much to create this code.

The purpose of this script is to run as a cron job and post a pre-written piece of text, presumably a FAQ, to a specified newsgroup.  The newsgroup name is taken from the filename of the text file.  I could write up more explicit instructions about how to use this program, but hell I don't even use it myself so I don't really see the point.  It doesn't work with NNTP servers that require authentication, sorry.  If I knew enough about writing sockets code and NNTP protocols I could make it work, but I didn't know enough about either to write this code in the first place, did I?  Use it at your own risk. Seriously.  Risk is a very key word here.


"FAQueue.perl" (click here to download)

#!/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);
}


Back to the Bad Idea page