From e80ce607f849d6c7b27df82e94831ce92ddeae6c Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 18 Jan 2026 23:50:48 +0100 Subject: [PATCH] Complete rewrite. Signed-off-by: Thomas Hochstein --- .gitignore | 1 - .yapfaqrc.sample | 17 +- ChangeLog | 3 + bin/yapfaq.pl | 571 ++++++++++++++++++++++ data/sample.hdr | 7 + sample.txt => data/sample.txt | 0 yapfaq.cfg.sample | 52 -- yapfaq.pl | 877 ---------------------------------- 8 files changed, 592 insertions(+), 936 deletions(-) delete mode 100644 .gitignore create mode 100755 bin/yapfaq.pl create mode 100644 data/sample.hdr rename sample.txt => data/sample.txt (100%) delete mode 100644 yapfaq.cfg.sample delete mode 100755 yapfaq.pl diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 30404ce..0000000 --- a/.gitignore +++ /dev/null @@ -1 +0,0 @@ -TODO \ No newline at end of file diff --git a/.yapfaqrc.sample b/.yapfaqrc.sample index d8c9b8a..0f894e0 100644 --- a/.yapfaqrc.sample +++ b/.yapfaqrc.sample @@ -1,6 +1,11 @@ -NNTPServer = 'localhost' -NNTPUser = '' -NNTPPass = '' -Sender = '' -ConfigFile = 'yapfaq.cfg.sample' -Program = '' +# config options +# - nntp-server NNTP server name +# - nntp-port NNTP port +# - nntp-user user name for AUTHINFO +# - nntp-pass password for AUTHINFO +# - force-auth force AUTHINFO +# - starttls 1 = use STARTTLS if possible, 0 = don't +# - verbose 1 = show warning messages, 0 = don't +# - debug 1 = show debug output, 0 = don't +nntp-server = localhost +nntp-port = 119 diff --git a/ChangeLog b/ChangeLog index b46f6a7..b18a354 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,6 @@ +yapfaq 1.0.0 (unreleased) +* Complete rewrite. + yapfaq 0.10 (unreleased) * Add: Charset definition. Fixes #29. diff --git a/bin/yapfaq.pl b/bin/yapfaq.pl new file mode 100755 index 0000000..ed6ee62 --- /dev/null +++ b/bin/yapfaq.pl @@ -0,0 +1,571 @@ +#! /usr/bin/perl -w +# +# yapfaq by Thomas Hochstein +# (Original author: Marc Brockschmidt) +# +# containing some code from tinews.pl +# Copyright (c) 2002-2024 Urs Janssen , +# Marc Brockschmidt +# containing some code from pgpverify.pl +# Written April 1996, (David C Lawrence) +# Currently maintained by Russ Allbery +# +# This script posts articles (e.g. FAQs) to Usenet newsgroups. +# Most people will use it in combination with cron(8). +# +# Copyright (C) 2003 Marc Brockschmidt +# Copyright (c) 2010-2017, 2026 Thomas Hochstein +# +# It can be redistributed and/or modified under the same terms under +# which Perl itself is published. + +my $VERSION = "1.0.0"; +(my $NAME = $0) =~ s#^.*/##; + +use utf8; +use strict; +use Encode qw(encode); +use POSIX qw(strftime); +use Net::Domain qw(hostfqdn); +use Net::NNTP; +use DateTime; # CPAN +use Path::Tiny; # CPAN +use Getopt::Long qw(GetOptions); +Getopt::Long::config ('bundling'); + +use Data::Dumper; + +# configuration ####################### +# may be overwritten via ~/.yapfaqrc or command line +my %Config; + +$Config{'datadir'} = 'data/'; # path to data files (FAQs, ...) + +$Config{'nntp-server'} = 'news'; # your NNTP server name, may be set via $NNTPSERVER +$Config{'nntp-port'} = 119; # NNTP-port, may be set via $NNTPPORT +$Config{'nntp-user'} = ''; # username for AUTHINFO +$Config{'nntp-pass'} = ''; # password for AUTHINFO +$Config{'force-auth'} = 0; # set to 1 to force authentification +$Config{'starttls'} = 0; # set to 1 to use STARTTLS if possible + +$Config{'verbose'} = 0; # set to 1 to get warning messages +$Config{'debug'} = 0; # set to 1 to get some debug output, + # set to 2 for NNTP debug output + +# Main program ######################## + +### read configuration +# from (first match counts) +# $XDG_CONFIG_HOME/yapfaqrc +# ~/.config/yapfaqrc +# ~/.yapfaqrc +# if present +# taken and modified from tinews.pl +my $RCFILE = undef; +my (@try, %seen); + +if ($ENV{'XDG_CONFIG_HOME'}) { + push(@try, (glob("$ENV{'XDG_CONFIG_HOME'}/yapfaqrc"))[0]); +} +push(@try, (glob('~/.config/yapfaqrc'))[0], (glob('~/.yapfaqrc'))[0]); + +foreach (grep { ! $seen{$_}++ } @try) { # uniq @try + last if (open($RCFILE, '<', $_)); + $RCFILE = undef; +} +if (defined($RCFILE)) { + while (defined($_ = <$RCFILE>)) { + if (m/^([^#\s=]+)\s*=\s*(\S[^#]+)/io) { + chomp($Config{lc($1)} = $2); + } + } + close($RCFILE); +} + +# these env-vars have higher priority (order is important) +# taken from tinews.pl +$Config{'nntp-server'} = $ENV{'NEWSHOST'} if ($ENV{'NEWSHOST'}); +$Config{'nntp-server'} = $ENV{'NNTPSERVER'} if ($ENV{'NNTPSERVER'}); +$Config{'nntp-port'} = $ENV{'NNTPPORT'} if ($ENV{'NNTPPORT'}); + +### read commandline options +my ($OptProject,$OptForce,$OptTest,$OptNewsgroup,$OptOutput); +GetOptions ('p|project=s' => \$OptProject, + 'f|force' => \$OptForce, + 't|test' => \$OptTest, + 'n|newsgroup=s' => \$OptNewsgroup, + 'o|output' => \$OptOutput, + 'datadir=s' => \$Config{'datadir'}, + 'nntp-server=s' => \$Config{'nntp-server'}, + 'nntp-port=s' => \$Config{'nntp-port'}, + 'nntp-user=s' => \$Config{'nntp-user'}, + 'nntp-pass=s' => \$Config{'nntp-pass'}, + 'starttls!' => \$Config{'starttls'}, + 'force-auth!' => \$Config{'force-auth'}, + 'v|verbose!' => \$Config{'verbose'}, + 'd|debug!' => \$Config{'debug'}, + 'c|config' => \&ShowConf, + 'h|help' => \&ShowPOD, + 'V|version' => \&ShowVersion) or &ShowUsage; + +### create list of @Projects from $Config{'datadir'} unless -p is set +my @Projects; +if (!$OptProject) { + die "E: Data directory '" . $Config{'datadir'} . "' does not exist.\n" unless (-d $Config{'datadir'}); + @Projects = glob $Config{'datadir'} . '*.hdr'; + foreach (@Projects) { + $_ =~ s#^.*/##; + $_ =~ s/\.hdr$//; + } +} else { + push @Projects, $OptProject; +} + +### iterate over @Projects +print "- Test mode, no status updates.\n" if $Config{'debug'}; +foreach (@Projects) { + # check for existence of project + my $HeaderFile = $Config{'datadir'} . "$_.hdr"; + if (not -r $HeaderFile) { + warn "W: Project '$_' does not exist ('$HeaderFile' not found).\n"; + next; + } + + print "Project '$_' ...\n" if $Config{'verbose'} or $Config{'debug'}; + # generate posting and check for due date + # @Posting will be empty ('') if not due + my @Posting = &BuildPosting($_); + next if !$#Posting; + + # save Message-ID + my $LastMID; + foreach (@Posting) { + if (/^Message-ID: /) { + ($LastMID = $_) =~ s/^Message-ID:\s+//; + chomp ($LastMID); + last; + } + } + + # sent to STDOUT due to --output + if ($OptOutput) { + print "- Print to STDTOUT.\n----->----->----->-----\n" if $Config{'debug'}; + foreach (@Posting) { + print $_ + }; + print "-----<-----<-----<-----\n" if $Config{'debug'}; + # otherwise: post + } else { + next if !&PostNNTP(@Posting); + } + + # update status + &UpdateStatus($_, $LastMID) if !$OptTest; +} + +### we're done +exit(0); + +# subroutines ######################### + +### ------------------------------------------------------------------ +### display version information and exit +sub ShowVersion { + print "$NAME v$VERSION\n"; + print "Copyright (C) 2003 Marc Brockschmidt \n"; + print "Copyright (c) 2010-2017, 2026 Thomas Hochstein \n"; + print "This program is free software; you may redistribute it ". + "and/or modify it under the same terms as Perl itself.\n"; + exit(0); +}; + +### ------------------------------------------------------------------ +### feed myself to perldoc and exit +sub ShowPOD { + exec('perldoc', $0); + exit(0); +}; + +### ------------------------------------------------------------------ +### Show current configuration +sub ShowConf { + print "$NAME v$VERSION\n"; + print "Current configuration:\n"; + foreach my $config (sort keys %Config) { + printf("- %s: %s\n", $config, $Config{$config}) if $Config{$config}; + } +}; + +### ------------------------------------------------------------------ +### display short usage information +sub ShowUsage { + print "$NAME v$VERSION\n"; + print "Usage: " . $NAME . " [OPTIONS]\n"; + print " -p project run on project only, don't use all projects\n"; + print " -f post unconditionally, even if project(s) is/are not due\n"; + print " -t don't update project status (test)\n"; + print " -n newsgroup post only to newsgroup (for testing)\n"; + print " -o print to STDOUT (for testing or to pipe into inews)\n"; + print " --datadir path override \$datadir\n"; + print " --nntp-server name override \$nntp-server\n"; + print " --nntp-port port override \$nntp-port\n"; + print " --nntp-user user override \$nntp-user\n"; + print " --nntp-pass passwd override \$nntp-pass\n"; + print " --[no-]starttls override \$starttls\n"; + print " --[no-]force-auth override \$force-auth\n"; + print " -v | --[no-]verbose override \$verbose\n"; + print " -d | --[no-]debug override \$debug\n"; + print " -c show current configuration\n"; + print " -h show documentation\n"; + print " -V show version and copyright\n"; + exit 0; +} + +### ------------------------------------------------------------------ +### parse a YYYY-MM-DD construct to a DateTime object +sub ParseDate { + my $Date = shift; + die "E: '$Date' is not a valid date format.\n" unless $Date =~ /^\d\d\d\d-\d\d-\d\d$/; + my ($Year, $Month, $Day) = split /-/, $Date; + return DateTime->new(year => $Year, + month => $Month, + day => $Day, + ); +} + +### ------------------------------------------------------------------ +### add a duration (in d,w,m,y) to a DateTime object +sub AddDuration { + my($Date, $Duration) = @_; + $Duration =~ /(\d+)(.)/; + my ($Amount, $Timespan) = ($1, lc($2)); + if ($Timespan eq 'd') { + $Date->add(days => $Amount); + } + elsif ($Timespan eq 'w') { + $Date->add(days => $Amount * 7); + } + elsif ($Timespan eq 'm') { + $Date->add(months => $Amount); + } + elsif ($Timespan eq 'y') { + $Date->add(years => $Amount); + } + return $Date; +} + +### ------------------------------------------------------------------ +### return a hash of all headers (ignoring duplicate headers) +# taken and modified from tinews.pl +sub ParseHeaders { + my @Headers = @_; + my (%Header, $Label, $Value); + foreach (@Headers) { + s/\r?\n$//; + + last if /^$/; + + if (/^(\S+):[ \t](.+)/) { + ($Label, $Value) = ($1, $2); + # discard all duplicate headers + next if $Header{lc($Label)}; + $Header{lc($Label)} = $Value; + } elsif (/^\s/) { + # continuation lines + if ($Label) { + s/^\s+/ /; + $Header{lc($Label)} .= $_; + } else { + warn (sprintf("W: Non-header line: %s\n",$_)); + } + } else { + warn (sprintf("W: Non-header line: %s\n",$_)); + } + } + return %Header; +}; + +### ------------------------------------------------------------------ +### open NNTP connection, authenticate and return a Net::NNTP-Object +# taken and modified from tinews.pl +sub ConnectNNTP { + my $NNTP = Net::NNTP->new( + Host => $Config{'nntp-server'}, + Reader => 1, + Debug => $Config{'debug'}, + Port => $Config{'nntp-port'}, + SSL_verify_mode => 0, + ) + or die("E: Can't connect to ".$Config{'nntp-server'}.":".$Config{'nntp-port'}.".\n"); + + my $NNTPMsg = $NNTP->message(); + my $NNTPCode = $NNTP->code(); + + if ($Config{'starttls'} && $NNTP->can_ssl()) { + $NNTP->starttls; + } + + if ($Config{'debug'}) { + print '- Connected to ' . $NNTP->peerhost . ':' . $NNTP->peerport . "\n"; + if ($Config{'starttls'}) { + printf(" SSL-Fingerprint: %s %s\n", split(/\$/, $NNTP->get_fingerprint)); + } + } + + # no read and/or write access - give up + if ($NNTPCode < 200 || $NNTPCode > 201) { + $NNTP->quit(); + } + + # read access - try to authenticate + if ($NNTPCode == 201 || $Config{'force-auth'}) { + # no user/password + if (!$Config{'nntp-user'} || !$Config{'nntp-pass'}) { + $NNTP->quit(); + die('E: ' . $NNTPCode . ' ' . $NNTPMsg . "\n"); + } + $NNTP = &AuthNNTP($NNTP); + } + + # try posting; on failure, try to authenticate + $NNTP->post(); + $NNTPCode = $NNTP->code(); + if ($NNTPCode == 480) { + $NNTP = &AuthNNTP($NNTP); + $NNTP->post(); + } + + return $NNTP; +} + +### ------------------------------------------------------------------ +### do AUTHINFO on a Net::NNTP-Object, die on failure +# taken and modified from tinews.pl +sub AuthNNTP { + my $NNTP = shift; + + $NNTP->authinfo($Config{'nntp-user'}, $Config{'nntp-pass'}); + my $NNTPMsg = $NNTP->message(); + my $NNTPCode = $NNTP->code(); + if ($NNTPCode != 281) { # auth failed + $NNTP->quit(); + die('E: ' . $NNTPCode . ' ' . $NNTPMsg . "\n"); + } + + return $NNTP; +} + +### ------------------------------------------------------------------ +### build posting +# read and parser header and body from files +# read status file, check due date +sub BuildPosting { + my $Project = shift; + my $StatusFile = $Config{'datadir'} . "$Project.cfg"; + my $HeaderFile = $Config{'datadir'} . "$Project.hdr"; + my $BodyFile = $Config{'datadir'} . "$Project.txt"; + if (not -r $BodyFile) { + warn "W: '$BodyFile' not found.\n"; + return ''; + } + + # read status file, if available + my($LastPosted, $LastMID); + if (-r $StatusFile) { + print "- Reading status ($Project.cfg).\n" if $Config{'debug'}; + my @Status = path($StatusFile)->lines_utf8; + foreach (@Status) { + # convert Windows line-endings to Unix + s/\r//; + if (/^Last-posted: /i) { + chomp; + ($LastPosted = $_) =~ s/^Last-posted:\s+//i; + } elsif (/^Last-Message-ID: /i) { + chomp; + ($LastMID = $_) =~ s/^Last-Message-ID:\s+//i; + } + } + } else { + print "- No status file ($Project.cfg).\n" if $Config{'debug'}; + } + + print "- Reading headers ($Project.hdr) and body ($Project.txt).\n" if $Config{'debug'}; + my @Headers = path($HeaderFile)->lines_utf8; + my @Body = path($BodyFile)->lines_utf8; + my %Header = &ParseHeaders(@Headers); + + # check for mandatory headers + if (!$Header{'from'} or !$Header{'subject'} or !$Header{'newsgroups'}) { + warn "W: From, Subject or Newsgroups header missing from '$HeaderFile'.\n"; + return ''; + } + + # add Date: + push @Headers, 'Date: ' . DateTime->now->strftime('%a, %d %b %Y %H:%M:%S %z') . "\n"; + # add missing Message-ID: + push @Headers, 'Message-ID: <%n-%y-%m-%d@' . hostfqdn. ">\n" if (!$Header{'message-id'}); + # add User-Agent + push @Headers, "User-Agent: $NAME/$VERSION\n"; + + # parse pseudo headers from body + my ($InRealBody,$LastModified,$PostingFrequency); + foreach (@Body) { + # convert Windows line-endings to Unix + s/\r//; + next if $InRealBody; + $InRealBody++ if /^$/; + $LastModified = $1 if /^Last-modified:\s*(\S+)\s*$/i; + $PostingFrequency = $1 if /^Posting-Frequency:\s*(\S+)\s*$/i; + } + # parse Posting-Frequency from pseudo-header + if ($PostingFrequency) { + print "- Posting-Frequency set to $PostingFrequency from pseudo-header.\n" if $Config{'debug'}; + if ($PostingFrequency eq 'daily') { + $PostingFrequency = '1d'; + } elsif ($PostingFrequency eq 'weekly') { + $PostingFrequency = '1w'; + } elsif ($PostingFrequency =~ /bi-?weekly/) { + $PostingFrequency = '2w'; + } elsif ($PostingFrequency eq 'monthly') { + $PostingFrequency = '1m'; + } elsif ($PostingFrequency =~ /bi-?monthly/) { + $PostingFrequency = '2m'; + } + } + + # parse placeholders in headers + foreach (@Headers) { + # convert Windows line-endings to Unix + s/\r//; + # drop empty header + $_ = '' if /^$/; + # Replace %LM placeholder in Subject: with the Last-modified: pseudo-header + if (/^Subject: /) { + if ($LastModified) { + $_ =~ s/\%LM/$LastModified/g; + } else { + $_ =~ s/ ?[<\[{\(]?\%LM[>\]}\)]? ?//; + } + } + # Replace placeholders in Message-ID: + # %n project name + # %y current year + # %m current month + # %d current day + # %p PID + if (/^Message-ID: /i) { + my $TDY = DateTime->now->strftime('%Y'); + my $TDM = DateTime->now->strftime('%m'); + my $TDD = DateTime->now->strftime('%d'); + $_ =~ s/\%n/$Project/g; + $_ =~ s/\%y/$TDY/g; + $_ =~ s/\%m/$TDM/g; + $_ =~ s/\%d/$TDD/g; + $_ =~ s/\%p/$$/g; + # add random part in test mode + if ($OptTest) { + my $random = sprintf("%08X", rand(0xFFFFFFFF)); + $_ =~ s/now,$_)->strftime('%a, %d %b %Y %H:%M:%S %z') . "\n"; + } + # add Supersedes: if set + if (/^Supersedes: /) { + if ($LastMID && !$OptTest) { + $_= "Supersedes: $LastMID\n"; + } else { + $_ = ''; + } + } + # overwrite Newsgroups: if --newsgroup is set + if ($OptNewsgroup && /^Newsgroups: /) { + print "- 'Newsgroups: $OptNewsgroup' has been set.\n" if $Config{'debug'}; + $_= "Newsgroups: $OptNewsgroup\n"; + } + # get Posting-Frequency + if (/^Posting-Frequency: /i) { + chomp; + $_ =~ s/^Posting-Frequency:\s+//i; + $PostingFrequency = $_; + $_ = ''; + print "- Posting-Frequency set to $PostingFrequency.\n" if $Config{'debug'}; + } + } + + # not due if Posting-Freqency is "none" + if ($PostingFrequency =~ /none/) { + print "... is disabled.\n" if $Config{'verbose'} or $Config{'debug'}; + return ''; + } + + # default to 1 month if no (valid) Posting-Frequency is set + $PostingFrequency = '1m' if $PostingFrequency !~ /^\d+[dwmy]$/; + + # check if posting is due + print "- Posting has been forced.\n" if $Config{'debug'} && $OptForce; + if ($OptForce or (!$LastPosted) or ($LastPosted && &AddDuration(&ParseDate($LastPosted),$PostingFrequency) <= DateTime->now)) { + print "... is due and will be posted.\n" if $Config{'verbose'} or $Config{'debug'}; + } else { + print "... is not due.\n" if $Config{'verbose'} or $Config{'debug'}; + return ''; + } + + # return posting + return @Headers, "\n", @Body; +} + +### ------------------------------------------------------------------ +### post via NNTP +# taken and modified from tinews.pl +sub PostNNTP { + my @Posting = @_; + + my $NNTP = ConnectNNTP(); + my $NNTPMsg = $NNTP->message(); + my $NNTPCode = $NNTP->code(); + print "- Post article.\n" if $Config{'debug'}; + if ($NNTPCode == 340) { + $NNTP->datasend(@Posting); + ## buggy Net::Cmd < 2.31 + $NNTP->set_status(200, ""); + $NNTP->dataend(); + $NNTPMsg = $NNTP->message(); + $NNTPCode = $NNTP->code(); + if (! $NNTP->ok()) { + $NNTP->quit(); + warn("W: Posting failed! Response from server:\n", $NNTPCode, ' ', $NNTPMsg); + return 0; + } + } else { + $NNTP->quit(); + warn("W: Posting failed! Response from server:\n", $NNTPCode, ' ', $NNTPMsg); + return 0; + } + $NNTP->quit(); + print "- Done.\n" if $Config{'debug'}; + return 1; +} + +### ------------------------------------------------------------------ +### update status (last posted, last mid) +sub UpdateStatus { + my ($Project, $LastMID) = @_; + my $StatusFile = $Config{'datadir'} . "$Project.cfg"; + my @Status; + + push @Status, "Last-Posted: " . DateTime->now->strftime('%Y-%m-%d') . "\n"; + push @Status, "Last-Message-ID: $LastMID\n"; + + $StatusFile = path($StatusFile); + $StatusFile->spew_utf8(@Status); + + print "- Status updated.\n" if $Config{'debug'}; + return; +} + diff --git a/data/sample.hdr b/data/sample.hdr new file mode 100644 index 0000000..3572a3d --- /dev/null +++ b/data/sample.hdr @@ -0,0 +1,7 @@ +From: John Doe +Subject: <%LM> test noreply ignore +Newsgroups: local.test +Message-ID: <%n-%y-%m-%d@domain.invalid> +Posting-frequency: 1d +Expires: 3m +Supersedes: yes diff --git a/sample.txt b/data/sample.txt similarity index 100% rename from sample.txt rename to data/sample.txt diff --git a/yapfaq.cfg.sample b/yapfaq.cfg.sample deleted file mode 100644 index a25d50f..0000000 --- a/yapfaq.cfg.sample +++ /dev/null @@ -1,52 +0,0 @@ -# name of your project -Name = 'sample' - -# file to post (complete body and pseudo-headers) -# ($File.cfg contains data on last posting and last MID) -File = 'sample.txt' - -# how often your project should be posted -# use (d)ay OR (w)eek OR (m)onth OR (y)ear -Posting-frequency = '1d' - -# time period after which the posting should expire -# use (d)ay OR (w)eek OR (m)onth OR (y)ear -# This setting is optional. Default: 3m -# Expires = '3m' - -# header "From:" -From = 'John Doe ' - -# header "Subject:" -# (may contain "%LM" which will be replaced by the contents of the -# Last-Modified pseudo header). -Subject = 'test noreply ignore' - -# comma-separated list of newsgroup(s) to post to -# (header "Newsgroups:") -NGs = 'de.test' - -# header "Followup-To:" -# This setting is optional. Default: unset -# Fup2 = 'poster' - -# Message-ID ("%n" is $Name) -# This setting is optional. Default: <%n-%y-%m-%d@YOURHOST> -# MID-Format = '<%n-%y-%m-%d@domain.invalid>' - -# Character Encoding -# This setting is optional. Default: UTF-8 -# Charset = ISO-8859-15 - -# Supersede last posting? -# This setting is optional. Default: unset -Supersede = yes - -# extra headers (appended verbatim) -# use this for custom headers like "Approved:" -# This setting is optional. Default: unset -ExtraHeader = 'Approved: moderator@domain.invalid -X-Header: Some text' - -# other projects may follow separated with "=====" -# ===== diff --git a/yapfaq.pl b/yapfaq.pl deleted file mode 100755 index 60d58d4..0000000 --- a/yapfaq.pl +++ /dev/null @@ -1,877 +0,0 @@ -#! /usr/bin/perl -W -# -# yapfaq Version 0.10 by Thomas Hochstein -# (Original author: Marc Brockschmidt) -# -# This script posts any project described in its config-file. Most people -# will use it in combination with cron(8). -# -# Copyright (C) 2003 Marc Brockschmidt -# Copyright (c) 2010-2017 Thomas Hochstein -# -# It can be redistributed and/or modified under the same terms under -# which Perl itself is published. - -our $VERSION = "0.10"; - -# Please do not change this setting! -# You may override the default .rc file (.yapfaqrc) by using "-c .rc file" -my $RCFile = '.yapfaqrc'; -# Valid configuration variables for use in a .rc file -my @ValidConfVars = ('NNTPServer','NNTPUser','NNTPPass','Sender','ConfigFile','Program'); - -################################### Defaults ################################### -# Please do not change anything in here! -# Use a runtime configuration file (.yapfaqrc by default) to override defaults. -my %Config = (NNTPServer => "", - NNTPUser => "", - NNTPPass => "", - Sender => "", - ConfigFile => "yapfaq.cfg", - Program => ""); - -################################# Main program ################################# - -use strict; -use Net::NNTP; -use Net::Domain qw(hostfqdn); -use Date::Calc qw(Add_Delta_YM Add_Delta_Days Delta_Days Today); -use Getopt::Std; -$Getopt::Std::STANDARD_HELP_VERSION = 1; -my ($TDY, $TDM, $TDD) = Today(); #TD: Today's date - -# read commandline options -my %Options; -getopts('Vhvpdt:f:c:s:', \%Options); -# -V: print version / copyright information -if ($Options{'V'}) { - print "$0 v $VERSION\nCopyright (c) 2003 Marc Brockschmidt \nCopyright (c) 2010-2017 Thomas Hochstein \n"; - print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n"; - exit(0); -} -# -h: feed myself to perldoc -if ($Options{'h'}) { - exec ('perldoc', $0); - exit(0); -}; -# -f: set $Faq -my ($Faq) = $Options{'f'} if ($Options{'f'}); - -# read runtime configuration (configuration variables) -$RCFile = $Options{'c'} if ($Options{'c'}); -if (-f $RCFile) { - readrc (\$RCFile,\%Config); -} else { - warn "$0: W: .rc file $RCFile does not exist!\n"; -} - -$Options{'s'} = $Config{'Program'} if (defined($Config{'Program'}) && $Config{'Program'} && !defined($Options{'s'})); - -# read configuration (configured FAQs) -my @Config; -readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq); - -# for each FAQ: -# - parse configuration -# - read status data -# - if FAQ is due: call postfaq() -foreach (@Config) { - my ($LPD,$LPM,$LPY) = (01, 01, 0001); #LP: Last posting-date - my ($NPY,$NPM,$NPD); #NP: Next posting-date - my $SupersedeMID; - - my ($ActName,$File,$PFreq,$Expire) =($$_{'name'},$$_{'file'},$$_{'posting-frequency'},$$_{'expires'}); - my ($From,$Subject,$NG,$Fup2)=($$_{'from'},$$_{'subject'},$$_{'ngs'},$$_{'fup2'}); - my ($MIDF,$ReplyTo,$Charset,$ExtHea)=($$_{'mid-format'},$$_{'reply-to'},$$_{'charset'},$$_{'extraheader'}); - my ($Supersede) =($$_{'supersede'}); - - # -f: loop if not FAQ to post - next if (defined($Faq) && $ActName ne $Faq); - - # read status data - if (open (FH, "<$File.cfg")) { - while(){ - if (/##;; Lastpost:\s*(\d{1,2})\.(\d{1,2})\.(\d{2}(\d{2})?)/){ - ($LPD, $LPM, $LPY) = ($1, $2, $3); - } elsif (/^##;;\s*LastMID:\s*(<\S+@\S+>)\s*$/) { - $SupersedeMID = $1; - } - } - close FH; - } else { - warn "$0: W: Couldn't open $File.cfg: $!\n"; - } - - $SupersedeMID = "" unless $Supersede; - - ($NPY,$NPM,$NPD) = calcdelta ($LPY,$LPM,$LPD,$PFreq); - - # if FAQ is due: get it out - if (Delta_Days($NPY,$NPM,$NPD,$TDY,$TDM,$TDD) >= 0 or ($Options{'p'})) { - if($Options{'d'}) { - print "$ActName: Would be posted now (but running in simulation mode [$0 -d]).\n" if $Options{'v'}; - } else { - postfaq(\$ActName,\$File,\$From,\$Subject,\$NG,\$Fup2,\$MIDF,\$Charset,\$ExtHea,\$Config{'Sender'},\$TDY,\$TDM,\$TDD,\$ReplyTo,\$SupersedeMID,\$Expire); - } - } elsif($Options{'v'}) { - print "$ActName: Nothing to do.\n"; - } -} - -exit; - -#################################### readrc #################################### -# Takes a filename and the reference to an array which contains the valid options - -sub readrc{ - my ($File, $Config) = @_; - - print "Reading $$File.\n" if($Options{'v'}); - - open FH, "<$$File" or die "$0: Can't open $$File: $!"; - while () { - if (/^\s*(\S+)\s*=\s*'?(.*?)'?\s*(#.*$|$)/) { - if (grep(/$1/,@ValidConfVars)) { - $$Config{$1} = $2 if $2 ne ''; - } else { - warn "$0: W: $1 is not a valid configuration variable (reading from $$File)\n"; - } - } - } -} - -################################## readconfig ################################## -# Takes a filename, a reference to an array, which will hold hashes with -# the data from $File, and - optionally - the name of the (single) FAQ to post - -sub readconfig{ - my ($File, $Config, $Faq) = @_; - my ($LastEntry, $Error, $i) = ('','',0); - - print "Reading configuration from $$File.\n" if($Options{'v'}); - - open FH, "<$$File" or die "$0: E: Can't open $$File: $!"; - while () { - next if (defined($$Faq) && !/^\s*=====\s*$/ && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq ); - if (/^(\s*(\S+)\s*=\s*'?(.*?)'?\s*(#.*$|$)|^(.*?)'?\s*(#.*$|$))/ && not /^\s*$/) { - $LastEntry = lc($2) if $2; - $$Config[$i]{$LastEntry} .= $3 if $3; - $$Config[$i]{$LastEntry} .= "\n$5" if $5 && $5; - } - if (/^\s*=====\s*$/) { - $i++; - } - } - close FH; - - #Check saved values: - for $i (0..$i){ - next if (defined($$Faq) && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq ); - unless(defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} =~ /^\S+$/) { - $Error .= "E: The name of your project \"$$Config[$i]{'name'}\" is not defined or contains whitespaces.\n" - } - unless(defined($$Config[$i]{'file'}) && -f $$Config[$i]{'file'}) { - $Error .= "E: The file to post for your project \"$$Config[$i]{'name'}\" is not defined or does not exist.\n" - } - unless(defined($$Config[$i]{'from'}) && $$Config[$i]{'from'} =~ /\S+\@(\S+\.)?\S{2,}\.\S{2,}/) { - $Error .= "E: The From header for your project \"$$Config[$i]{'name'}\" seems to be incorrect.\n" - } - unless(defined($$Config[$i]{'ngs'}) && $$Config[$i]{'ngs'} =~ /^\S+$/) { - $Error .= "E: The Newsgroups header for your project \"$$Config[$i]{'name'}\" is not defined or contains whitespaces.\n" - } - unless(defined($$Config[$i]{'subject'})) { - $Error .= "E: The Subject header for your project \"$$Config[$i]{'name'}\" is not defined.\n" - } - unless(!$$Config[$i]{'fup2'} || $$Config[$i]{'fup2'} =~ /^\S+$/) { - $Error .= "E: The Followup-To header for your project \"$$Config[$i]{'name'}\" contains whitespaces.\n" - } - unless(defined($$Config[$i]{'posting-frequency'}) && $$Config[$i]{'posting-frequency'} =~ /^\s*\d+\s*[dwmy]\s*$/) { - $Error .= "E: The Posting-frequency for your project \"$$Config[$i]{'name'}\" is invalid.\n" - } - unless(!$$Config[$i]{'expires'} || $$Config[$i]{'expires'} =~ /^\s*\d+\s*[dwmy]\s*$/) { - warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" is invalid - set to 3 month.\n"; - $$Config[$i]{'expires'} = '3m'; # set default (3 month) if expires is unset or invalid - } - unless(!$$Config[$i]{'mid-format'} || $$Config[$i]{'mid-format'} =~ /^<\S+\@(\S+\.)?\S{2,}\.\S{2,}>/) { - warn "$0: W: The Message-ID format for your project \"$$Config[$i]{'name'}\" seems to be invalid - set to default.\n"; - $$Config[$i]{'mid-format'} = '<%n-%y-%m-%d@'.hostfqdn.'>'; # set default if mid-format is invalid - } - } - $Error .= "-" x 25 . 'program terminated' . "-" x 25 . "\n" if $Error; - die $Error if $Error; -} - -################################# calcdelta ################################# -# Takes a date (year, month and day) and a time period (1d, 1w, 1m, 1y, ...) -# and adds the latter to the former - -sub calcdelta { - my ($Year, $Month, $Day, $Period) = @_; - my ($NYear, $NMonth, $NDay); - - if ($Period =~ /(\d+)\s*([dw])/) { # Is counted in days or weeks: Use Add_Delta_Days. - ($NYear, $NMonth, $NDay) = Add_Delta_Days($Year, $Month, $Day, (($2 eq "w")?$1 * 7: $1 * 1)); - } elsif ($Period =~ /(\d+)\s*([my])/) { #Is counted in months or years: Use Add_Delta_YM - ($NYear, $NMonth, $NDay) = Add_Delta_YM($Year, $Month, $Day, (($2 eq "m")?(0,$1):($1,0))); - } - return ($NYear, $NMonth, $NDay); -} - -################################ updatestatus ############################### -# Takes a MID and a status file name -# and writes status information to disk - -sub updatestatus { - my ($ActName, $File, $date, $MID) = @_; - - print "$$ActName: Save status information.\n" if($Options{'v'}); - - open (FH, ">$$File.cfg") or die "$0: E: Can't open $$File.cfg: $!"; - print FH "##;; Lastpost: $date\n"; - print FH "##;; LastMID: $MID\n"; - close FH; -} - -################################## postfaq ################################## -# Takes a filename and many other vars. -# -# It reads the data-file $File and then posts the article. - -sub postfaq { - my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$Charset,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_; - my (@Header,@Body,$MID,$InRealBody,$LastModified); - - print "$$ActName: Preparing to post.\n" if($Options{'v'}); - - #Prepare MID: - $$TDM = ($$TDM < 10 && $$TDM !~ /^0/) ? "0" . $$TDM : $$TDM; - $$TDD = ($$TDD < 10 && $$TDD !~ /^0/) ? "0" . $$TDD : $$TDD; - my $Timestamp = time; - - $MID = $$MIDF; - $MID = '<%n-%y-%m-%d@'.hostfqdn.'>' if !defined($MID); # set to default if unset - $MID =~ s/\%n/$$ActName/g; - $MID =~ s/\%d/$$TDD/g; - $MID =~ s/\%m/$$TDM/g; - $MID =~ s/\%y/$$TDY/g; - $MID =~ s/\%t/$Timestamp/g; - - #Now get the body: - open (FH, "<$$File"); - while (){ - s/\r//; - push (@Body, $_), next if $InRealBody; - $InRealBody++ if /^$/; - $LastModified = $1 if /^Last-modified:\s*(\S+)\s*$/i; - push @Body, $_; - } - close FH; - push @Body, "\n" if ($Body[-1] ne "\n"); - - #Create Date- and Expires-Header: - my @time = localtime; - my $ss = ($time[0]<10) ? "0" . $time[0] : $time[0]; - my $mm = ($time[1]<10) ? "0" . $time[1] : $time[1]; - my $hh = ($time[2]<10) ? "0" . $time[2] : $time[2]; - my $day = $time[3]; - my $month = ($time[4]+1<10) ? "0" . ($time[4]+1) : $time[4]+1; - my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]]; - my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]]; - my $year = (1900 + $time[5]); - my $tz = $time[8] ? " +0200" : " +0100"; - - $$Expire = '3m' if !$$Expire; # set default if unset: 3 month - - my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire); - my $expmonthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$expM-1]; - - my $date = "$day $monthN $year " . $hh . ":" . $mm . ":" . $ss . $tz; - my $expdate = "$expD $expmonthN $expY $hh:$mm:$ss$tz"; - - #Replace %LM by the content of the news.answer-pseudo-header Last-modified: - if ($LastModified) { - $$Subject =~ s/\%LM/$LastModified/; - } else { - $$Subject =~ s/[<\[{\(]?\%LM[>\]}\)]?//; - } - - # Set Charset - $$Charset = 'UTF-8' if !$$Charset; - my $ContentType = sprintf('text/plain; charset=%s',$$Charset); - - # Test mode? - if($Options{'t'} and $Options{'t'} !~ /console/i) { - $$NG = $Options{'t'}; - $MID =~ s/@/-$Timestamp-test@/g; - $$ExtraHeaders .= "\n" if $$ExtraHeaders; - $$ExtraHeaders .= "X-Supersedes: $$Supersedes\n" if $$Supersedes; - $$ExtraHeaders .= "X-yapfaq-Remark: This is only a test message."; - undef $$Supersedes; - } - - #Now create the complete Header: - push @Header, "From: $$From\n"; - push @Header, "Newsgroups: $$NG\n"; - push @Header, "Followup-To: $$Fup2\n" if $$Fup2; - push @Header, "Subject: $$Subject\n"; - push @Header, "Message-ID: $MID\n"; - push @Header, "Supersedes: $$Supersedes\n" if $$Supersedes; - push @Header, "Date: $date\n"; - push @Header, "Expires: $expdate\n"; - push @Header, "Sender: $$Sender\n" if $$Sender; - push @Header, "Mime-Version: 1.0\n"; - push @Header, "Reply-To: $$ReplyTo\n" if $$ReplyTo; - push @Header, "Content-Type: $ContentType\n"; - push @Header, "Content-Transfer-Encoding: 8bit\n"; - push @Header, "User-Agent: yapfaq/$VERSION\n"; - if ($$ExtraHeaders) { - push @Header, "$_\n" for (split /\n/, $$ExtraHeaders); - } - - my @Article = (@Header, "\n", @Body); - - # post article - print "$$ActName: Posting article ...\n" if($Options{'v'}); - my $failure = post(\@Article); - - if ($failure) { - print "$$ActName: Posting failed, ERROR.dat may have more information.\n" if($Options{'v'} && (!defined($Options{'t'}) || $Options{'t'} !~ /console/i)); - } else { - updatestatus($ActName, $File, "$day.$month.$year", $MID) if !defined($Options{'t'}); - } -} - -################################## post ################################## -# Takes a complete article (Header and Body). -# -# It opens a connection to $NNTPServer and posts the message. - -sub post { - my ($ArticleR) = @_; - my ($failure) = -1; - - # test mode - print article to console - if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) { - print "-----BEGIN--------------------------------------------------\n"; - print @$ArticleR; - print "------END---------------------------------------------------\n"; - # pipe article to script - } elsif(defined($Options{'s'})) { - open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n"; - print POST @$ArticleR; - close POST; - if ($? == 0) { - $failure = 0; - } else { - warn "$0: W: $Options{'s'} exited with status ", ($? >> 8), "\n"; - $failure = $?; - } - # post article - } else { - my $NewsConnection = Net::NNTP->new($Config{'NNTPServer'}, Reader => 1) or die "$0: E: Can't connect to news server '$Config{'NNTPServer'}'!\n"; - $NewsConnection->authinfo ($Config{'NNTPUser'}, $Config{'NNTPPass'}) if (defined($Config{'NNTPUser'})); - $NewsConnection->post(); - $NewsConnection->datasend (@$ArticleR); - $NewsConnection->dataend(); - - if ($NewsConnection->ok()) { - $failure = 0; - # Posting failed? Save to ERROR.dat - } else { - warn "$0: W: Posting failed!\n"; - open FH, ">>ERROR.dat"; - print FH "\nPosting failed! Saving to ERROR.dat. Response from news server:\n"; - print FH $NewsConnection->code(); - print FH $NewsConnection->message(); - print FH "\n"; - print FH @$ArticleR; - print FH "-" x 80, "\n"; - close FH; - } - $NewsConnection->quit(); - } - return $failure; -} - -__END__ - -################################ Documentation ################################# - -=head1 NAME - -yapfaq - Post Usenet FAQs I<(yet another postfaq)> - -=head1 SYNOPSIS - -B [B<-Vhvpd>] [B<-t> I | CONSOLE] [B<-f> I] [B<-s> I] [B<-c> I<.rc file>] - -=head1 REQUIREMENTS - -=over 2 - -=item - - -Perl 5.8 or later - -=item - - -Net::NNTP - -=item - - -Date::Calc - -=item - - -Getopt::Std - -=back - -Furthermore you need access to a news server to actually post FAQs. - -=head1 DESCRIPTION - -B posts (one or more) FAQs to Usenet with a certain posting -frequency (every n days, weeks, months or years), adding all necessary -headers as defined in its config file (by default F). - -=head2 Configuration - -F consists of one or more blocks, separated by C<=====> on -a single line, each containing the configuration for one FAQ as a set -of definitions in the form of I. Everything after a "#" -sign is ignored so you may comment your configuration file. - -=over 4 - -=item B = I - -A name referring to your FAQ, also used for generation of a Message-ID. - -This value must be set. - -=item B = I - -A file containing the message body of your FAQ and all pseudo headers -(subheaders in the news.answers style). - -This value must be set. - -=item B = I