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