Add rcfile (.yapfaqrc) for configuration.
[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: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 readrc (\$RCFile,\%Config) if -f $RCFile;
82
83 # read configuration (configured FAQs)
84 my @Config;
85 readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq);
86
87 # for each FAQ:
88 # - parse configuration
89 # - read status data
90 # - if FAQ is due: call postfaq()
91 foreach (@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
134 exit;
135
136 #################################### readrc ####################################
137 # Takes a filename and the reference to an array which contains the valid options
138
139 sub 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
160 sub 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
219 sub 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
236 sub 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
338 sub 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
383 sub 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.
428 sub 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
547 yapfaq - Post Usenet FAQs I<(yet another postfaq)>
548
549 =head1 SYNOPSIS
550
551 B<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
559 Perl 5.8 or later
560
561 =item -
562
563 Net::NNTP
564
565 =item -
566
567 Date::Calc
568
569 =item -
570
571 Getopt::Std
572
573 =back
574
575 Furthermore you need access to a news server to actually post FAQs.
576
577 =head1 DESCRIPTION
578
579 B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
580 frequency (every n days, weeks, months or years), adding all necessary
581 headers as defined in its config file (by default F<yapfaq.cfg>).
582
583 =head2 Configuration
584
585 F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
586 a single line, each containing the configuration for one FAQ as a set
587 of definitions in the form of I<param = value>.
588
589 =over 4
590
591 =item B<Name> = I<project name>
592
593 A name referring to your FAQ, also used for generation of a Message-ID.
594
595 This value must be set.
596
597 =item B<File> = I<file name>
598
599 A file containing the message body of your FAQ and all pseudo headers
600 (subheaders in the news.answers style).
601
602 This value must be set.
603
604 =item B<Posting-frequency> = I<time period>
605
606 The posting frequency defines how often your FAQ will be posted.
607 B<yapfaq> will only post your FAQ if this period of time has passed
608 since the last posting.
609
610 You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
611 or I<B<m>onths> or I<B<y>ears>.
612
613 This value must be set.
614
615 =item B<Expires> = I<time period>
616
617 The period of time after which your message will expire. An Expires
618 header will be calculated adding this time period to today's date.
619
620 You can declare this  time period either in I<B<d>ays> or I<B<w>weeks>
621 or I<B<m>onths> or I<B<y>ears>.
622
623 This setting is optional; the default  is 3 months.
624
625 =item B<From> = I<author>
626
627 The author of your FAQ as it will appear in the From header of the
628 message.
629
630 This value must be set.
631
632 =item B<Subject> = I<subject>
633
634 The title of your FAQ as it will appear in the Subject header of the
635 message.
636
637 You may use the special string C<%LM> which will be replaced with
638 the contents of the Last-Modified subheader in your I<File>.
639
640 This value must be set.
641
642 =item B<NGs> = I<newsgroups>
643
644 A comma-separated list of newsgroup(s) to post your FAQ to as it will
645 appear in the Newsgroups header of the message.
646
647 This value must be set.
648
649 =item B<Fup2> = I<newsgroup | poster>
650
651 A comma-separated list of newsgroup(s) or the special string I<poster>
652 as it will appear in the Followup-To header of the message.
653
654 This setting is optional.
655
656 =item B<MID-Format> = I<pattern>
657
658 A pattern from which the message ID is generated as it will appear in
659 the Message-ID header of the message.
660
661 You may use the special strings C<%n> for the I<Name> of your project,
662 C<%d> for the date the message is posted, C<%m> for the month and
663 C<%y> for the year, respectively.
664
665 This value must be set.
666
667 =item B<Supersede> = I<yes>
668
669 Add Supersedes header to the message containing the Message-ID header
670 of the last posting.
671
672 This setting is optional; you should set it to yes or leave it out.
673
674 =item B<ExtraHeader> = I<additional headers>
675
676 The contents of I<ExtraHeader> is added verbatim to the headers of
677 your message so you can add custom headers like Approved.
678
679 This 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
739 Information about the last post and about how to form message IDs for
740 posts is stored in a file named F<I<project name>.cfg> which will be
741 generated if it does not exist. Each of those status files will
742 contain two lines, the first being the date of the last time the FAQ
743 was 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
751 Print out version and copyright information on B<yapfaq> and exit.
752
753 =item B<-h> (help)
754
755 Print this man page and exit.
756
757 =item B<-v> (verbose)
758
759 Print out status information while running to STDOUT.
760
761 =item B<-p> (post unconditionally)
762
763 Post (all) FAQs unconditionally ignoring the posting frequency setting.
764
765 You may want to use this with the B<-f> option (see below).
766
767 =item B<-d> (dry run)
768
769 Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
770 update any status information.
771
772 =item B<-t> I<newsgroup(s) | CONSOLE> (test)
773
774 Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
775 newsgroups given after B<-t> as a comma-separated list or print the
776 FAQs to STDOUT separated by lines of dashes if the special string
777 C<CONSOLE> is given.  This can be used to preview what B<yapfaq> would
778 do without embarassing yourself on Usenet.  The status files are not
779 updated when this option is given.
780
781 You may want to use this with the B<-f> option (see below).
782
783 =item B<-f> I<project name>
784
785 Just deal with one FAQ only.
786
787 By default B<yapfaq> will work on all FAQs that are defined in
788 F<yapfaq.cfg>, check whether they are due for posting and - if they
789 are - post them. Consequently when the B<-p> option is set all FAQs
790 will be posted unconditionally. That may not be what you want to
791 achieve, so you can limit the operation of B<yapfaq> to the named FAQ
792 only.
793
794 =item B<-s> I<program> (pipe to script)
795
796 Instead of posting the article(s) to Usenet pipe them to the external
797 I<program> on STDIN (which may post the article(s) then). A return
798 value of 0 will be considered success.
799
800 =back
801
802 =head1 EXAMPLES
803
804 Post all FAQs that are due for posting:
805
806     yapfaq
807
808 Do a dry run, showing which FAQs would be posted:
809
810     yapfaq -dv
811
812 Do a test run and print on STDOUT what the FAQ I<myfaq> would look
813 like when posted, regardless whether it is due for posting or not:
814
815     yapfaq -pt CONSOLE -f myfaq
816
817 Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
818 if it is due:
819
820     yapfaq -t de.test -f myfaq
821
822 =head1 ENVIRONMENT
823
824 There are no special environment variables used by B<yapfaq>.
825
826 =head1 FILES
827
828 =over 4
829
830 =item F<yapfaq.pl>
831
832 The script itself.
833
834 =item F<yapfaq.cfg>
835
836 Configuration file for B<yapfaq>.
837
838 =item F<*.cfg>
839
840 Status data on FAQs.
841
842 The status files will be created on successful posting if they don't
843 already exist. The first line of the file will be the date of the last
844 time the FAQ was posted and the second line will be the message ID of
845 the last post of that FAQ.
846
847 =back
848
849 =head1 BUGS
850
851 Many, I'm sure.
852
853 =head1 SEE ALSO
854
855 L<http://th-h.de/download/scripts.php> will have the current
856 version of this program.
857
858 =head1 AUTHOR
859
860 Thomas Hochstein <thh@inter.net>
861
862 Original author (until version 0.5b from 2003):
863 Marc Brockschmidt <marc@marcbrockschmidt.de>
864
865
866 =head1 COPYRIGHT AND LICENSE
867
868 Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
869
870 Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
871
872 This program is free software; you may redistribute it and/or modify it
873 under the same terms as Perl itself.
874
875 =cut
This page took 0.033972 seconds and 4 git commands to generate.