#!/usr/bin/perl -w
$ID = q$Id: postfaq,v 1.17 2013/01/09 04:54:17 eagle Exp $;
#
# postfaq -- Post a Usenet FAQ following news.answers conventions.
#
# Copyright 1999, 2002, 2003, 2004, 2008, 2013 Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

##############################################################################
# Local configuration
##############################################################################

# This directory stores the last message ID of each FAQ that postfaq knows
# about, in a file named after the FAQ.
$STATUS = $ENV{HOME} . '/data/faqs';

##############################################################################
# Modules and declarations
##############################################################################

require 5.001;

use strict;
use vars qw($ID @MONTHS $STATUS);

use Getopt::Long qw(GetOptions);
use Net::Domain qw(hostfqdn);
use Net::NNTP ();
use POSIX qw(mktime strftime);

# Abbreviated month names, used for creating Date headers.  These must not be
# translated, so we can't use strftime for them.
@MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

##############################################################################
# Utility functions
##############################################################################

# Convert a time into an RFC 2822 date in the -0000 time zone.  We don't use
# strftime since it may translate the month name.
sub date {
    my ($time) = @_;
    my @date = gmtime $time;
    my $date = sprintf ("%d %s %d %02d:%02d:%02d -0000", $date[3],
                        $MONTHS[$date[4]], $date[5] + 1900, $date[2],
                        $date[1], $date[0]);
    return $date;
}

# Map an expiration time into an RFC 2822 date.  The expiration time is
# expected to be a positive integer followed by units, which for the time
# being are assumed to be in days.  Run things through mktime to normalize.
sub expires {
    my $interval = shift;
    my @now = localtime;
    my ($amount, $unit) = ($interval =~ /(\d+)\s*(\w)\w*\s*/);
    if ($unit ne 'd') { die "$0: unsupported expires unit $unit\n" }
    my %units = (d => 3);
    $now[$units{$unit}] += $amount;
    my $expires = date (mktime @now);
    return $expires;
}

# Returns a nicely formatted "Last modified" string from an RCS/CVS Id.
sub modified_id {
    my $id = shift;
    my ($version, $date) = (split (' ', $id))[2,3];
    my ($year, $month, $day) = split (m%[/-]%, $date);
    $day =~ s/^0//;
    if ($version =~ /\./) {
        return strftime ("%Y-%m-%d (revision $version)", 0, 0, 0, $day,
                         $month - 1, $year - 1900);
    } else {
        return strftime ('%Y-%m-%d', 0, 0, 0, $day, $month - 1, $year - 1900);
    }
}

# The same, but from a file modification time.
sub modified_file {
    my ($faq) = @_;
    my $timestamp = (stat $faq)[9];
    return strftime ('%Y-%m-%d', gmtime $timestamp);
}

# Produces a good string representation of the Perl version, allowing for the
# change of version numbering conventions in 5.6.0.
sub perl_version {
    my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/);
    $version[2] ||= 0;
    $version[2] *= 10 ** (3 - length $version[2]);
    for (@version) { $_ += 0 }
    return join ('.', @version);
}

##############################################################################
# Status file handling
##############################################################################

# Given the name of the faq, open its status file and parse out the
# information contained in it.  There are up to two pieces of data contained
# in this file:  The string to use when forming message IDs and the previous
# post (if any) used to generate a Supersedes: header.
sub status_read {
    my $status = shift;
    $status =~ s%.*/|^%$STATUS/%;
    open (STATUS, $status) or return;
    my $name = <STATUS>;
    chomp $name if $name;
    my $supersedes = <STATUS>;
    chomp $supersedes if $supersedes;
    close STATUS;
    return ($name, $supersedes);
}

# Write out the new information to the status file after successful posting.
sub status_write {
    my ($status, $name, $id) = @_;
    $status =~ s%.*/|^%$STATUS/%;
    open (STATUS, "> $status") or die "$0: cannot create $status: $!\n";
    print STATUS "$name\n$id\n";
    close STATUS;
}

##############################################################################
# FAQ posting
##############################################################################

