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