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