# Read the FAQ into memory, parsing it into a CVS revision string, headers,
# subheaders, and body.  Returns the revision string and references to three
# arrays holding those three sections of the post.
sub post_read {
    my $faq = shift;
    open (FAQ, $faq) or die "$0: cannot open FAQ $faq: $!\n";

    # Grab the first line and see if it's an RCS/CVS identifier.  If so, stash
    # that information for future reference and skip forward over whitespace.
    my $rcsid;
    $_ = <FAQ>;
    if (/^\s*\$Id.*\$\s*$/) {
        $rcsid = $_;
        do { $_ = <FAQ> } while (defined && /^\s*$/);
    }

    # Read in the message headers, terminated by a blank line, into the
    # @headers array.  Expires headers are handled specially.
    my @header;
    while (defined) {
        last if /^\s*$/;
        s/^Expires:\s*(.*)/'Expires: ' . expires $1/ei;
        push (@header, $_);
        $_ = <FAQ>;
    }
    $_ = <FAQ> while (defined && /^\s*$/);

    # Read in the archive subheader, terminated by a blank line.  Ignore any
    # headers beginning with HTML-, since those are for the use of faq2html.
    # Note that some FAQs won't have subheaders.
    my @subheader;
    while (defined) {
        last if /^\s*$/;
        last if !/^[\w-]+:\s/;
        next if /^HTML-/i;
        push (@subheader, $_);
    } continue {
        $_ = <FAQ>;
    }

    # Finally, read in the body of the post and return the results.
    my @body = <FAQ>;
    return ($rcsid, \@header, \@subheader, \@body);
}

# Actually post a FAQ, using the passed-in file name, open Net::NNTP object,
# flag saying whether to use IHAVE, and program to use to post.  Returns the
# message ID used in the posting, and if any arguments are given beyond the
# first four, uses them to generate a References header.  If $server is
# undef, prints the FAQ to stdout rather than posting it.
sub post {
    my ($faq, $server, $ihave, $program, @references) = @_;
    my ($rcsid, $header, $subheader, $body) = post_read ($faq);

    # Check our status information for this FAQ and see if we need to add a
    # Supersedes header.
    my ($name, $supersedes) = status_read ($faq);
    unless ($name) {
        ($name = $faq) =~ s%.*/%%;
    }
    if ($supersedes) {
        push (@$header, "Supersedes: $supersedes\n");
    }

    # Generate a new message ID, putting it in the headers.  Add References if
    # we have them.
    my $id = '<' . $name . '-faq-' . time . "\$$$\@" . hostfqdn . '>';
    push (@$header, "Message-ID: $id\n");
    push (@$header, "References: @references\n") if @references;

    # If there's a subheader, advertise ourselves and add a Last-modified
    # subheader.
    if (@$subheader) {
        my $version = join (' ', (split (' ', $ID))[1..2]);
        $version =~ s/,v\b//;
        my $perlversion = perl_version;
        unshift (@$subheader, "Posted-by: $version (Perl $perlversion)\n");
        my $modified = $rcsid ? modified_id ($rcsid) : modified_file ($faq);
        unshift (@$subheader, 'Last-modified: ' . $modified . "\n");
    }

    # Now build our actual post to feed to the server.
    my @post = (@$header, "\n");
    push (@post, @$subheader, "\n") if @$subheader;
    push (@post, @$body);

    # Add the additional headers required for IHAVE posting.
    if ($ihave) {
        my $date = date (time);
        unshift (@post, "Date: $date\n");
        unshift (@post, "Path: not-for-mail\n");
    }

    # Post the message, or just print to stdout if -n was given.
    if ($program) {
        open (POST, "| $program") or die "$0: cannot fork $program: $!\n";
        print POST @post;
        close POST;
        if ($? == 0) {
            status_write ($faq, $name, $id);
        } else {
            warn "$0: $program exited with status ", ($? >> 8), "\n";
            die "$0: posting $faq with program $program failed\n";
        }
    } elsif ($server) {
        my $status;
        if ($ihave) {
            $status = $server->ihave ($id, \@post);
        } else {
            $status = $server->post (\@post);
        }
        unless ($status) {
            die "$0: posting $faq failed: " . $server->code . ' '
                . $server->message;
        }
        status_write ($faq, $name, $id);
    } else {
        print '-' x 74, "\n", @post;
    }
    return $id;
}

