Add option '-c': define another .rcfile.
[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
TH
212 unless(defined($$Config[$i]{'mid-format'}) && $$Config[$i]{'mid-format'} =~ /^<\S+\@\S{2,}\.\S{2,}>$/) {
213 warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" seems to be invalid - set to default.\n";
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}
235
dc88d139
TH
236################################## postfaq ##################################
237# Takes a filename and many other vars.
238#
239# It reads the data-file $File and then posts the article.
240
241sub postfaq {
0c6ebe78 242 my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_;
dc88d139
TH
243 my (@Header,@Body,$MID,$InRealBody,$LastModified);
244
366322b2 245 print "$$ActName: Preparing to post.\n" if($Options{'v'});
4251e545 246
dc88d139
TH
247 #Prepare MID:
248 $$TDM = ($$TDM < 10 && $$TDM !~ /^0/) ? "0" . $$TDM : $$TDM;
249 $$TDD = ($$TDD < 10 && $$TDD !~ /^0/) ? "0" . $$TDD : $$TDD;
250
251 $MID = $$MIDF;
dbca4ad8 252 $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID);
dc88d139
TH
253 $MID =~ s/\%n/$$ActName/g;
254 $MID =~ s/\%d/$$TDD/g;
255 $MID =~ s/\%m/$$TDM/g;
256 $MID =~ s/\%y/$$TDY/g;
257
dc88d139
TH
258 #Now get the body:
259 open (FH, "<$$File");
260 while (<FH>){
261 s/\r//;
262 push (@Body, $_), next if $InRealBody;
263 $InRealBody++ if /^$/;
8e1cb154 264 $LastModified = $1 if /^Last-modified: (\S+)$/i;
dc88d139
TH
265 push @Body, $_;
266 }
267 close FH;
268 push @Body, "\n" if ($Body[-1] ne "\n");
269
270 #Create Date- and Expires-Header:
271 my @time = localtime;
272 my $ss = ($time[0]<10) ? "0" . $time[0] : $time[0];
273 my $mm = ($time[1]<10) ? "0" . $time[1] : $time[1];
274 my $hh = ($time[2]<10) ? "0" . $time[2] : $time[2];
275 my $day = $time[3];
276 my $month = ($time[4]+1<10) ? "0" . ($time[4]+1) : $time[4]+1;
277 my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]];
278 my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]];
279 my $year = (1900 + $time[5]);
280 my $tz = $time[8] ? " +0200" : " +0100";
7823ece9
TH
281
282 $$Expire = '3m' if !$$Expire; # set default if unset: 3 month
283
0c6ebe78 284 my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire);
dc88d139
TH
285 my $expmonthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$expM-1];
286
287 my $date = "$day $monthN $year " . $hh . ":" . $mm . ":" . $ss . $tz;
288 my $expdate = "$expD $expmonthN $expY $hh:$mm:$ss$tz";
0c6ebe78 289
dc88d139
TH
290 #Replace %LM by the content of the news.answer-pseudo-header Last-modified:
291 if ($LastModified) {
292 $$Subject =~ s/\%LM/$LastModified/;
293 }
294
4251e545
TH
295 # Test mode?
296 if($Options{'t'} and $Options{'t'} !~ /console/i) {
297 $$NG = $Options{'t'};
298 }
299
dc88d139
TH
300 #Now create the complete Header:
301 push @Header, "From: $$From\n";
302 push @Header, "Newsgroups: $$NG\n";
303 push @Header, "Followup-To: $$Fup2\n" if $$Fup2;
304 push @Header, "Subject: $$Subject\n";
305 push @Header, "Message-ID: $MID\n";
306 push @Header, "Supersedes: $$Supersedes\n" if $$Supersedes;
307 push @Header, "Date: $date\n";
308 push @Header, "Expires: $expdate\n";
309 push @Header, "Sender: $$Sender\n" if $$Sender;
310 push @Header, "Mime-Version: 1.0\n";
311 push @Header, "Reply-To: $$ReplyTo\n" if $$ReplyTo;
312 push @Header, "Content-Type: text/plain; charset=ISO-8859-15\n";
313 push @Header, "Content-Transfer-Encoding: 8bit\n";
314 push @Header, "User-Agent: yapfaq/$Version\n";
315 if ($$ExtraHeaders) {
316 push @Header, "$_\n" for (split /\n/, $$ExtraHeaders);
317 }
318
b9550622 319 # sign article if $UsePGP is true
2507947f 320 my @Article = ($Config{'UsePGP'})?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body);
dc88d139 321
b9550622 322 # post article
366322b2 323 print "$$ActName: Posting article ...\n" if($Options{'v'});
dc88d139
TH
324 post(\@Article);
325
5ddba442
TH
326 # Test mode?
327 return if($Options{'t'});
328
b9550622 329 # otherwise: update status data
366322b2 330 print "$$ActName: Save status information.\n" if($Options{'v'});
4251e545 331
74407146 332 open (FH, ">$$File.cfg") or die "$0: E: Can't open $$File.cfg: $!";
dc88d139
TH
333 print FH "##;; Lastpost: $day.$month.$year\n";
334 print FH "##;; LastMID: $MID\n";
335 close FH;
336}
337
338################################## post ##################################
339# Takes a complete article (Header and Body).
340#
341# It opens a connection to $NNTPServer and posts the message.
342
343sub post {
344 my ($ArticleR) = @_;
345
4251e545
TH
346 # Test mode?
347 if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) {
55bfbd3c 348 print "-----BEGIN--------------------------------------------------\n";
4251e545 349 print @$ArticleR;
55bfbd3c 350 print "------END---------------------------------------------------\n";
4251e545
TH
351 return;
352 }
353
b855559e
TH
354 # pipe to script?
355 if(defined($Options{'s'})) {
356 open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n";
357 print POST @$ArticleR;
358 close POST;
359 return;
360 }
361
2507947f
TH
362 my $NewsConnection = Net::NNTP->new($Config{'NNTPServer'}, Reader => 1) or die "$0: E: Can't connect to news server '$Config{'NNTPServer'}'!\n";
363 $NewsConnection->authinfo ($Config{'NNTPUser'}, $Config{'NNTPPass'}) if (defined($Config{'NNTPUser'}));
dc88d139
TH
364 $NewsConnection->post();
365 $NewsConnection->datasend (@$ArticleR);
366 $NewsConnection->dataend();
367
b9550622 368 # Posting failed? Save to ERROR.dat
dc88d139
TH
369 if (!$NewsConnection->ok()) {
370 open FH, ">>ERROR.dat";
114be302 371 print FH "\nPosting failed! Saving to ERROR.dat. Response from news server:\n";
dc88d139
TH
372 print FH $NewsConnection->code();
373 print FH $NewsConnection->message();
374 print FH "\n";
375 print FH @$ArticleR;
376 print FH "-" x 80, "\n";
377 close FH;
378 }
379
380 $NewsConnection->quit();
381}
382
383#-------- sub getpgpcommand
384# getpgpcommand generates the command to sign the message and returns it.
385#
386# Receives:
387# - $PGPVersion: A scalar holding the PGPVersion
388sub getpgpcommand {
389 my ($PGPVersion) = @_;
390 my $PGPCommand;
391
392 if ($PGPVersion eq '2') {
2507947f
TH
393 if ($Config{'PathtoPGPPass'} && !$Config{'PGPPass'}) {
394 open (PGPPW, $Config{'PathtoPGPPass'}) or die "$0: E: Can't open $Config{'PathtoPGPPass'}: $!";
395 Config{'$PGPPass'} = <PGPPW>;
dc88d139
TH
396 close PGPPW;
397 }
398
2507947f
TH
399 if (Config{'$PGPPass'}) {
400 $PGPCommand = "PGPPASS=\"".$Config{'PGPPass'}."\" ".$Config{'pgp'}." -u \"".$Config{'PGPSigner'}."\" +verbose=0 language='en' -saft <".$Config{'pgptmpf'}.".txt >".$Config{'pgptmpf'}.".txt.asc";
dc88d139 401 } else {
74407146 402 die "$0: E: PGP-Passphrase is unknown!\n";
dc88d139
TH
403 }
404 } elsif ($PGPVersion eq '5') {
2507947f
TH
405 if ($Config{'PathtoPGPPass'}) {
406 $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 407 } else {
74407146 408 die "$0: E: PGP-Passphrase is unknown!\n";
dc88d139
TH
409 }
410 } elsif ($PGPVersion =~ m/GPG/io) {
2507947f
TH
411 if (Config{'$PathtoPGPPass'}) {
412 $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 413 } else {
74407146 414 die "$0: E: Passphrase is unknown!\n";
dc88d139
TH
415 }
416 } else {
74407146 417 die "$0: E: Unknown PGP-Version $PGPVersion!";
dc88d139
TH
418 }
419 return $PGPCommand;
420}
421
422
423#-------- sub signarticle
424# signarticle signs an articel and returns a reference to an array
425# containing the whole signed Message.
426#
427# Receives:
428# - $HeaderAR: A reference to a array containing the articles headers.
429# - $BodyR: A reference to an array containing the body.
430#
431# Returns:
432# - $MessageRef: A reference to an array containing the whole message.
433sub signpgp {
434 my ($HeaderAR, $BodyR) = @_;
435 my (@pgphead, @pgpbody, $pgphead, $pgpbody, $header, $signheaders, @signheaders, $currentheader, $HeaderR, $line);
436
437 foreach my $line (@$HeaderAR) {
438 if ($line =~ /^(\S+):\s+(.*)$/s) {
439 $currentheader = $1;
440 $$HeaderR{lc($currentheader)} = "$1: $2";
441 } else {
442 $$HeaderR{lc($currentheader)} .= $line;
443 }
444 }
445
446 foreach (@PGPSignHeaders) {
447 if (defined($$HeaderR{lc($_)}) && $$HeaderR{lc($_)} =~ m/^[^\s:]+: .+/o) {
448 push @signheaders, $_;
449 }
450 }
451
452 $pgpbody = join ("", @$BodyR);
453
454 # Delete and create the temporary pgp-Files
2507947f
TH
455 unlink "$Config{'pgptmpf'}.txt";
456 unlink "$Config{'pgptmpf'}.txt.asc";
dc88d139
TH
457 $signheaders = join(",", @signheaders);
458
459 $pgphead = "X-Signed-Headers: $signheaders\n";
460 foreach $header (@signheaders) {
461 if ($$HeaderR{lc($header)} =~ m/^[^\s:]+: (.+?)\n?$/so) {
462 $pgphead .= $header.": ".$1."\n";
463 }
464 }
465
2507947f 466 open(FH, ">" . $Config{'pgptmpf'} . ".txt") or die "$0: E: can't open $Config{'pgptmpf'}: $!\n";
dc88d139 467 print FH $pgphead, "\n", $pgpbody;
2507947f 468 print FH "\n" if ($Config{'PGPVersion'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
74407146 469 close(FH) or warn "$0: W: Couldn't close TMP: $!\n";
dc88d139
TH
470
471 # Start PGP, then read the signature;
2507947f 472 my $PGPCommand = getpgpcommand($Config{'PGPVersion'});
dc88d139
TH
473 `$PGPCommand`;
474
2507947f
TH
475 open (FH, "<" . $Config{'pgptmpf'} . ".txt.asc") or die "$0: E: can't open ".$Config{'pgptmpf'}.".txt.asc: $!\n";
476 $/ = "$Config{'pgpbegin'}\n";
dc88d139 477 $_ = <FH>;
2507947f
TH
478 unless (m/\Q$Config{'pgpbegin'}\E$/o) {
479# unlink $Config{'pgptmpf'} . ".txt";
480# unlink $Config{'pgptmpf'} . ".txt.asc";
481 die "$0: E: $Config{'pgpbegin'} not found in ".$Config{'pgptmpf'}.".txt.asc\n"
dc88d139 482 }
2507947f 483 unlink($Config{'pgptmpf'} . ".txt") or warn "$0: W: Couldn't unlink $Config{'pgptmpf'}.txt: $!\n";
dc88d139
TH
484
485 $/ = "\n";
486 $_ = <FH>;
487 unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
2507947f
TH
488 unlink $Config{'pgptmpf'} . ".txt";
489 unlink $Config{'pgptmpf'} . ".txt.asc";
74407146 490 die "$0: E: didn't find PGP Version line where expected.\n";
dc88d139
TH
491 }
492
493 if (defined($2)) {
2507947f 494 $$HeaderR{$Config{'pgpheader'}} = $1."-".$2." ".$signheaders;
dc88d139 495 } else {
2507947f 496 $$HeaderR{$Config{'pgpheader'}} = $1." ".$signheaders;
dc88d139
TH
497 }
498
499 do { # skip other pgp headers like
500 $_ = <FH>; # "charset:"||"comment:" until empty line
501 } while ! /^$/;
502
503 while (<FH>) {
504 chomp;
2507947f
TH
505 last if /^\Q$Config{'pgpend'}\E$/;
506 $$HeaderR{$Config{'pgpheader'}} .= "\n\t$_";
dc88d139
TH
507 }
508
2507947f 509 $$HeaderR{$Config{'pgpheader'}} .= "\n" unless ($$HeaderR{$Config{'pgpheader'}} =~ /\n$/s);
dc88d139
TH
510
511 $_ = <FH>;
512 unless (eof(FH)) {
2507947f
TH
513 unlink $Config{'pgptmpf'} . ".txt";
514 unlink $Config{'pgptmpf'} . ".txt.asc";
515 die "$0: E: unexpected data following $Config{'pgpend'}\n";
dc88d139
TH
516 }
517 close(FH);
2507947f 518 unlink "$Config{'pgptmpf'}.txt.asc";
dc88d139 519
2507947f
TH
520 my $tmppgpheader = $Config{'pgpheader'} . ": " . $$HeaderR{$Config{'pgpheader'}};
521 delete $$HeaderR{$Config{'pgpheader'}};
dc88d139
TH
522
523 @pgphead = ();
524 foreach $header (@PGPorderheaders) {
525 if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
526 push(@pgphead, "$$HeaderR{$header}");
527 delete $$HeaderR{$header};
528 }
529 }
530
531 foreach $header (keys %$HeaderR) {
532 if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
533 push(@pgphead, "$$HeaderR{$header}");
534 delete $$HeaderR{$header};
535 }
536 }
537
2507947f 538 push @pgphead, ("X-PGP-Key: " . $Config{'PGPSigner'} . "\n"), $tmppgpheader;
dc88d139
TH
539 undef $tmppgpheader;
540
541 @pgpbody = split /$/m, $pgpbody;
542 my @pgpmessage = (@pgphead, "\n", @pgpbody);
543 return \@pgpmessage;
544}
272b0243
TH
545
546__END__
547
548################################ Documentation #################################
549
550=head1 NAME
551
552yapfaq - Post Usenet FAQs I<(yet another postfaq)>
553
554=head1 SYNOPSIS
555
b855559e 556B<yapfaq> [B<-hvpd>] [B<-t> I<newsgroups> | CONSOLE] [B<-f> I<project name>] [B<-s> I<program>]
272b0243
TH
557
558=head1 REQUIREMENTS
559
560=over 2
561
562=item -
563
564Perl 5.8 or later
565
566=item -
567
568Net::NNTP
569
570=item -
571
572Date::Calc
573
574=item -
575
576Getopt::Std
577
578=back
579
580Furthermore you need access to a news server to actually post FAQs.
581
582=head1 DESCRIPTION
583
584B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
585frequency (every n days, weeks, months or years), adding all necessary
586headers as defined in its config file (by default F<yapfaq.cfg>).
587
588=head2 Configuration
589
590F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
591a single line, each containing the configuration for one FAQ as a set
592of definitions in the form of I<param = value>.
593
594=over 4
595
596=item B<Name> = I<project name>
597
598A name referring to your FAQ, also used for generation of a Message-ID.
599
600This value must be set.
601
602=item B<File> = I<file name>
603
604A file containing the message body of your FAQ and all pseudo headers
605(subheaders in the news.answers style).
606
607This value must be set.
608
609=item B<Posting-frequency> = I<time period>
610
611The posting frequency defines how often your FAQ will be posted.
612B<yapfaq> will only post your FAQ if this period of time has passed
613since the last posting.
614
615You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
616or I<B<m>onths> or I<B<y>ears>.
617
618This value must be set.
619
620=item B<Expires> = I<time period>
621
622The period of time after which your message will expire. An Expires
623header will be calculated adding this time period to today's date.
624
625You can declare this time period either in I<B<d>ays> or I<B<w>weeks>
626or I<B<m>onths> or I<B<y>ears>.
627
628This setting is optional; the default is 3 months.
629
630=item B<From> = I<author>
631
632The author of your FAQ as it will appear in the From header of the
633message.
634
635This value must be set.
636
637=item B<Subject> = I<subject>
638
639The title of your FAQ as it will appear in the Subject header of the
640message.
641
642You may use the special string C<%LM> which will be replaced with
643the contents of the Last-Modified subheader in your I<File>.
644
645This value must be set.
646
647=item B<NGs> = I<newsgroups>
648
649A comma-separated list of newsgroup(s) to post your FAQ to as it will
650appear in the Newsgroups header of the message.
651
652This value must be set.
653
654=item B<Fup2> = I<newsgroup | poster>
655
656A comma-separated list of newsgroup(s) or the special string I<poster>
657as it will appear in the Followup-To header of the message.
658
659This setting is optional.
660
661=item B<MID-Format> = I<pattern>
662
663A pattern from which the message ID is generated as it will appear in
664the Message-ID header of the message.
665
666You may use the special strings C<%n> for the I<Name> of your project,
667C<%d> for the date the message is posted, C<%m> for the month and
668C<%y> for the year, respectively.
669
670This value must be set.
671
672=item B<Supersede> = I<yes>
673
674Add Supersedes header to the message containing the Message-ID header
675of the last posting.
676
677This setting is optional; you should set it to yes or leave it out.
678
679=item B<ExtraHeader> = I<additional headers>
680
681The contents of I<ExtraHeader> is added verbatim to the headers of
682your message so you can add custom headers like Approved.
683
684This setting is optional.
685
686=back
687
688=head2 Example configuration file
689
690 # name of your project
691 Name = 'testpost'
692
693 # file to post (complete body and pseudo-headers)
694 # ($File.cfg contains data on last posting and last MID)
695 File = 'test.txt'
696
697 # how often your project should be posted
698 # use (d)ay OR (w)eek OR (m)onth OR (y)ear
699 Posting-frequency = '1d'
700
701 # time period after which the posting should expire
702 # use (d)ay OR (w)eek OR (m)onth OR (y)ear
703 Expires = '3m'
704
705 # header "From:"
706 From = 'test@domain.invalid'
707
708 # header "Subject:"
709 # (may contain "%LM" which will be replaced by the contents of the
710 # Last-Modified pseudo header).
711 Subject = 'test noreply ignore'
712
713 # comma-separated list of newsgroup(s) to post to
714 # (header "Newsgroups:")
715 NGs = 'de.test'
716
717 # header "Followup-To:"
718 Fup2 = 'poster'
719
720 # Message-ID ("%n" is $Name)
721 MID-Format = '<%n-%d.%m.%y@domain.invalid>'
722
723 # Supersede last posting?
724 Supersede = yes
725
726 # extra headers (appended verbatim)
727 # use this for custom headers like "Approved:"
728 ExtraHeader = 'Approved: moderator@domain.invalid
729 X-Header: Some text'
730
731 # other projects may follow separated with "====="
732 =====
733
734 Name = 'othertest'
735 File = 'test.txt'
736 Posting-frequency = '2m'
737 From = 'My Name <my.name@domain.invalid>'
738 Subject = 'Test of yapfag <%LM>'
739 NGs = 'de.test,de.alt.test'
740 Fup2 = 'de.test'
741 MID-Format = '<%n-%m.%y@domain.invalid>'
742 Supersede = yes
743
744Information about the last post and about how to form message IDs for
745posts is stored in a file named F<I<project name>.cfg> which will be
746generated if it does not exist. Each of those status files will
747contain two lines, the first being the date of the last time the FAQ
748was posted and the second being the message ID of that incarnation.
749
750=head1 OPTIONS
751
752=over 3
753
a052296f
TH
754=item B<-V> (version)
755
756Print out version and copyright information on B<yapfaq> and exit.
757
272b0243
TH
758=item B<-h> (help)
759
ae3b1b79 760Print this man page and exit.
272b0243
TH
761
762=item B<-v> (verbose)
763
764Print out status information while running to STDOUT.
765
766=item B<-p> (post unconditionally)
767
768Post (all) FAQs unconditionally ignoring the posting frequency setting.
769
770You may want to use this with the B<-f> option (see below).
771
772=item B<-d> (dry run)
773
774Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
775update any status information.
776
777=item B<-t> I<newsgroup(s) | CONSOLE> (test)
778
779Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
780newsgroups given after B<-t> as a comma-separated list or print the
781FAQs to STDOUT separated by lines of dashes if the special string
782C<CONSOLE> is given. This can be used to preview what B<yapfaq> would
783do without embarassing yourself on Usenet. The status files are not
784updated when this option is given.
785
786You may want to use this with the B<-f> option (see below).
787
788=item B<-f> I<project name>
789
790Just deal with one FAQ only.
791
792By default B<yapfaq> will work on all FAQs that are defined in
793F<yapfaq.cfg>, check whether they are due for posting and - if they
794are - post them. Consequently when the B<-p> option is set all FAQs
795will be posted unconditionally. That may not be what you want to
796achieve, so you can limit the operation of B<yapfaq> to the named FAQ
797only.
798
b855559e
TH
799=item B<-s> I<program> (pipe to script)
800
801Instead of posting the article(s) to Usenet pipe them to the external
802I<program> on STDIN (which may post the article(s) then). A return
803value of 0 will be considered success.
804
272b0243
TH
805=back
806
807=head1 EXAMPLES
808
809Post all FAQs that are due for posting:
810
811 yapfaq
812
813Do a dry run, showing which FAQs would be posted:
814
815 yapfaq -dv
816
817Do a test run and print on STDOUT what the FAQ I<myfaq> would look
818like when posted, regardless whether it is due for posting or not:
819
820 yapfaq -pt CONSOLE -f myfaq
821
822Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
823if it is due:
824
825 yapfaq -t de.test -f myfaq
826
827=head1 ENVIRONMENT
828
829There are no special environment variables used by B<yapfaq>.
830
831=head1 FILES
832
833=over 4
834
835=item F<yapfaq.pl>
836
837The script itself.
838
839=item F<yapfaq.cfg>
840
841Configuration file for B<yapfaq>.
842
843=item F<*.cfg>
844
845Status data on FAQs.
846
847The status files will be created on successful posting if they don't
848already exist. The first line of the file will be the date of the last
849time the FAQ was posted and the second line will be the message ID of
850the last post of that FAQ.
851
852=back
853
854=head1 BUGS
855
856Many, I'm sure.
857
858=head1 SEE ALSO
859
860L<http://th-h.de/download/scripts.php> will have the current
861version of this program.
862
863=head1 AUTHOR
864
865Thomas Hochstein <thh@inter.net>
866
867Original author (until version 0.5b from 2003):
868Marc Brockschmidt <marc@marcbrockschmidt.de>
869
870
871=head1 COPYRIGHT AND LICENSE
872
873Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
874
875Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
876
877This program is free software; you may redistribute it and/or modify it
878under the same terms as Perl itself.
879
880=cut
This page took 0.0643280000000001 seconds and 4 git commands to generate.