Fix: Consistency check for MID-Format fixed (regexp).
[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+\.)?\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   my $Timestamp = time;
273
274   $MID = $$MIDF;
275   $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID); # set to default if unset
276   $MID =~ s/\%n/$$ActName/g;
277   $MID =~ s/\%d/$$TDD/g;
278   $MID =~ s/\%m/$$TDM/g;
279   $MID =~ s/\%y/$$TDY/g;
280   $MID =~ s/\%t/$Timestamp/g;
281
282   #Now get the body:
283   open (FH, "<$$File");
284   while (<FH>){  
285     s/\r//;
286     push (@Body, $_), next if $InRealBody;
287     $InRealBody++ if /^$/;
288     $LastModified = $1 if /^Last-modified: (\S+)$/i;
289     push @Body, $_;
290   }
291   close FH;
292   push @Body, "\n" if ($Body[-1] ne "\n");
293
294   #Create Date- and Expires-Header:
295   my @time = localtime;
296   my $ss =  ($time[0]<10) ? "0" . $time[0] : $time[0];
297   my $mm =  ($time[1]<10) ? "0" . $time[1] : $time[1];
298   my $hh =  ($time[2]<10) ? "0" . $time[2] : $time[2];
299   my $day = $time[3];
300   my $month = ($time[4]+1<10) ? "0" . ($time[4]+1) : $time[4]+1;
301   my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]];
302   my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]];
303   my $year = (1900 + $time[5]);
304   my $tz = $time[8] ? " +0200" : " +0100";
305
306   $$Expire = '3m' if !$$Expire; # set default if unset: 3 month
307
308   my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire);
309   my $expmonthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$expM-1];
310
311   my $date = "$day $monthN $year " . $hh . ":" . $mm . ":" . $ss . $tz;
312   my $expdate = "$expD $expmonthN $expY $hh:$mm:$ss$tz";
313  
314   #Replace %LM by the content of the news.answer-pseudo-header Last-modified:
315   if ($LastModified) {
316     $$Subject =~ s/\%LM/$LastModified/;
317   }
318
319   # Test mode?
320   if($Options{'t'} and $Options{'t'} !~ /console/i) {
321     $$NG = $Options{'t'};
322   }
323
324   #Now create the complete Header:
325   push @Header, "From: $$From\n";
326   push @Header, "Newsgroups: $$NG\n";
327   push @Header, "Followup-To: $$Fup2\n" if $$Fup2;
328   push @Header, "Subject: $$Subject\n";
329   push @Header, "Message-ID: $MID\n";
330   push @Header, "Supersedes: $$Supersedes\n" if $$Supersedes;
331   push @Header, "Date: $date\n";
332   push @Header, "Expires: $expdate\n";
333   push @Header, "Sender: $$Sender\n" if $$Sender;
334   push @Header, "Mime-Version: 1.0\n";
335   push @Header, "Reply-To: $$ReplyTo\n" if $$ReplyTo;
336   push @Header, "Content-Type: text/plain; charset=ISO-8859-15\n";
337   push @Header, "Content-Transfer-Encoding: 8bit\n";
338   push @Header, "User-Agent: yapfaq/$Version\n";
339   if ($$ExtraHeaders) {
340     push @Header, "$_\n" for (split /\n/, $$ExtraHeaders);
341   }
342
343   # sign article if $UsePGP is true
344   my @Article = ($Config{'UsePGP'})?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body);
345   
346   # post article
347   print "$$ActName: Posting article ...\n" if($Options{'v'});
348   my $failure = post(\@Article);
349   
350   if ($failure) {
351     print "$$ActName: Posting failed, ERROR.dat may have more information.\n" if($Options{'v'} && (!defined($Options{'t'}) || $Options{'t'} !~ /console/i));
352   } else {
353     updatestatus($ActName, $File, "$day.$month.$year", $MID) if !defined($Options{'t'});
354   }
355 }
356
357 ################################## post ##################################
358 # Takes a complete article (Header and Body).
359 #
360 # It opens a connection to $NNTPServer and posts the message.
361
362 sub post {
363   my ($ArticleR) = @_;
364   my ($failure) = -1;
365
366   # test mode - print article to console
367   if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) {
368     print "-----BEGIN--------------------------------------------------\n";
369     print @$ArticleR;
370     print "------END---------------------------------------------------\n";
371   # pipe article to script
372   } elsif(defined($Options{'s'})) {
373     open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n";
374     print POST @$ArticleR;
375     close POST;
376     if ($? == 0) {
377       $failure = 0;
378     } else {
379       warn "$0: W: $Options{'s'} exited with status ", ($? >> 8), "\n";
380       $failure = $?;
381     }
382   # post article
383   } else {
384     my $NewsConnection = Net::NNTP->new($Config{'NNTPServer'}, Reader => 1) or die "$0: E: Can't connect to news server '$Config{'NNTPServer'}'!\n";
385     $NewsConnection->authinfo ($Config{'NNTPUser'}, $Config{'NNTPPass'}) if (defined($Config{'NNTPUser'}));
386     $NewsConnection->post();
387     $NewsConnection->datasend (@$ArticleR);
388     $NewsConnection->dataend();
389
390     if ($NewsConnection->ok()) {
391       $failure = 0;
392     # Posting failed? Save to ERROR.dat
393     } else {
394           warn "$0: W: Posting failed!\n";
395       open FH, ">>ERROR.dat";
396       print FH "\nPosting failed! Saving to ERROR.dat. Response from news server:\n";
397       print FH $NewsConnection->code();
398       print FH $NewsConnection->message();
399       print FH "\n";
400       print FH @$ArticleR;
401       print FH "-" x 80, "\n";
402       close FH;
403     }
404     $NewsConnection->quit();
405   }
406   return $failure;
407 }
408
409 #-------- sub getpgpcommand
410 # getpgpcommand generates the command to sign the message and returns it.
411 #
412 # Receives:
413 #       - $PGPVersion: A scalar holding the PGPVersion
414 sub getpgpcommand {
415   my ($PGPVersion) = @_;
416   my $PGPCommand;
417
418   if ($PGPVersion eq '2') {
419     if ($Config{'PathtoPGPPass'} && !$Config{'PGPPass'}) {
420       open (PGPPW, $Config{'PathtoPGPPass'}) or die "$0: E: Can't open $Config{'PathtoPGPPass'}: $!";
421       Config{'$PGPPass'} = <PGPPW>;
422       close PGPPW;
423     }
424   
425     if (Config{'$PGPPass'}) {
426       $PGPCommand = "PGPPASS=\"".$Config{'PGPPass'}."\" ".$Config{'pgp'}." -u \"".$Config{'PGPSigner'}."\" +verbose=0 language='en' -saft <".$Config{'pgptmpf'}.".txt >".$Config{'pgptmpf'}.".txt.asc";
427     } else {
428       die "$0: E: PGP-Passphrase is unknown!\n";
429     }
430   } elsif ($PGPVersion eq '5') {
431     if ($Config{'PathtoPGPPass'}) {
432       $PGPCommand = "PGPPASSFD=2 ".$Config{'pgp'}."s -u \"".$Config{'PGPSigner'}."\" -t --armor -o ".$Config{'pgptmpf'}.".txt.asc -z -f < ".$Config{'pgptmpf'}.".txt 2<".$Config{'PathtoPGPPass'};
433     } else {
434       die "$0: E: PGP-Passphrase is unknown!\n";
435     }
436   } elsif ($PGPVersion =~ m/GPG/io) {
437     if (Config{'$PathtoPGPPass'}) {
438       $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";
439     } else {
440       die "$0: E: Passphrase is unknown!\n";
441     }
442   } else {
443     die "$0: E: Unknown PGP-Version $PGPVersion!";
444   }
445   return $PGPCommand;
446 }
447
448
449 #-------- sub signarticle
450 # signarticle signs an articel and returns a reference to an array
451 #       containing the whole signed Message.
452 #
453 # Receives:
454 #       - $HeaderAR: A reference to a array containing the articles headers.
455 #       - $BodyR: A reference to an array containing the body.
456 #
457 # Returns:
458 #       - $MessageRef: A reference to an array containing the whole message.
459 sub signpgp {
460   my ($HeaderAR, $BodyR) = @_;
461   my (@pgphead, @pgpbody, $pgphead, $pgpbody, $header, $signheaders, @signheaders, $currentheader, $HeaderR, $line);
462
463   foreach my $line (@$HeaderAR) {
464     if ($line =~ /^(\S+):\s+(.*)$/s) {
465       $currentheader = $1;
466       $$HeaderR{lc($currentheader)} = "$1: $2";
467     } else {
468       $$HeaderR{lc($currentheader)} .= $line;
469     }
470   }
471
472   foreach (@PGPSignHeaders) {
473     if (defined($$HeaderR{lc($_)}) && $$HeaderR{lc($_)} =~ m/^[^\s:]+: .+/o) {
474       push @signheaders, $_;
475     }
476   }
477
478   $pgpbody = join ("", @$BodyR);
479
480   # Delete and create the temporary pgp-Files
481   unlink "$Config{'pgptmpf'}.txt";
482   unlink "$Config{'pgptmpf'}.txt.asc";
483   $signheaders = join(",", @signheaders);
484
485   $pgphead = "X-Signed-Headers: $signheaders\n";
486   foreach $header (@signheaders) {
487     if ($$HeaderR{lc($header)} =~ m/^[^\s:]+: (.+?)\n?$/so) {
488       $pgphead .= $header.": ".$1."\n";
489     }
490   }
491
492   open(FH, ">" . $Config{'pgptmpf'} . ".txt") or die "$0: E: can't open $Config{'pgptmpf'}: $!\n";
493   print FH $pgphead, "\n", $pgpbody;
494   print FH "\n" if ($Config{'PGPVersion'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
495   close(FH) or warn "$0: W: Couldn't close TMP: $!\n";
496
497   # Start PGP, then read the signature;
498   my $PGPCommand = getpgpcommand($Config{'PGPVersion'});
499   `$PGPCommand`;
500
501   open (FH, "<" . $Config{'pgptmpf'} . ".txt.asc") or die "$0: E: can't open ".$Config{'pgptmpf'}.".txt.asc: $!\n";
502   $/ = "$Config{'pgpbegin'}\n";
503   $_ = <FH>;
504   unless (m/\Q$Config{'pgpbegin'}\E$/o) {
505 #    unlink $Config{'pgptmpf'} . ".txt";
506 #    unlink $Config{'pgptmpf'} . ".txt.asc";
507     die "$0: E: $Config{'pgpbegin'} not found in ".$Config{'pgptmpf'}.".txt.asc\n"
508   }
509   unlink($Config{'pgptmpf'} . ".txt") or warn "$0: W: Couldn't unlink $Config{'pgptmpf'}.txt: $!\n";
510
511   $/ = "\n";
512   $_ = <FH>;
513   unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
514     unlink $Config{'pgptmpf'} . ".txt";
515     unlink $Config{'pgptmpf'} . ".txt.asc";
516     die "$0: E: didn't find PGP Version line where expected.\n";
517   }
518   
519   if (defined($2)) {
520     $$HeaderR{$Config{'pgpheader'}} = $1."-".$2." ".$signheaders;
521   } else {
522     $$HeaderR{$Config{'pgpheader'}} = $1." ".$signheaders;
523   }
524   
525   do {          # skip other pgp headers like
526     $_ = <FH>;  # "charset:"||"comment:" until empty line
527   } while ! /^$/;
528
529   while (<FH>) {
530     chomp;
531     last if /^\Q$Config{'pgpend'}\E$/;
532     $$HeaderR{$Config{'pgpheader'}} .= "\n\t$_";
533   }
534   
535   $$HeaderR{$Config{'pgpheader'}} .= "\n" unless ($$HeaderR{$Config{'pgpheader'}} =~ /\n$/s);
536
537   $_ = <FH>;
538   unless (eof(FH)) {
539     unlink $Config{'pgptmpf'} . ".txt";
540     unlink $Config{'pgptmpf'} . ".txt.asc";
541     die "$0: E: unexpected data following $Config{'pgpend'}\n";
542   }
543   close(FH);
544   unlink "$Config{'pgptmpf'}.txt.asc";
545
546   my $tmppgpheader = $Config{'pgpheader'} . ": " . $$HeaderR{$Config{'pgpheader'}};
547   delete $$HeaderR{$Config{'pgpheader'}};
548
549   @pgphead = ();
550   foreach $header (@PGPorderheaders) {
551     if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
552       push(@pgphead, "$$HeaderR{$header}");
553       delete $$HeaderR{$header};
554     }
555   }
556
557   foreach $header (keys %$HeaderR) {
558     if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
559       push(@pgphead, "$$HeaderR{$header}");
560       delete $$HeaderR{$header};
561     }
562   }
563
564   push @pgphead, ("X-PGP-Key: " . $Config{'PGPSigner'} . "\n"), $tmppgpheader;
565   undef $tmppgpheader;
566
567   @pgpbody = split /$/m, $pgpbody;
568   my @pgpmessage = (@pgphead, "\n", @pgpbody);
569   return \@pgpmessage;
570 }
571
572 __END__
573
574 ################################ Documentation #################################
575
576 =head1 NAME
577
578 yapfaq - Post Usenet FAQs I<(yet another postfaq)>
579
580 =head1 SYNOPSIS
581
582 B<yapfaq> [B<-Vhvpd>] [B<-t> I<newsgroups> | CONSOLE] [B<-f> I<project name>] [B<-s> I<program>] [B<-c> I<.rc file>]
583
584 =head1 REQUIREMENTS
585
586 =over 2
587
588 =item -
589
590 Perl 5.8 or later
591
592 =item -
593
594 Net::NNTP
595
596 =item -
597
598 Date::Calc
599
600 =item -
601
602 Getopt::Std
603
604 =back
605
606 Furthermore you need access to a news server to actually post FAQs.
607
608 =head1 DESCRIPTION
609
610 B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
611 frequency (every n days, weeks, months or years), adding all necessary
612 headers as defined in its config file (by default F<yapfaq.cfg>).
613
614 =head2 Configuration
615
616 F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
617 a single line, each containing the configuration for one FAQ as a set
618 of definitions in the form of I<param = value>. Everything after a "#"
619 sign is ignored so you may comment your configuration file.
620
621 =over 4
622
623 =item B<Name> = I<project name>
624
625 A name referring to your FAQ, also used for generation of a Message-ID.
626
627 This value must be set.
628
629 =item B<File> = I<file name>
630
631 A file containing the message body of your FAQ and all pseudo headers
632 (subheaders in the news.answers style).
633
634 This value must be set.
635
636 =item B<Posting-frequency> = I<time period>
637
638 The posting frequency defines how often your FAQ will be posted.
639 B<yapfaq> will only post your FAQ if this period of time has passed
640 since the last posting.
641
642 You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
643 or I<B<m>onths> or I<B<y>ears>.
644
645 This value must be set.
646
647 =item B<Expires> = I<time period> (optional)
648
649 The period of time after which your message will expire. An Expires
650 header will be calculated adding this time period to today's date.
651
652 You can declare this  time period either in I<B<d>ays> or I<B<w>weeks>
653 or I<B<m>onths> or I<B<y>ears>.
654
655 This setting is optional; the default is 3 months.
656
657 =item B<From> = I<author>
658
659 The author of your FAQ as it will appear in the From header of the
660 message.
661
662 This value must be set.
663
664 =item B<Subject> = I<subject>
665
666 The title of your FAQ as it will appear in the Subject header of the
667 message.
668
669 You may use the special string C<%LM> which will be replaced with
670 the contents of the Last-Modified subheader in your I<File>.
671
672 This value must be set.
673
674 =item B<NGs> = I<newsgroups>
675
676 A comma-separated list of newsgroup(s) to post your FAQ to as it will
677 appear in the Newsgroups header of the message.
678
679 This value must be set.
680
681 =item B<Fup2> = I<newsgroup | poster>  (optional)
682
683 A comma-separated list of newsgroup(s) or the special string I<poster>
684 as it will appear in the Followup-To header of the message.
685
686 This setting is optional.
687
688 =item B<MID-Format> = I<pattern>  (optional)
689
690 A pattern from which the message ID is generated as it will appear in
691 the Message-ID header of the message.
692
693 You may use the special strings C<%n> for the I<Name> of your project,
694 C<%d> for the date the message is posted, C<%m> for the month, C<%y>
695 for the year and C<%t> for a time stamp (number of seconds since the
696 epoch), respectively.
697
698 This setting is optional; the default is '<%n-%d.%m.%y@I<YOURHOST>>'
699 where I<YOURHOST> is the fully qualified domain name (FQDN) of the
700 host B<yapfaq> is running on. Obviously that will only work if you
701 have defined a reasonable hostname that the hostfqdn() function of
702 Net::Domain can return.
703
704 =item B<Supersede> = I<yes>  (optional)
705
706 Add Supersedes header to the message containing the Message-ID header
707 of the last posting.
708
709 This setting is optional; you should set it to yes or leave it out.
710
711 =item B<ExtraHeader> = I<additional headers>  (optional)
712
713 The contents of I<ExtraHeader> is added verbatim to the headers of
714 your message so you can add custom headers like Approved.
715
716 This setting is optional.
717
718 =back
719
720 =head3 Example configuration file
721
722     # name of your project
723     Name = 'testpost'
724     
725     # file to post (complete body and pseudo-headers)
726     # ($File.cfg contains data on last posting and last MID)
727     File = 'test.txt'
728     
729     # how often your project should be posted
730     # use (d)ay OR (w)eek OR (m)onth OR (y)ear
731     Posting-frequency = '1d'
732     
733     # time period after which the posting should expire
734     # use (d)ay OR (w)eek OR (m)onth OR (y)ear
735     # Expires = '3m'
736     
737     # header "From:"
738     From = 'test@domain.invalid'
739     
740     # header "Subject:"
741     # (may contain "%LM" which will be replaced by the contents of the
742     #  Last-Modified pseudo header).
743     Subject = 'test noreply ignore'
744     
745     # comma-separated list of newsgroup(s) to post to
746     # (header "Newsgroups:")
747     NGs = 'de.test'
748     
749     # header "Followup-To:"
750     # Fup2 = 'poster'
751     
752     # Message-ID ("%n" is $Name)
753     # MID-Format = '<%n-%d.%m.%y@domain.invalid>'
754     
755     # Supersede last posting?
756     Supersede = yes
757     
758     # extra headers (appended verbatim)
759     # use this for custom headers like "Approved:"
760     ExtraHeader = 'Approved: moderator@domain.invalid
761     X-Header: Some text'
762     
763     # other projects may follow separated with "====="
764     =====
765     
766     Name = 'othertest'
767     File = 'test.txt'
768     Posting-frequency = '2m'
769     From = 'My Name <my.name@domain.invalid>'
770     Subject = 'Test of yapfag <%LM>'
771     NGs = 'de.test,de.alt.test'
772     Fup2 = 'de.test'
773     MID-Format = '<%n-%m.%y@domain.invalid>'
774     Supersede = yes
775
776 =head3 Status Information
777
778 Information about the last post and about how to form message IDs for
779 posts is stored in a file named F<I<project name>.cfg> which will be
780 generated if it does not exist. Each of those status files will
781 contain two lines, the first being the date of the last time the FAQ
782 was posted and the second being the message ID of that incarnation.
783
784 =head2 Runtime Configuration
785
786 Apart from configuring which FAQ(s) to post you may (re)set some
787 runtime configuration variables via the .rcfile (by default
788 F<.yapfaqrc>). F<.yapfaqrc> must contain one definition in the form of
789 I<param = value> on each line; everything after a "#" sign is ignored.
790
791 If you omit some settings they will be set to default values hardcoded
792 in F<yapfaq.pl>.
793
794 B<Please note that all parameter names are case-sensitive!>
795
796 =over 4
797
798 =item B<NNTPServer> = I<NNTP server> (mandatory)
799
800 Host name of the NNTP server to post to. Must be set (or omitted; the
801 default is "localhost"); if set to en empty string, B<yapfaq> falls
802 back to Perl's build-in defaults (contents of environment variables
803 NNTPSERVER and NEWSHOST; if not set, default from Net::Config; if not
804 set, "news" is used).
805
806 =item B<NNTPUser> = I<user name> (optional)
807
808 User name used for authentication with the NNTP server (I<AUTHINFO
809 USER>).
810
811 This setting is optional; if it is not set, I<NNTPPass> is ignored and
812 no authentication is tried.
813
814 =item B<NNTPPass> = I<password> (optional)
815
816 Password used for authentication with the NNTP server (I<AUTHINFO
817 PASS>).
818
819 This setting is optional; it must be set if I<NNTPUser> is present.
820
821 =item B<Sender> = I<Sender header> (optional)
822
823 The Sender header that will be added to every posted message.
824
825 This setting is optional.
826
827 =item B<ConfigFile> = I<configuration file> (mandatory)
828
829 The configuration file defining the FAQ(s) to post. Must be set (or
830 omitted; the default is "yapfaq.cfg").
831
832 =item B<UsePGP> = I<whether to add a digital signature> (optional)
833
834 Boolean value (0 or 1) controlling whether the FAQs will get digitally
835 signed via an X-PGP-Sig header.
836
837 This setting is optional; the default is 0.
838
839 If you have set I<UsePGP> to 1, you must also supply the necessary
840 information on your PGP oder GPG installation; please refer to the
841 sample F<.yapfaqrc> file (see below) for more information on this
842 topic.
843
844 =back
845
846 =head3 Example runtime configuration file
847
848     NNTPServer = 'localhost'
849     NNTPUser   = ''
850     NNTPPass   = ''
851     Sender     = ''
852     ConfigFile = 'yapfaq.cfg'
853     UsePGP     = 0
854
855     ################################## PGP-Config #################################
856     pgp        = '/usr/bin/pgp'                  # path to pgp
857     PGPVersion = '2'                             # Use 2 for 2.X 5 for PGP > 2.X and GPG for GPG
858     PGPSigner  = ''                              # sign as who?
859     PGPPass    = ''                              # pgp2 only
860     PathtoPGPPass = ''                           # pgp2 pgp5 and gpg
861     pgpbegin   = '-----BEGIN PGP SIGNATURE-----' # Begin of PGP-Signature
862     pgpend     = '-----END PGP SIGNATURE-----'   # End of PGP-Signature
863     pgptmpf    = 'pgptmp'                        # temporary file for PGP.
864     pgpheader  = 'X-PGP-Sig'
865
866 =head3 Using more than one runtime configuration
867
868 You may use more than one runtime configuration file with the B<-c>
869 option (see below).
870
871 =head1 OPTIONS
872
873 =over 3
874
875 =item B<-V> (version)
876
877 Print out version and copyright information on B<yapfaq> and exit.
878
879 =item B<-h> (help)
880
881 Print this man page and exit.
882
883 =item B<-v> (verbose)
884
885 Print out status information while running to STDOUT.
886
887 =item B<-p> (post unconditionally)
888
889 Post (all) FAQs unconditionally ignoring the posting frequency setting.
890
891 You may want to use this with the B<-f> option (see below).
892
893 =item B<-d> (dry run)
894
895 Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
896 update any status information.
897
898 =item B<-t> I<newsgroup(s) | CONSOLE> (test)
899
900 Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
901 newsgroups given after B<-t> as a comma-separated list or print the
902 FAQs to STDOUT separated by lines of dashes if the special string
903 C<CONSOLE> is given.  This can be used to preview what B<yapfaq> would
904 do without embarassing yourself on Usenet.  The status files are not
905 updated when this option is given.
906
907 You may want to use this with the B<-f> option (see below).
908
909 =item B<-f> I<project name>
910
911 Just deal with one FAQ only.
912
913 By default B<yapfaq> will work on all FAQs that are defined in
914 F<yapfaq.cfg>, check whether they are due for posting and - if they
915 are - post them. Consequently when the B<-p> option is set all FAQs
916 will be posted unconditionally. That may not be what you want to
917 achieve, so you can limit the operation of B<yapfaq> to the named FAQ
918 only.
919
920 =item B<-s> I<program> (pipe to script)
921
922 Instead of posting the article(s) to Usenet pipe them to the external
923 I<program> on STDIN (which may post the article(s) then). A return
924 value of 0 will be considered success.
925
926 =item B<-c> I<.rc file>
927
928 Load another runtime configuration file (.rc file) than F<.yaofaq.rc>.
929
930 You may for example define another usenet server to post your FAQ(s)
931 to or load another configuration file defining (an)other FAQ(s).
932
933 =back
934
935 =head1 EXAMPLES
936
937 Post all FAQs that are due for posting:
938
939     yapfaq
940
941 Do a dry run, showing which FAQs would be posted:
942
943     yapfaq -dv
944
945 Do a test run and print on STDOUT what the FAQ I<myfaq> would look
946 like when posted, regardless whether it is due for posting or not:
947
948     yapfaq -pt CONSOLE -f myfaq
949
950 Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
951 if it is due:
952
953     yapfaq -t de.test -f myfaq
954
955 Post all FAQs (that are due for posting) using inews from INN:
956
957     yapfaq -s inews
958
959 Do a dry run using a runtime configuration from .alternaterc, showing
960 which FAQs would be posted:
961
962     yapfaq -dvc .alternaterc
963
964 =head1 ENVIRONMENT
965
966 =over 4
967
968 =item NNTPSERVER
969
970 The default NNTP server to post to, used by the Net::NNTP module. You
971 can also  specify the server using the runtime configuration file (by
972 default F<.yapfaqrc>).
973
974 =back
975
976 =head1 FILES
977
978 =over 4
979
980 =item F<yapfaq.pl>
981
982 The script itself.
983
984 =item F<.yapfaqrc>
985
986 Runtime configuration file for B<yapfaq>.
987
988 =item F<yapfaq.cfg>
989
990 Configuration file for B<yapfaq>.
991
992 =item F<*.cfg>
993
994 Status data on FAQs.
995
996 The status files will be created on successful posting if they don't
997 already exist. The first line of the file will be the date of the last
998 time the FAQ was posted and the second line will be the message ID of
999 the last post of that FAQ.
1000
1001 =back
1002
1003 =head1 BUGS
1004
1005 Many, I'm sure.
1006
1007 =head1 SEE ALSO
1008
1009 L<http://th-h.de/download/scripts.php> will have the current
1010 version of this program.
1011
1012 =head1 AUTHOR
1013
1014 Thomas Hochstein <thh@inter.net>
1015
1016 Original author (up to version 0.5b, dating from 2003):
1017 Marc Brockschmidt <marc@marcbrockschmidt.de>
1018
1019 =head1 COPYRIGHT AND LICENSE
1020
1021 Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
1022
1023 Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
1024
1025 This program is free software; you may redistribute it and/or modify it
1026 under the same terms as Perl itself.
1027
1028 =cut
This page took 0.038878 seconds and 4 git commands to generate.