# Given a file containing a list of FAQs to post, go through each one and post
# it by turn.  FAQs listed on the same line are considered to be part of a
# set, and all posts after the first on that line will contain a References
# header referring to the first one.  In addition to the list, takes the open
# Net::NNTP server, the flag saying whether to just print to stdout, and the
# program to use to post (if any).
sub post_list {
    my ($list, $server, $ihave, $program) = @_;
    my ($directory) = ($list =~ m%^(.*/)%);
    open (LIST, $list) or die "$0: cannot open post list $list: $!\n";
    while (<LIST>) {
        next if /^\s*$/;
        next if /^\s*\#/;
        my @posts = split;
        if ($directory) {
            for (@posts) { s%^([^/])%$directory/$1% }
        }
        if (@posts == 1) {
            post ($posts[0], $server, $ihave, $program);
        } else {
            my $id = post (shift (@posts), $server, $ihave);
            for (@posts) { post ($_, $server, $ihave, $program, $id) }
        }
    }
}

##############################################################################
# Main routine
##############################################################################

# Trim extraneous garbage from the path.
my $fullpath = $0;
$0 =~ s%.*/%%;

# Parse command-line options.
my ($file, $help, $ihave, $nopost, $password, $program, $server, $username,
    $version);
Getopt::Long::config ('bundling', 'no_ignore_case');
GetOptions ('data|d=s'             => \$STATUS,
            'file|f=s'             => \$file,
            'help|h'               => \$help,
            'ihave|i'              => \$ihave,
            'dry-run|just-print|n' => \$nopost,
            'password|P=s'         => \$password,
            'program|p=s'          => \$program,
            'server|s=s'           => \$server,
            'username|U=s'         => \$username,
            'version|v'            => \$version) or exit 1;
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $0);
} elsif ($version) {
    my $version = join (' ', (split (' ', $ID))[1..3]);
    $version =~ s/,v\b//;
    $version =~ s/(\S+)$/($1)/;
    $version =~ tr%/%-%;
    print $version, "\n";
    exit;
}

# Make sure that the options are consistent.
if ($file && @ARGV) { die "$0: both -f and FAQ given on command-line\n" }
if (!$file && !@ARGV) { die "$0: no FAQ to post specified\n" }
if ($program && $ihave) { die "$0: -p is inconsistent with -i\n" }
if ($program && $server) { die "$0: -p is inconsistent with -s\n" }
if ($username && !defined ($password)) { die "$0: -U requires -P\n" }
if ($password && !defined ($username)) { die "$0: -P requires -U\n" }

# Open a server connection unless -n was given or we're posting with a
# program.
my ($nntp, @options);
push (@options, $server) if $server;
push (@options, Reader => 0) if $ihave;
unless ($nopost || $program) {
    $nntp = Net::NNTP->new (@options);
    die "$0: cannot open connection to server\n" unless $nntp;
    if (defined $username) {
        my $status = $nntp->authinfo ($username, $password);
        unless ($status) {
            die "$0: cannot authenticate to server: " . $nntp->code . ' '
                . $nntp->message;
        }
    }
}
$program = undef if $nopost;

# If -f is given, read the FAQs to post from a file.  Otherwise, loop across
# all FAQs given on the command line.
if ($file) {
    post_list ($file, $nntp, $ihave, $program);
} else {
    for (@ARGV) {
        post ($_, $nntp, $ihave, $program);
    }
}
exit;

__END__

##############################################################################
# Documentation
##############################################################################

=head1 NAME

postfaq - Post Usenet FAQs following news.answers conventions

=head1 SYNOPSIS

B<postfaq> [B<-hinv>] [B<-d> I<statusdir>] [B<-s> I<server>] [B<-p> I<program>]
    [B<-U> I<username> B<-P> I<password>] I<faq> [I<faq> ...]

B<postfaq> [B<-hinv>] [B<-d> I<statusdir>] [B<-s> I<server>] [B<-p> I<program>]
    [B<-U> I<username> B<-P> I<password>] B<-f> I<list>

=head1 REQUIREMENTS

