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