Add sample .yapfaqrc with defaults.
[usenet/yapfaq.git] / yapfaq.pl
... / ...
CommitLineData
1#! /usr/bin/perl -W
2#
3# yapfaq Version 0.6 by Thomas Hochstein
4# (Original author: Marc Brockschmidt)
5#
6# This script posts any project described in its config-file. Most people
7# will use it in combination with cron(8).
8#
9# Copyright (C) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
10# Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
11#
12# It can be redistributed and/or modified under the same terms under
13# which Perl itself is published.
14
15my $Version = "0.6.2";
16
17my $RCFile = '.yapfaqrc';
18my @ValidConfVars = ('NNTPServer','NNTPUser','NNTPPass','Sender','ConfigFile',
19 'UsePGP','pgp','PGPVersion','PGPSigner','PGPPass',
20 'PathtoPGPPass','pgpbegin','pgpend','pgptmpf','pgpheader');
21
22################################### Defaults ##################################
23my %Config = (NNTPServer => "localhost",
24 NNTPUser => "",
25 NNTPPass => "",
26 Sender => "",
27 ConfigFile => "yapfaq.cfg",
28 UsePGP => 0,
29
30 ################################## PGP-Config #################################
31 pgp => '/usr/bin/pgp', # path to pgp
32 PGPVersion => '2', # Use 2 for 2.X, 5 for PGP > 2.X and GPG for GPG
33 PGPSigner => '', # sign as who?
34 PGPPass => '', # pgp2 only
35 PathtoPGPPass => '', # pgp2, pgp5 and gpg
36 pgpbegin => '-----BEGIN PGP SIGNATURE-----', # Begin of PGP-Signature
37 pgpend => '-----END PGP SIGNATURE-----', # End of PGP-Signature
38 pgptmpf => 'pgptmp', # temporary file for PGP.
39 pgpheader => 'X-PGP-Sig');
40
41my @PGPSignHeaders = ('From', 'Newsgroups', 'Subject', 'Control',
42 'Supersedes', 'Followup-To', 'Date', 'Sender', 'Approved',
43 'Message-ID', 'Reply-To', 'Cancel-Lock', 'Cancel-Key',
44 'Also-Control', 'Distribution');
45
46my @PGPorderheaders = ('from', 'newsgroups', 'subject', 'control',
47 'supersedes', 'followup-To', 'date', 'organization', 'lines',
48 'sender', 'approved', 'distribution', 'message-id',
49 'references', 'reply-to', 'mime-version', 'content-type',
50 'content-transfer-encoding', 'summary', 'keywords', 'cancel-lock',
51 'cancel-key', 'also-control', 'x-pgp', 'user-agent');
52
53############################# End of Configuration #############################
54
55use strict;
56use Net::NNTP;
57use Net::Domain qw(hostfqdn);
58use Date::Calc qw(Add_Delta_YM Add_Delta_Days Delta_Days Today);
59use Fcntl ':flock'; # import LOCK_* constants
60use Getopt::Std;
61my ($TDY, $TDM, $TDD) = Today(); #TD: Today's date
62
63# read commandline options
64my %Options;
65getopts('Vhvpdt:f:s:', \%Options);
66# -V: print version / copyright information
67if ($Options{'V'}) {
68 print "$0 v $Version\nCopyright (c) 2003 Marc Brockschmidt <marc\@marcbrockschmidt.de>\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
69 print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
70 exit(0);
71}
72# -h: feed myself to perldoc
73if ($Options{'h'}) {
74 exec ('perldoc', $0);
75 exit(0);
76};
77# -f: set $Faq
78my ($Faq) = $Options{'f'} if ($Options{'f'});
79
80# read runtime configuration (configuration variables)
81readrc (\$RCFile,\%Config) if -f $RCFile;
82
83# read configuration (configured FAQs)
84my @Config;
85readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq);
86
87# for each FAQ:
88# - parse configuration
89# - read status data
90# - if FAQ is due: call postfaq()
91foreach (@Config) {
92 my ($LPD,$LPM,$LPY) = (01, 01, 0001); #LP: Last posting-date
93 my ($NPY,$NPM,$NPD); #NP: Next posting-date
94 my $SupersedeMID;
95
96 my ($ActName,$File,$PFreq,$Expire) =($$_{'name'},$$_{'file'},$$_{'posting-frequency'},$$_{'expires'});
97 my ($From,$Subject,$NG,$Fup2)=($$_{'from'},$$_{'subject'},$$_{'ngs'},$$_{'fup2'});
98 my ($MIDF,$ReplyTo,$ExtHea)=($$_{'mid-format'},$$_{'reply-to'},$$_{'extraheader'});
99 my ($Supersede) =($$_{'supersede'});
100
101 # -f: loop if not FAQ to post
102 next if (defined($Faq) && $ActName ne $Faq);
103
104 # read status data
105 if (open (FH, "<$File.cfg")) {
106 while(<FH>){
107 if (/##;; Lastpost:\s*(\d{1,2})\.(\d{1,2})\.(\d{2}(\d{2})?)/){
108 ($LPD, $LPM, $LPY) = ($1, $2, $3);
109 } elsif (/^##;;\s*LastMID:\s*(<\S+@\S+>)\s*$/) {
110 $SupersedeMID = $1;
111 }
112 }
113 close FH;
114 } else {
115 warn "$0: W: Couldn't open $File.cfg: $!\n";
116 }
117
118 $SupersedeMID = "" unless $Supersede;
119
120 ($NPY,$NPM,$NPD) = calcdelta ($LPY,$LPM,$LPD,$PFreq);
121
122 # if FAQ is due: get it out
123 if (Delta_Days($NPY,$NPM,$NPD,$TDY,$TDM,$TDD) >= 0 or ($Options{'p'})) {
124 if($Options{'d'}) {
125 print "$ActName: Would be posted now (but running in simulation mode [$0 -d]).\n" if $Options{'v'};
126 } else {
127 postfaq(\$ActName,\$File,\$From,\$Subject,\$NG,\$Fup2,\$MIDF,\$ExtHea,\$Config{'Sender'},\$TDY,\$TDM,\$TDD,\$ReplyTo,\$SupersedeMID,\$Expire);
128 }
129 } elsif($Options{'v'}) {
130 print "$ActName: Nothing to do.\n";
131 }
132}
133
134exit;
135
136#################################### readrc ####################################
137# Takes a filename and the reference to an array which contains the valid options
138
139sub readrc{
140 my ($File, $Config) = @_;
141
142 print "Reading $$File.\n" if($Options{'v'});
143
144 open FH, "<$$File" or die "$0: Can't open $$File: $!";
145 while (<FH>) {
146 if (/^\s*(\S+)\s*=\s*'?(.*?)'?\s*(#.*$|$)/) {
147 if (grep(/$1/,@ValidConfVars)) {
148 $$Config{$1} = $2 if $2 ne '';
149 } else {
150 warn "$0: W: $1 is not a valid configuration variable (reading from $$File)\n";
151 }
152 }
153 }
154}
155
156################################## readconfig ##################################
157# Takes a filename, a reference to an array, which will hold hashes with
158# the data from $File, and - optionally - the name of the (single) FAQ to post
159
160sub readconfig{
161 my ($File, $Config, $Faq) = @_;
162 my ($LastEntry, $Error, $i) = ('','',0);
163
164 print "Reading configuration.\n" if($Options{'v'});
165
166 open FH, "<$$File" or die "$0: E: Can't open $$File: $!";
167 while (<FH>) {
168 next if (defined($$Faq) && !/^\s*=====\s*$/ && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
169 if (/^(\s*(\S+)\s*=\s*'?(.*?)'?\s*(#.*$|$)|^(.*?)'?\s*(#.*$|$))/ && not /^\s*$/) {
170 $LastEntry = lc($2) if $2;
171 $$Config[$i]{$LastEntry} .= $3 if $3;
172 $$Config[$i]{$LastEntry} .= "\n$5" if $5 && $5;
173 }
174 if (/^\s*=====\s*$/) {
175 $i++;
176 }
177 }
178 close FH;
179
180 #Check saved values:
181 for $i (0..$i){
182 next if (defined($$Faq) && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
183 unless(defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} =~ /^\S+$/) {
184 $Error .= "E: The name of your project \"$$Config[$i]{'name'}\" is not defined or contains whitespaces.\n"
185 }
186 unless(defined($$Config[$i]{'file'}) && -f $$Config[$i]{'file'}) {
187 $Error .= "E: The file to post for your project \"$$Config[$i]{'name'}\" is not defined or does not exist.\n"
188 }
189 unless(defined($$Config[$i]{'from'}) && $$Config[$i]{'from'} =~ /\S+\@(\S+\.)?\S{2,}\.\S{2,}/) {
190 $Error .= "E: The From header for your project \"$$Config[$i]{'name'}\" seems to be incorrect.\n"
191 }
192 unless(defined($$Config[$i]{'ngs'}) && $$Config[$i]{'ngs'} =~ /^\S+$/) {
193 $Error .= "E: The Newsgroups header for your project \"$$Config[$i]{'name'}\" is not defined or contains whitespaces.\n"
194 }
195 unless(defined($$Config[$i]{'subject'})) {
196 $Error .= "E: The Subject header for your project \"$$Config[$i]{'name'}\" is not defined.\n"
197 }
198 unless(!$$Config[$i]{'fup2'} || $$Config[$i]{'fup2'} =~ /^\S+$/) {
199 $Error .= "E: The Followup-To header for your project \"$$Config[$i]{'name'}\" contains whitespaces.\n"
200 }
201 unless(defined($$Config[$i]{'posting-frequency'}) && $$Config[$i]{'posting-frequency'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
202 $Error .= "E: The Posting-frequency for your project \"$$Config[$i]{'name'}\" is invalid.\n"
203 }
204 unless(!$$Config[$i]{'expires'} || $$Config[$i]{'expires'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
205 warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" is invalid - set to 3 month.\n";
206 }
207 unless(defined($$Config[$i]{'mid-format'}) && $$Config[$i]{'mid-format'} =~ /^<\S+\@\S{2,}\.\S{2,}>$/) {
208 warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" seems to be invalid - set to default.\n";
209 }
210 }
211 $Error .= "-" x 25 . 'program terminated' . "-" x 25 . "\n" if $Error;
212 die $Error if $Error;
213}
214
215################################# calcdelta #################################
216# Takes a date (year, month and day) and a time period (1d, 1w, 1m, 1y, ...)
217# and adds the latter to the former
218
219sub calcdelta {
220 my ($Year, $Month, $Day, $Period) = @_;
221 my ($NYear, $NMonth, $NDay);
222
223 if ($Period =~ /(\d+)\s*([dw])/) { # Is counted in days or weeks: Use Add_Delta_Days.
224 ($NYear, $NMonth, $NDay) = Add_Delta_Days($Year, $Month, $Day, (($2 eq "w")?$1 * 7: $1 * 1));
225 } elsif ($Period =~ /(\d+)\s*([my])/) { #Is counted in months or years: Use Add_Delta_YM
226 ($NYear, $NMonth, $NDay) = Add_Delta_YM($Year, $Month, $Day, (($2 eq "m")?(0,$1):($1,0)));
227 }
228 return ($NYear, $NMonth, $NDay);
229}
230
231################################## postfaq ##################################
232# Takes a filename and many other vars.
233#
234# It reads the data-file $File and then posts the article.
235
236sub postfaq {
237 my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_;
238 my (@Header,@Body,$MID,$InRealBody,$LastModified);
239
240 print "$$ActName: Preparing to post.\n" if($Options{'v'});
241
242 #Prepare MID:
243 $$TDM = ($$TDM < 10 && $$TDM !~ /^0/) ? "0" . $$TDM : $$TDM;
244 $$TDD = ($$TDD < 10 && $$TDD !~ /^0/) ? "0" . $$TDD : $$TDD;
245
246 $MID = $$MIDF;
247 $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID);
248 $MID =~ s/\%n/$$ActName/g;
249 $MID =~ s/\%d/$$TDD/g;
250 $MID =~ s/\%m/$$TDM/g;
251 $MID =~ s/\%y/$$TDY/g;
252
253 #Now get the body:
254 open (FH, "<$$File");
255 while (<FH>){
256 s/\r//;
257 push (@Body, $_), next if $InRealBody;
258 $InRealBody++ if /^$/;
259 $LastModified = $1 if /^Last-modified: (\S+)$/i;
260 push @Body, $_;
261 }
262 close FH;
263 push @Body, "\n" if ($Body[-1] ne "\n");
264
265 #Create Date- and Expires-Header:
266 my @time = localtime;
267 my $ss = ($time[0]<10) ? "0" . $time[0] : $time[0];
268 my $mm = ($time[1]<10) ? "0" . $time[1] : $time[1];
269 my $hh = ($time[2]<10) ? "0" . $time[2] : $time[2];
270 my $day = $time[3];
271 my $month = ($time[4]+1<10) ? "0" . ($time[4]+1) : $time[4]+1;
272 my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]];
273 my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]];
274 my $year = (1900 + $time[5]);
275 my $tz = $time[8] ? " +0200" : " +0100";
276
277 $$Expire = '3m' if !$$Expire; # set default if unset: 3 month
278
279 my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire);
280 my $expmonthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$expM-1];
281
282 my $date = "$day $monthN $year " . $hh . ":" . $mm . ":" . $ss . $tz;
283 my $expdate = "$expD $expmonthN $expY $hh:$mm:$ss$tz";
284
285 #Replace %LM by the content of the news.answer-pseudo-header Last-modified:
286 if ($LastModified) {
287 $$Subject =~ s/\%LM/$LastModified/;
288 }
289
290 # Test mode?
291 if($Options{'t'} and $Options{'t'} !~ /console/i) {
292 $$NG = $Options{'t'};
293 }
294
295 #Now create the complete Header:
296 push @Header, "From: $$From\n";
297 push @Header, "Newsgroups: $$NG\n";
298 push @Header, "Followup-To: $$Fup2\n" if $$Fup2;
299 push @Header, "Subject: $$Subject\n";
300 push @Header, "Message-ID: $MID\n";
301 push @Header, "Supersedes: $$Supersedes\n" if $$Supersedes;
302 push @Header, "Date: $date\n";
303 push @Header, "Expires: $expdate\n";
304 push @Header, "Sender: $$Sender\n" if $$Sender;
305 push @Header, "Mime-Version: 1.0\n";
306 push @Header, "Reply-To: $$ReplyTo\n" if $$ReplyTo;
307 push @Header, "Content-Type: text/plain; charset=ISO-8859-15\n";
308 push @Header, "Content-Transfer-Encoding: 8bit\n";
309 push @Header, "User-Agent: yapfaq/$Version\n";
310 if ($$ExtraHeaders) {
311 push @Header, "$_\n" for (split /\n/, $$ExtraHeaders);
312 }
313
314 # sign article if $UsePGP is true
315 my @Article = ($Config{'UsePGP'})?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body);
316
317 # post article
318 print "$$ActName: Posting article ...\n" if($Options{'v'});
319 post(\@Article);
320
321 # Test mode?
322 return if($Options{'t'});
323
324 # otherwise: update status data
325 print "$$ActName: Save status information.\n" if($Options{'v'});
326
327 open (FH, ">$$File.cfg") or die "$0: E: Can't open $$File.cfg: $!";
328 print FH "##;; Lastpost: $day.$month.$year\n";
329 print FH "##;; LastMID: $MID\n";
330 close FH;
331}
332
333################################## post ##################################
334# Takes a complete article (Header and Body).
335#
336# It opens a connection to $NNTPServer and posts the message.
337
338sub post {
339 my ($ArticleR) = @_;
340
341 # Test mode?
342 if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) {
343 print "-----BEGIN--------------------------------------------------\n";
344 print @$ArticleR;
345 print "------END---------------------------------------------------\n";
346 return;
347 }
348
349 # pipe to script?
350 if(defined($Options{'s'})) {
351 open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n";
352 print POST @$ArticleR;
353 close POST;
354 return;
355 }
356
357 my $NewsConnection = Net::NNTP->new($Config{'NNTPServer'}, Reader => 1) or die "$0: E: Can't connect to news server '$Config{'NNTPServer'}'!\n";
358 $NewsConnection->authinfo ($Config{'NNTPUser'}, $Config{'NNTPPass'}) if (defined($Config{'NNTPUser'}));
359 $NewsConnection->post();
360 $NewsConnection->datasend (@$ArticleR);
361 $NewsConnection->dataend();
362
363 # Posting failed? Save to ERROR.dat
364 if (!$NewsConnection->ok()) {
365 open FH, ">>ERROR.dat";
366 print FH "\nPosting failed! Saving to ERROR.dat. Response from news server:\n";
367 print FH $NewsConnection->code();
368 print FH $NewsConnection->message();
369 print FH "\n";
370 print FH @$ArticleR;
371 print FH "-" x 80, "\n";
372 close FH;
373 }
374
375 $NewsConnection->quit();
376}
377
378#-------- sub getpgpcommand
379# getpgpcommand generates the command to sign the message and returns it.
380#
381# Receives:
382# - $PGPVersion: A scalar holding the PGPVersion
383sub getpgpcommand {
384 my ($PGPVersion) = @_;
385 my $PGPCommand;
386
387 if ($PGPVersion eq '2') {
388 if ($Config{'PathtoPGPPass'} && !$Config{'PGPPass'}) {
389 open (PGPPW, $Config{'PathtoPGPPass'}) or die "$0: E: Can't open $Config{'PathtoPGPPass'}: $!";
390 Config{'$PGPPass'} = <PGPPW>;
391 close PGPPW;
392 }
393
394 if (Config{'$PGPPass'}) {
395 $PGPCommand = "PGPPASS=\"".$Config{'PGPPass'}."\" ".$Config{'pgp'}." -u \"".$Config{'PGPSigner'}."\" +verbose=0 language='en' -saft <".$Config{'pgptmpf'}.".txt >".$Config{'pgptmpf'}.".txt.asc";
396 } else {
397 die "$0: E: PGP-Passphrase is unknown!\n";
398 }
399 } elsif ($PGPVersion eq '5') {
400 if ($Config{'PathtoPGPPass'}) {
401 $PGPCommand = "PGPPASSFD=2 ".$Config{'pgp'}."s -u \"".$Config{'PGPSigner'}."\" -t --armor -o ".$Config{'pgptmpf'}.".txt.asc -z -f < ".$Config{'pgptmpf'}.".txt 2<".$Config{'PathtoPGPPass'};
402 } else {
403 die "$0: E: PGP-Passphrase is unknown!\n";
404 }
405 } elsif ($PGPVersion =~ m/GPG/io) {
406 if (Config{'$PathtoPGPPass'}) {
407 $PGPCommand = $Config{'pgp'}." --digest-algo MD5 -a -u \"".$Config{'PGPSigner'}."\" -o ".$Config{'pgptmpf'}.".txt.asc --no-tty --batch --passphrase-fd 2 2<".$Config{'PathtoPGPPass'}." --clearsign ".$Config{'pgptmpf'}.".txt";
408 } else {
409 die "$0: E: Passphrase is unknown!\n";
410 }
411 } else {
412 die "$0: E: Unknown PGP-Version $PGPVersion!";
413 }
414 return $PGPCommand;
415}
416
417
418#-------- sub signarticle
419# signarticle signs an articel and returns a reference to an array
420# containing the whole signed Message.
421#
422# Receives:
423# - $HeaderAR: A reference to a array containing the articles headers.
424# - $BodyR: A reference to an array containing the body.
425#
426# Returns:
427# - $MessageRef: A reference to an array containing the whole message.
428sub signpgp {
429 my ($HeaderAR, $BodyR) = @_;
430 my (@pgphead, @pgpbody, $pgphead, $pgpbody, $header, $signheaders, @signheaders, $currentheader, $HeaderR, $line);
431
432 foreach my $line (@$HeaderAR) {
433 if ($line =~ /^(\S+):\s+(.*)$/s) {
434 $currentheader = $1;
435 $$HeaderR{lc($currentheader)} = "$1: $2";
436 } else {
437 $$HeaderR{lc($currentheader)} .= $line;
438 }
439 }
440
441 foreach (@PGPSignHeaders) {
442 if (defined($$HeaderR{lc($_)}) && $$HeaderR{lc($_)} =~ m/^[^\s:]+: .+/o) {
443 push @signheaders, $_;
444 }
445 }
446
447 $pgpbody = join ("", @$BodyR);
448
449 # Delete and create the temporary pgp-Files
450 unlink "$Config{'pgptmpf'}.txt";
451 unlink "$Config{'pgptmpf'}.txt.asc";
452 $signheaders = join(",", @signheaders);
453
454 $pgphead = "X-Signed-Headers: $signheaders\n";
455 foreach $header (@signheaders) {
456 if ($$HeaderR{lc($header)} =~ m/^[^\s:]+: (.+?)\n?$/so) {
457 $pgphead .= $header.": ".$1."\n";
458 }
459 }
460
461 open(FH, ">" . $Config{'pgptmpf'} . ".txt") or die "$0: E: can't open $Config{'pgptmpf'}: $!\n";
462 print FH $pgphead, "\n", $pgpbody;
463 print FH "\n" if ($Config{'PGPVersion'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
464 close(FH) or warn "$0: W: Couldn't close TMP: $!\n";
465
466 # Start PGP, then read the signature;
467 my $PGPCommand = getpgpcommand($Config{'PGPVersion'});
468 `$PGPCommand`;
469
470 open (FH, "<" . $Config{'pgptmpf'} . ".txt.asc") or die "$0: E: can't open ".$Config{'pgptmpf'}.".txt.asc: $!\n";
471 $/ = "$Config{'pgpbegin'}\n";
472 $_ = <FH>;
473 unless (m/\Q$Config{'pgpbegin'}\E$/o) {
474# unlink $Config{'pgptmpf'} . ".txt";
475# unlink $Config{'pgptmpf'} . ".txt.asc";
476 die "$0: E: $Config{'pgpbegin'} not found in ".$Config{'pgptmpf'}.".txt.asc\n"
477 }
478 unlink($Config{'pgptmpf'} . ".txt") or warn "$0: W: Couldn't unlink $Config{'pgptmpf'}.txt: $!\n";
479
480 $/ = "\n";
481 $_ = <FH>;
482 unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
483 unlink $Config{'pgptmpf'} . ".txt";
484 unlink $Config{'pgptmpf'} . ".txt.asc";
485 die "$0: E: didn't find PGP Version line where expected.\n";
486 }
487
488 if (defined($2)) {
489 $$HeaderR{$Config{'pgpheader'}} = $1."-".$2." ".$signheaders;
490 } else {
491 $$HeaderR{$Config{'pgpheader'}} = $1." ".$signheaders;
492 }
493
494 do { # skip other pgp headers like
495 $_ = <FH>; # "charset:"||"comment:" until empty line
496 } while ! /^$/;
497
498 while (<FH>) {
499 chomp;
500 last if /^\Q$Config{'pgpend'}\E$/;
501 $$HeaderR{$Config{'pgpheader'}} .= "\n\t$_";
502 }
503
504 $$HeaderR{$Config{'pgpheader'}} .= "\n" unless ($$HeaderR{$Config{'pgpheader'}} =~ /\n$/s);
505
506 $_ = <FH>;
507 unless (eof(FH)) {
508 unlink $Config{'pgptmpf'} . ".txt";
509 unlink $Config{'pgptmpf'} . ".txt.asc";
510 die "$0: E: unexpected data following $Config{'pgpend'}\n";
511 }
512 close(FH);
513 unlink "$Config{'pgptmpf'}.txt.asc";
514
515 my $tmppgpheader = $Config{'pgpheader'} . ": " . $$HeaderR{$Config{'pgpheader'}};
516 delete $$HeaderR{$Config{'pgpheader'}};
517
518 @pgphead = ();
519 foreach $header (@PGPorderheaders) {
520 if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
521 push(@pgphead, "$$HeaderR{$header}");
522 delete $$HeaderR{$header};
523 }
524 }
525
526 foreach $header (keys %$HeaderR) {
527 if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
528 push(@pgphead, "$$HeaderR{$header}");
529 delete $$HeaderR{$header};
530 }
531 }
532
533 push @pgphead, ("X-PGP-Key: " . $Config{'PGPSigner'} . "\n"), $tmppgpheader;
534 undef $tmppgpheader;
535
536 @pgpbody = split /$/m, $pgpbody;
537 my @pgpmessage = (@pgphead, "\n", @pgpbody);
538 return \@pgpmessage;
539}
540
541__END__
542
543################################ Documentation #################################
544
545=head1 NAME
546
547yapfaq - Post Usenet FAQs I<(yet another postfaq)>
548
549=head1 SYNOPSIS
550
551B<yapfaq> [B<-hvpd>] [B<-t> I<newsgroups> | CONSOLE] [B<-f> I<project name>] [B<-s> I<program>]
552
553=head1 REQUIREMENTS
554
555=over 2
556
557=item -
558
559Perl 5.8 or later
560
561=item -
562
563Net::NNTP
564
565=item -
566
567Date::Calc
568
569=item -
570
571Getopt::Std
572
573=back
574
575Furthermore you need access to a news server to actually post FAQs.
576
577=head1 DESCRIPTION
578
579B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
580frequency (every n days, weeks, months or years), adding all necessary
581headers as defined in its config file (by default F<yapfaq.cfg>).
582
583=head2 Configuration
584
585F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
586a single line, each containing the configuration for one FAQ as a set
587of definitions in the form of I<param = value>.
588
589=over 4
590
591=item B<Name> = I<project name>
592
593A name referring to your FAQ, also used for generation of a Message-ID.
594
595This value must be set.
596
597=item B<File> = I<file name>
598
599A file containing the message body of your FAQ and all pseudo headers
600(subheaders in the news.answers style).
601
602This value must be set.
603
604=item B<Posting-frequency> = I<time period>
605
606The posting frequency defines how often your FAQ will be posted.
607B<yapfaq> will only post your FAQ if this period of time has passed
608since the last posting.
609
610You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
611or I<B<m>onths> or I<B<y>ears>.
612
613This value must be set.
614
615=item B<Expires> = I<time period>
616
617The period of time after which your message will expire. An Expires
618header will be calculated adding this time period to today's date.
619
620You can declare this time period either in I<B<d>ays> or I<B<w>weeks>
621or I<B<m>onths> or I<B<y>ears>.
622
623This setting is optional; the default is 3 months.
624
625=item B<From> = I<author>
626
627The author of your FAQ as it will appear in the From header of the
628message.
629
630This value must be set.
631
632=item B<Subject> = I<subject>
633
634The title of your FAQ as it will appear in the Subject header of the
635message.
636
637You may use the special string C<%LM> which will be replaced with
638the contents of the Last-Modified subheader in your I<File>.
639
640This value must be set.
641
642=item B<NGs> = I<newsgroups>
643
644A comma-separated list of newsgroup(s) to post your FAQ to as it will
645appear in the Newsgroups header of the message.
646
647This value must be set.
648
649=item B<Fup2> = I<newsgroup | poster>
650
651A comma-separated list of newsgroup(s) or the special string I<poster>
652as it will appear in the Followup-To header of the message.
653
654This setting is optional.
655
656=item B<MID-Format> = I<pattern>
657
658A pattern from which the message ID is generated as it will appear in
659the Message-ID header of the message.
660
661You may use the special strings C<%n> for the I<Name> of your project,
662C<%d> for the date the message is posted, C<%m> for the month and
663C<%y> for the year, respectively.
664
665This value must be set.
666
667=item B<Supersede> = I<yes>
668
669Add Supersedes header to the message containing the Message-ID header
670of the last posting.
671
672This setting is optional; you should set it to yes or leave it out.
673
674=item B<ExtraHeader> = I<additional headers>
675
676The contents of I<ExtraHeader> is added verbatim to the headers of
677your message so you can add custom headers like Approved.
678
679This setting is optional.
680
681=back
682
683=head2 Example configuration file
684
685 # name of your project
686 Name = 'testpost'
687
688 # file to post (complete body and pseudo-headers)
689 # ($File.cfg contains data on last posting and last MID)
690 File = 'test.txt'
691
692 # how often your project should be posted
693 # use (d)ay OR (w)eek OR (m)onth OR (y)ear
694 Posting-frequency = '1d'
695
696 # time period after which the posting should expire
697 # use (d)ay OR (w)eek OR (m)onth OR (y)ear
698 Expires = '3m'
699
700 # header "From:"
701 From = 'test@domain.invalid'
702
703 # header "Subject:"
704 # (may contain "%LM" which will be replaced by the contents of the
705 # Last-Modified pseudo header).
706 Subject = 'test noreply ignore'
707
708 # comma-separated list of newsgroup(s) to post to
709 # (header "Newsgroups:")
710 NGs = 'de.test'
711
712 # header "Followup-To:"
713 Fup2 = 'poster'
714
715 # Message-ID ("%n" is $Name)
716 MID-Format = '<%n-%d.%m.%y@domain.invalid>'
717
718 # Supersede last posting?
719 Supersede = yes
720
721 # extra headers (appended verbatim)
722 # use this for custom headers like "Approved:"
723 ExtraHeader = 'Approved: moderator@domain.invalid
724 X-Header: Some text'
725
726 # other projects may follow separated with "====="
727 =====
728
729 Name = 'othertest'
730 File = 'test.txt'
731 Posting-frequency = '2m'
732 From = 'My Name <my.name@domain.invalid>'
733 Subject = 'Test of yapfag <%LM>'
734 NGs = 'de.test,de.alt.test'
735 Fup2 = 'de.test'
736 MID-Format = '<%n-%m.%y@domain.invalid>'
737 Supersede = yes
738
739Information about the last post and about how to form message IDs for
740posts is stored in a file named F<I<project name>.cfg> which will be
741generated if it does not exist. Each of those status files will
742contain two lines, the first being the date of the last time the FAQ
743was posted and the second being the message ID of that incarnation.
744
745=head1 OPTIONS
746
747=over 3
748
749=item B<-V> (version)
750
751Print out version and copyright information on B<yapfaq> and exit.
752
753=item B<-h> (help)
754
755Print this man page and exit.
756
757=item B<-v> (verbose)
758
759Print out status information while running to STDOUT.
760
761=item B<-p> (post unconditionally)
762
763Post (all) FAQs unconditionally ignoring the posting frequency setting.
764
765You may want to use this with the B<-f> option (see below).
766
767=item B<-d> (dry run)
768
769Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
770update any status information.
771
772=item B<-t> I<newsgroup(s) | CONSOLE> (test)
773
774Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
775newsgroups given after B<-t> as a comma-separated list or print the
776FAQs to STDOUT separated by lines of dashes if the special string
777C<CONSOLE> is given. This can be used to preview what B<yapfaq> would
778do without embarassing yourself on Usenet. The status files are not
779updated when this option is given.
780
781You may want to use this with the B<-f> option (see below).
782
783=item B<-f> I<project name>
784
785Just deal with one FAQ only.
786
787By default B<yapfaq> will work on all FAQs that are defined in
788F<yapfaq.cfg>, check whether they are due for posting and - if they
789are - post them. Consequently when the B<-p> option is set all FAQs
790will be posted unconditionally. That may not be what you want to
791achieve, so you can limit the operation of B<yapfaq> to the named FAQ
792only.
793
794=item B<-s> I<program> (pipe to script)
795
796Instead of posting the article(s) to Usenet pipe them to the external
797I<program> on STDIN (which may post the article(s) then). A return
798value of 0 will be considered success.
799
800=back
801
802=head1 EXAMPLES
803
804Post all FAQs that are due for posting:
805
806 yapfaq
807
808Do a dry run, showing which FAQs would be posted:
809
810 yapfaq -dv
811
812Do a test run and print on STDOUT what the FAQ I<myfaq> would look
813like when posted, regardless whether it is due for posting or not:
814
815 yapfaq -pt CONSOLE -f myfaq
816
817Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
818if it is due:
819
820 yapfaq -t de.test -f myfaq
821
822=head1 ENVIRONMENT
823
824There are no special environment variables used by B<yapfaq>.
825
826=head1 FILES
827
828=over 4
829
830=item F<yapfaq.pl>
831
832The script itself.
833
834=item F<yapfaq.cfg>
835
836Configuration file for B<yapfaq>.
837
838=item F<*.cfg>
839
840Status data on FAQs.
841
842The status files will be created on successful posting if they don't
843already exist. The first line of the file will be the date of the last
844time the FAQ was posted and the second line will be the message ID of
845the last post of that FAQ.
846
847=back
848
849=head1 BUGS
850
851Many, I'm sure.
852
853=head1 SEE ALSO
854
855L<http://th-h.de/download/scripts.php> will have the current
856version of this program.
857
858=head1 AUTHOR
859
860Thomas Hochstein <thh@inter.net>
861
862Original author (until version 0.5b from 2003):
863Marc Brockschmidt <marc@marcbrockschmidt.de>
864
865
866=head1 COPYRIGHT AND LICENSE
867
868Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
869
870Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
871
872This program is free software; you may redistribute it and/or modify it
873under the same terms as Perl itself.
874
875=cut
This page took 0.01247 seconds and 4 git commands to generate.