Fix: Consistency check for MID-Format fixed (regexp).
[usenet/yapfaq.git] / yapfaq.pl
... / ...
CommitLineData
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
15my $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"
19my $RCFile = '.yapfaqrc';
20# Valid configuration variables for use in a .rc file
21my @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.
28my %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
46my @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
51my @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
60use strict;
61use Net::NNTP;
62use Net::Domain qw(hostfqdn);
63use Date::Calc qw(Add_Delta_YM Add_Delta_Days Delta_Days Today);
64use Fcntl ':flock'; # import LOCK_* constants
65use Getopt::Std;
66my ($TDY, $TDM, $TDD) = Today(); #TD: Today's date
67
68# read commandline options
69my %Options;
70getopts('Vhvpdt:f:c:s:', \%Options);
71# -V: print version / copyright information
72if ($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
78if ($Options{'h'}) {
79 exec ('perldoc', $0);
80 exit(0);
81};
82# -f: set $Faq
83my ($Faq) = $Options{'f'} if ($Options{'f'});
84
85# read runtime configuration (configuration variables)
86$RCFile = $Options{'c'} if ($Options{'c'});
87if (-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)
94my @Config;
95readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq);
96
97# for each FAQ:
98# - parse configuration
99# - read status data
100# - if FAQ is due: call postfaq()
101foreach (@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
144exit;
145
146#################################### readrc ####################################
147# Takes a filename and the reference to an array which contains the valid options
148
149sub 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
170sub 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
231sub 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
247sub 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
263sub 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
362sub 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
414sub 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.
459sub 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
578yapfaq - Post Usenet FAQs I<(yet another postfaq)>
579
580=head1 SYNOPSIS
581
582B<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
590Perl 5.8 or later
591
592=item -
593
594Net::NNTP
595
596=item -
597
598Date::Calc
599
600=item -
601
602Getopt::Std
603
604=back
605
606Furthermore you need access to a news server to actually post FAQs.
607
608=head1 DESCRIPTION
609
610B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
611frequency (every n days, weeks, months or years), adding all necessary
612headers as defined in its config file (by default F<yapfaq.cfg>).
613
614=head2 Configuration
615
616F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
617a single line, each containing the configuration for one FAQ as a set
618of definitions in the form of I<param = value>. Everything after a "#"
619sign is ignored so you may comment your configuration file.
620
621=over 4
622
623=item B<Name> = I<project name>
624
625A name referring to your FAQ, also used for generation of a Message-ID.
626
627This value must be set.
628
629=item B<File> = I<file name>
630
631A file containing the message body of your FAQ and all pseudo headers
632(subheaders in the news.answers style).
633
634This value must be set.
635
636=item B<Posting-frequency> = I<time period>
637
638The posting frequency defines how often your FAQ will be posted.
639B<yapfaq> will only post your FAQ if this period of time has passed
640since the last posting.
641
642You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
643or I<B<m>onths> or I<B<y>ears>.
644
645This value must be set.
646
647=item B<Expires> = I<time period> (optional)
648
649The period of time after which your message will expire. An Expires
650header will be calculated adding this time period to today's date.
651
652You can declare this time period either in I<B<d>ays> or I<B<w>weeks>
653or I<B<m>onths> or I<B<y>ears>.
654
655This setting is optional; the default is 3 months.
656
657=item B<From> = I<author>
658
659The author of your FAQ as it will appear in the From header of the
660message.
661
662This value must be set.
663
664=item B<Subject> = I<subject>
665
666The title of your FAQ as it will appear in the Subject header of the
667message.
668
669You may use the special string C<%LM> which will be replaced with
670the contents of the Last-Modified subheader in your I<File>.
671
672This value must be set.
673
674=item B<NGs> = I<newsgroups>
675
676A comma-separated list of newsgroup(s) to post your FAQ to as it will
677appear in the Newsgroups header of the message.
678
679This value must be set.
680
681=item B<Fup2> = I<newsgroup | poster> (optional)
682
683A comma-separated list of newsgroup(s) or the special string I<poster>
684as it will appear in the Followup-To header of the message.
685
686This setting is optional.
687
688=item B<MID-Format> = I<pattern> (optional)
689
690A pattern from which the message ID is generated as it will appear in
691the Message-ID header of the message.
692
693You may use the special strings C<%n> for the I<Name> of your project,
694C<%d> for the date the message is posted, C<%m> for the month, C<%y>
695for the year and C<%t> for a time stamp (number of seconds since the
696epoch), respectively.
697
698This setting is optional; the default is '<%n-%d.%m.%y@I<YOURHOST>>'
699where I<YOURHOST> is the fully qualified domain name (FQDN) of the
700host B<yapfaq> is running on. Obviously that will only work if you
701have defined a reasonable hostname that the hostfqdn() function of
702Net::Domain can return.
703
704=item B<Supersede> = I<yes> (optional)
705
706Add Supersedes header to the message containing the Message-ID header
707of the last posting.
708
709This setting is optional; you should set it to yes or leave it out.
710
711=item B<ExtraHeader> = I<additional headers> (optional)
712
713The contents of I<ExtraHeader> is added verbatim to the headers of
714your message so you can add custom headers like Approved.
715
716This 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
778Information about the last post and about how to form message IDs for
779posts is stored in a file named F<I<project name>.cfg> which will be
780generated if it does not exist. Each of those status files will
781contain two lines, the first being the date of the last time the FAQ
782was posted and the second being the message ID of that incarnation.
783
784=head2 Runtime Configuration
785
786Apart from configuring which FAQ(s) to post you may (re)set some
787runtime configuration variables via the .rcfile (by default
788F<.yapfaqrc>). F<.yapfaqrc> must contain one definition in the form of
789I<param = value> on each line; everything after a "#" sign is ignored.
790
791If you omit some settings they will be set to default values hardcoded
792in F<yapfaq.pl>.
793
794B<Please note that all parameter names are case-sensitive!>
795
796=over 4
797
798=item B<NNTPServer> = I<NNTP server> (mandatory)
799
800Host name of the NNTP server to post to. Must be set (or omitted; the
801default is "localhost"); if set to en empty string, B<yapfaq> falls
802back to Perl's build-in defaults (contents of environment variables
803NNTPSERVER and NEWSHOST; if not set, default from Net::Config; if not
804set, "news" is used).
805
806=item B<NNTPUser> = I<user name> (optional)
807
808User name used for authentication with the NNTP server (I<AUTHINFO
809USER>).
810
811This setting is optional; if it is not set, I<NNTPPass> is ignored and
812no authentication is tried.
813
814=item B<NNTPPass> = I<password> (optional)
815
816Password used for authentication with the NNTP server (I<AUTHINFO
817PASS>).
818
819This setting is optional; it must be set if I<NNTPUser> is present.
820
821=item B<Sender> = I<Sender header> (optional)
822
823The Sender header that will be added to every posted message.
824
825This setting is optional.
826
827=item B<ConfigFile> = I<configuration file> (mandatory)
828
829The configuration file defining the FAQ(s) to post. Must be set (or
830omitted; the default is "yapfaq.cfg").
831
832=item B<UsePGP> = I<whether to add a digital signature> (optional)
833
834Boolean value (0 or 1) controlling whether the FAQs will get digitally
835signed via an X-PGP-Sig header.
836
837This setting is optional; the default is 0.
838
839If you have set I<UsePGP> to 1, you must also supply the necessary
840information on your PGP oder GPG installation; please refer to the
841sample F<.yapfaqrc> file (see below) for more information on this
842topic.
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
868You may use more than one runtime configuration file with the B<-c>
869option (see below).
870
871=head1 OPTIONS
872
873=over 3
874
875=item B<-V> (version)
876
877Print out version and copyright information on B<yapfaq> and exit.
878
879=item B<-h> (help)
880
881Print this man page and exit.
882
883=item B<-v> (verbose)
884
885Print out status information while running to STDOUT.
886
887=item B<-p> (post unconditionally)
888
889Post (all) FAQs unconditionally ignoring the posting frequency setting.
890
891You may want to use this with the B<-f> option (see below).
892
893=item B<-d> (dry run)
894
895Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
896update any status information.
897
898=item B<-t> I<newsgroup(s) | CONSOLE> (test)
899
900Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
901newsgroups given after B<-t> as a comma-separated list or print the
902FAQs to STDOUT separated by lines of dashes if the special string
903C<CONSOLE> is given. This can be used to preview what B<yapfaq> would
904do without embarassing yourself on Usenet. The status files are not
905updated when this option is given.
906
907You may want to use this with the B<-f> option (see below).
908
909=item B<-f> I<project name>
910
911Just deal with one FAQ only.
912
913By default B<yapfaq> will work on all FAQs that are defined in
914F<yapfaq.cfg>, check whether they are due for posting and - if they
915are - post them. Consequently when the B<-p> option is set all FAQs
916will be posted unconditionally. That may not be what you want to
917achieve, so you can limit the operation of B<yapfaq> to the named FAQ
918only.
919
920=item B<-s> I<program> (pipe to script)
921
922Instead of posting the article(s) to Usenet pipe them to the external
923I<program> on STDIN (which may post the article(s) then). A return
924value of 0 will be considered success.
925
926=item B<-c> I<.rc file>
927
928Load another runtime configuration file (.rc file) than F<.yaofaq.rc>.
929
930You may for example define another usenet server to post your FAQ(s)
931to or load another configuration file defining (an)other FAQ(s).
932
933=back
934
935=head1 EXAMPLES
936
937Post all FAQs that are due for posting:
938
939 yapfaq
940
941Do a dry run, showing which FAQs would be posted:
942
943 yapfaq -dv
944
945Do a test run and print on STDOUT what the FAQ I<myfaq> would look
946like when posted, regardless whether it is due for posting or not:
947
948 yapfaq -pt CONSOLE -f myfaq
949
950Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
951if it is due:
952
953 yapfaq -t de.test -f myfaq
954
955Post all FAQs (that are due for posting) using inews from INN:
956
957 yapfaq -s inews
958
959Do a dry run using a runtime configuration from .alternaterc, showing
960which FAQs would be posted:
961
962 yapfaq -dvc .alternaterc
963
964=head1 ENVIRONMENT
965
966=over 4
967
968=item NNTPSERVER
969
970The default NNTP server to post to, used by the Net::NNTP module. You
971can also specify the server using the runtime configuration file (by
972default F<.yapfaqrc>).
973
974=back
975
976=head1 FILES
977
978=over 4
979
980=item F<yapfaq.pl>
981
982The script itself.
983
984=item F<.yapfaqrc>
985
986Runtime configuration file for B<yapfaq>.
987
988=item F<yapfaq.cfg>
989
990Configuration file for B<yapfaq>.
991
992=item F<*.cfg>
993
994Status data on FAQs.
995
996The status files will be created on successful posting if they don't
997already exist. The first line of the file will be the date of the last
998time the FAQ was posted and the second line will be the message ID of
999the last post of that FAQ.
1000
1001=back
1002
1003=head1 BUGS
1004
1005Many, I'm sure.
1006
1007=head1 SEE ALSO
1008
1009L<http://th-h.de/download/scripts.php> will have the current
1010version of this program.
1011
1012=head1 AUTHOR
1013
1014Thomas Hochstein <thh@inter.net>
1015
1016Original author (up to version 0.5b, dating from 2003):
1017Marc Brockschmidt <marc@marcbrockschmidt.de>
1018
1019=head1 COPYRIGHT AND LICENSE
1020
1021Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
1022
1023Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
1024
1025This program is free software; you may redistribute it and/or modify it
1026under the same terms as Perl itself.
1027
1028=cut
This page took 0.01323 seconds and 4 git commands to generate.