Perl 5.001 or later and the Net::NNTP and Net::Domain modules (both of
which are included in Perl core as of 5.8.0 and are part of the libnet
distribution on CPAN).  Access to a news server is required to actually
post FAQs, and it is assumed that Net::NNTP is configured correctly to
point to your local news server by default (otherwise, use B<-s>).

The hostfqdn() function of Net::Domain needs to return a reasonable
hostname for your system.  This means that your public domain name should
be listed first in F</etc/hosts>, not something bogus like
C<localhost.localdomain>.

=head1 DESCRIPTION

B<postfaq> posts Usenet FAQs, with support for the news.answers
conventions.  Its basic operation is to read in a file containing the FAQ,
which should include the standard Usenet headers such as Newsgroups,
Subject, and From, and post it.  A Message-ID header is added as described
below.

If an Expires header is present in the FAQ, it is expected to contain a
time period from the time of posting that the FAQ should remain in the
newsgroup.  Currently, the only time interval allowed is days, represented
by C<d>.  So, for example, a header containing:

    Expires: 35d

when posted on 2002-07-22 00:15:17 -0000 would be converted to:

    Expires: 26 Aug 2002 00:15:17 -0000

in the actual post.

The first line of the post may be an RCS/CVS-style Id string; if so, it is
not included in the final post, and is parsed for the version and last
modification date of the FAQ.  The version number is included only if it
looks like a CVS or RCS version number (containing a period).  Subversion
version numbers aren't as useful, since they're a repository-wide version,
and hence aren't included.  If there is no Id string, the last modified
time of the file is used instead.

