#! /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