X-Git-Url: https://code.th-h.de/?p=usenet%2Fyapfaq.git;a=blobdiff_plain;f=yapfaq.pl;h=c36be30b1bb81905fdc59eb2a4e3a8682b8a904d;hp=ac9764e296dfa14d954260ebdc00113afbdc5149;hb=b855559ee3a4f17afc052fdb8edd1b022181eb67;hpb=c2cafcca0009684fc16c87776cf5d62b74863ae5 diff --git a/yapfaq.pl b/yapfaq.pl index ac9764e..c36be30 100644 --- a/yapfaq.pl +++ b/yapfaq.pl @@ -12,7 +12,7 @@ # It can be redistributed and/or modified under the same terms under # which Perl itself is published. -my $Version = "0.6-unreleased"; +my $Version = "0.6.2"; my $NNTPServer = "localhost"; my $NNTPUser = ""; @@ -52,22 +52,37 @@ my @PGPorderheaders = ('from', 'newsgroups', 'subject', 'control', use strict; use Net::NNTP; +use Net::Domain qw(hostfqdn); use Date::Calc qw(Add_Delta_YM Add_Delta_Days Delta_Days Today); use Fcntl ':flock'; # import LOCK_* constants use Getopt::Std; my ($TDY, $TDM, $TDD) = Today(); #TD: Today's date +# read commandline options my %Options; -getopts('hvpdt:f:', \%Options); +getopts('Vhvpdt:f:s:', \%Options); +# -V: print version / copyright information +if ($Options{'V'}) { + print "$0 v $Version\nCopyright (c) 2003 Marc Brockschmidt \nCopyright (c) 2010 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'}) { - print "$0 v $Version\nUsage: $0 [-hvpd] [-t ] [-f ]\n"; + exec ('perldoc', $0); exit(0); }; +# -f: set $Faq my ($Faq) = $Options{'f'} if ($Options{'f'}); +# read configuration (configured FAQs) my @Config; readconfig (\$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 @@ -78,8 +93,10 @@ foreach (@Config) { my ($MIDF,$ReplyTo,$ExtHea)=($$_{'mid-format'},$$_{'reply-to'},$$_{'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})?)/){ @@ -97,6 +114,7 @@ foreach (@Config) { ($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'}; @@ -118,9 +136,7 @@ sub readconfig{ my ($File, $Config, $Faq) = @_; my ($LastEntry, $Error, $i) = ('','',0); - if($Options{'v'}) { - print "Reading configuration.\n"; - } + print "Reading configuration.\n" if($Options{'v'}); open FH, "<$$File" or die "$0: E: Can't open $$File: $!"; while () { @@ -139,24 +155,35 @@ sub readconfig{ #Check saved values: for $i (0..$i){ next if (defined($$Faq) && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq ); - unless($$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]{'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($$Config[$i]{'ngs'} =~ /^\S+$/) { - $Error .= "E: The Newsgroups-header for your project \"$$Config[$i]{'name'}\" 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" + $Error .= "E: The Followup-To header for your project \"$$Config[$i]{'name'}\" contains whitespaces.\n" } - unless($$Config[$i]{'posting-frequency'} =~ /^\s*\d+\s*[dwmy]\s*$/) { + 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'} =~ /^\s*\d+\s*[dwmy]\s*$/) { - $$Config[$i]{'expires'} = '3m'; # set default: 3 month + 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"; } - $Error .= "-" x 25 . "\n" if $Error; + unless(defined($$Config[$i]{'mid-format'}) && $$Config[$i]{'mid-format'} =~ /^<\S+\@\S{2,}\.\S{2,}>$/) { + warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" seems to be invalid - set to default.\n"; + } } + $Error .= "-" x 25 . 'program terminated' . "-" x 25 . "\n" if $Error; die $Error if $Error; } @@ -185,21 +212,19 @@ sub postfaq { my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_; my (@Header,@Body,$MID,$InRealBody,$LastModified); - if($Options{'v'}) { - print "$$ActName: Preparing to post.\n"; - } + 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; $MID = $$MIDF; + $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID); $MID =~ s/\%n/$$ActName/g; $MID =~ s/\%d/$$TDD/g; $MID =~ s/\%m/$$TDM/g; $MID =~ s/\%y/$$TDY/g; - #Now get the body: open (FH, "<$$File"); while (){ @@ -223,7 +248,9 @@ sub postfaq { 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]; @@ -259,16 +286,18 @@ sub postfaq { push @Header, "$_\n" for (split /\n/, $$ExtraHeaders); } + # sign article if $UsePGP is true my @Article = ($UsePGP)?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body); - if($Options{'v'}) { - print "$$ActName: Posting article ...\n"; - } + # post article + print "$$ActName: Posting article ...\n" if($Options{'v'}); post(\@Article); - if($Options{'v'}) { - print "$$ActName: Save status information.\n"; - } + # Test mode? + return if($Options{'t'}); + + # otherwise: update status data + 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: $day.$month.$year\n"; @@ -286,20 +315,29 @@ sub post { # Test mode? if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) { - print "\n-----BEGIN--------------------------------------------------\n"; + print "-----BEGIN--------------------------------------------------\n"; print @$ArticleR; - print "\n------END---------------------------------------------------\n"; + print "------END---------------------------------------------------\n"; return; } + # pipe to script? + if(defined($Options{'s'})) { + open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n"; + print POST @$ArticleR; + close POST; + return; + } + my $NewsConnection = Net::NNTP->new($NNTPServer, Reader => 1) or die "$0: E: Can't connect to news server '$NNTPServer'!\n"; - $NewsConnection->authinfo ($NNTPUser, $NNTPPass); + $NewsConnection->authinfo ($NNTPUser, $NNTPPass) if (defined($NNTPUser)); $NewsConnection->post(); $NewsConnection->datasend (@$ArticleR); $NewsConnection->dataend(); + # Posting failed? Save to ERROR.dat if (!$NewsConnection->ok()) { open FH, ">>ERROR.dat"; print FH "\nPosting failed! Saving to ERROR.dat. Response from news server:\n"; @@ -487,7 +525,7 @@ yapfaq - Post Usenet FAQs I<(yet another postfaq)> =head1 SYNOPSIS -B [B<-hvpd>] [B<-t> I | CONSOLE] [B<-f> I] +B [B<-hvpd>] [B<-t> I | CONSOLE] [B<-f> I] [B<-s> I] =head1 REQUIREMENTS @@ -685,9 +723,13 @@ was posted and the second being the message ID of that incarnation. =over 3 +=item B<-V> (version) + +Print out version and copyright information on B and exit. + =item B<-h> (help) -Print out version and usage information on B and exit. +Print this man page and exit. =item B<-v> (verbose) @@ -726,6 +768,12 @@ will be posted unconditionally. That may not be what you want to achieve, so you can limit the operation of B to the named FAQ only. +=item B<-s> I (pipe to script) + +Instead of posting the article(s) to Usenet pipe them to the external +I on STDIN (which may post the article(s) then). A return +value of 0 will be considered success. + =back =head1 EXAMPLES