If the beginning of the post body looks like additional headers (some
number of alphanumerics and dashes followed by a colon and a space), the
beginning of the body is assumed to be a subheader in the news.answers
style.  B<postfaq> will add to the beginning of that subheader a
Last-modified header, determined as described above.  It will also add a
Posted-by subheader giving its own version number and that of Perl.  Any
subheaders beginning with C<HTML-> are stripped out of the post (as
they're presumed to be for the HTML translation of the FAQ).

Information about the last post and about how to form message IDs for
posts is stored in a file in a status directory (F<$HOME/data/faqs> by
default, which can be overridden with the B<-d> option) which must exist.
In that directory, one file per FAQ, with the same name as the FAQ
filename, is written.  Each of those status files will contain two lines,
the first being the prefix used to generate message IDs and the second
being the message ID of the last time that FAQ was posted.  If this status
file is present when a FAQ is posted and contains a message ID on the
second line, a Supersedes header will be added to the post.

A Message-ID header will always be added to a posted FAQ, constructed from
the first line of the status file as described above, the current time,
the process ID, and the local hostname (obtained from
Net::Domain::hostfqdn).

To post multiple FAQs at the same time, a list of files can be given on
the command line.  Alternately, the B<-f> option can be given with an
argument giving a file containing the list of FAQs to post.  Usually those
files should be listed one per line (and relative paths are considered
relative to the path to the list file as given on the command line), but
if multiple FAQs are given on the same line, they are considered related.
All FAQs listed on that line after the first will have a References header
added referring to the first post.

=head1 OPTIONS

=over 4

=item B<-d> I<statusdir>, B<--data>=I<statusdir>

Look for and store status information in the provided directory instead
of in the default of F<$HOME/data/faqs>.

=item B<-f> I<list>, B<--file>=I<list>

Take the list of FAQs to post from the file I<list> instead of from the
command line.  This also enables posting FAQs as a group; see above for
more details on how that works.

=item B<-i>, B<--ihave>

Post using IHAVE rather than POST.  This requires that your local server
accept IHAVE commands from the system on which this script is running (no
authentication is used).  A Date header corresponding to the current time
(but in UTC, not in the local time zone) and a Path header containing only
C<not-for-mail> will be added to the article before posting.

=item B<-h>, B<--help>

Print out this documentation (which is done simply by feeding the script
to C<perldoc -t>).

=item B<-n>, B<--dry-run>, B<--just-print>

Rather than posting the FAQs, just print them to stdout separated by lines
of dashes.  This can be used to preview what B<postfaq> would do without
embarassing yourself on Usenet.  The status files are not updated when
this option is given.

=item B<-p> I<program>, B<--program>=I<program>

Post using the external program I<program>.  The post will be fed to this
program on standard input, and a 0 return value will be considered
success.  This option cannot be used with B<-i> or B<-s> (for obvious
reasons).

=item B<-P> I<password>, B<--password>=I<password>

Authenticate to the news server using AUTHINFO with the password
I<password>.  The username must also be specified with B<-U>.

Please note: B<postfaq> does not use an SSL-encrypted connection or any
safe authentication mechanism and the password will be sent in clear-text
over the network.  Furthermore, the password will be visible to anyone
else using the same system via B<ps>.  This option is only intended to be
used with NNTP-only account passwords that don't have any significant
value and where interception of the password is not a significant risk.

If you need to use a more secure authentication mechanism or post via SSL,
you will need to use an external program that knows how to do that sort of
posting and specify it with the B<-p> option.

=item B<-s> I<server>, B<--server>=I<server>

Post to I<server> rather than to the default server configured into
News::NNTP, or set by the NNTPSERVER environment variable.

=item B<-U> I<username>, B<--username>=I<username>

Authenticate to the news server using AUTHINFO with the username
I<username>.  The password must also be specified with B<-P>.  See the
description of B<-P> for additional security warnings and caveats.

=item B<-v>, B<--version>

Print out the version of B<postfaq> and exit.

=back

=head1 EXAMPLES

Post the FAQ contained in the file F<faqs/boating>:

    postfaq faqs/boating

Do a dry run, showing what the FAQs would look like when posted for all of
F<faqs/boating>, F<faqs/food>, and F</www/htdocs/faqs/tolkien.txt>:

    postfaq -n faqs/boating faqs/food /www/htdocs/faqs/tolkien.txt

Post all of the FAQs in F<faqs/.posts.01>:

    postfaq -f faqs/.posts.01

I put a command like this in my personal crontab file and then don't have
to change crontab when I add a new FAQ that I post on the 1st of each
month.  I just add the filename to that file.

Post the FAQ contained in the file F<faqs/boating> using IHAVE:

    postfaq -i faqs/boating

In order to do this, you have to have permission to send IHAVE commands to
your local news server.

Post that same FAQ using POST, authenticating with the username C<faq> and
the password C<sekret>:

    postfaq -U faq -P sekret faqs/boating

Post the FAQ contained in the file F<faqs/boating> using an external
program called B<inews>:

    postfaq -p /usr/bin/inews faqs/boating

Normally it's best to let B<postfaq> post directly, but this can be useful
if you have a posting script that does other things (such as adding
PGPMoose signatures or posting via SSL).

=head1 ENVIRONMENT

=over 4

=item HOME

Used to determine the default status directory (F<$HOME/data/faqs>).

=item NNTPSERVER

The default NNTP server to post to, used by the Net::NNTP module.  You can
also use B<-s> to specify the server.

=back

=head1 FILES

=over 4

=item F<$HOME/data/faqs>

This directory (by default; this is set at the top of this script and can
be changed there or with the B<-d> option) is searched for status files
for each FAQ that is posted.  The status file should have the same name as
the file name (without the directory portion) of the FAQ.  This directory
must exist, and the status file will be created on successful posting if
it doesn't already exist.

The first line of the file will be the string used to form the message ID
(the file name of the FAQ by default) and the second line will be the
message ID of the last successful post of that FAQ.

=back

=head1 BUGS

Currently, the only time interval supported for Expires is C<d> for days,
and only one time interval is allowed in the header.  It would be nice to
support something like:

    Expires: 1m 15d

The default status directory works well for me but is likely not ideal for
many other people.

There should be a way to post diffs from the previously posted version of
the FAQ, as this is rather important for some types of FAQs.

There is no way to specify the hostname to use in message IDs if that
shouldn't be the local hostname.

Supporting obtaining credentials from an F<.authinfo> file would be nice.

=head1 SEE ALSO

L<Net::NNTP>

L<http://www.eyrie.org/~eagle/software/postfaq/> will have the current
version of this program.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 1999, 2002, 2003, 2004, 2008, 2013 Russ Allbery
<rra@stanford.edu>

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=cut