Fix: Consistency check for MID-Format fixed (regexp).
[usenet/yapfaq.git] / yapfaq.pl
CommitLineData
dc88d139
TH
1#! /usr/bin/perl -W
2#
ace701c4 3# yapfaq Version 0.7 by Thomas Hochstein
7aaba0e0 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
647af2ea 15my $Version = "0.8-prelease";
dc88d139 16
605916ef
TH
17# Please do not change this setting!
18# You may override the default .rc file (.yapfaqrc) by using "-c .rc file"
d60c2d5f 19my $RCFile = '.yapfaqrc';
605916ef 20# Valid configuration variables for use in a .rc file
d60c2d5f
TH
21my @ValidConfVars = ('NNTPServer','NNTPUser','NNTPPass','Sender','ConfigFile',
22 'UsePGP','pgp','PGPVersion','PGPSigner','PGPPass',
23 'PathtoPGPPass','pgpbegin','pgpend','pgptmpf','pgpheader');
24
605916ef
TH
25################################### Defaults ###################################
26# Please do not change anything in here!
27# Use a runtime configuration file (.yapfaqrc by default) to override defaults.
7ef63844 28my %Config = (NNTPServer => "",
2507947f
TH
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');
dc88d139
TH
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
605916ef 58################################# Main program #################################
dc88d139
TH
59
60use strict;
61use Net::NNTP;
40847f71 62use Net::Domain qw(hostfqdn);
dc88d139
TH
63use Date::Calc qw(Add_Delta_YM Add_Delta_Days Delta_Days Today);
64use Fcntl ':flock'; # import LOCK_* constants
4251e545 65use Getopt::Std;
dc88d139
TH
66my ($TDY, $TDM, $TDD) = Today(); #TD: Today's date
67
b9550622 68# read commandline options
4251e545 69my %Options;
86c0a100 70getopts('Vhvpdt:f:c:s:', \%Options);
b9550622 71# -V: print version / copyright information
a052296f
TH
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}
b9550622 77# -h: feed myself to perldoc
4251e545 78if ($Options{'h'}) {
ae3b1b79 79 exec ('perldoc', $0);
4251e545
TH
80 exit(0);
81};
b9550622 82# -f: set $Faq
4251e545
TH
83my ($Faq) = $Options{'f'} if ($Options{'f'});
84
d60c2d5f 85# read runtime configuration (configuration variables)
86c0a100
TH
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}
d60c2d5f 92
b9550622 93# read configuration (configured FAQs)
dc88d139 94my @Config;
2507947f 95readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq);
dc88d139 96
b9550622
TH
97# for each FAQ:
98# - parse configuration
99# - read status data
100# - if FAQ is due: call postfaq()
dc88d139
TH
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
0c6ebe78 106 my ($ActName,$File,$PFreq,$Expire) =($$_{'name'},$$_{'file'},$$_{'posting-frequency'},$$_{'expires'});
dc88d139
TH
107 my ($From,$Subject,$NG,$Fup2)=($$_{'from'},$$_{'subject'},$$_{'ngs'},$$_{'fup2'});
108 my ($MIDF,$ReplyTo,$ExtHea)=($$_{'mid-format'},$$_{'reply-to'},$$_{'extraheader'});
109 my ($Supersede) =($$_{'supersede'});
4251e545 110
b9550622 111 # -f: loop if not FAQ to post
4251e545
TH
112 next if (defined($Faq) && $ActName ne $Faq);
113
b9550622 114 # read status data
dc88d139
TH
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 {
74407146 125 warn "$0: W: Couldn't open $File.cfg: $!\n";
dc88d139
TH
126 }
127
128 $SupersedeMID = "" unless $Supersede;
129
0c6ebe78
TH
130 ($NPY,$NPM,$NPD) = calcdelta ($LPY,$LPM,$LPD,$PFreq);
131
b9550622 132 # if FAQ is due: get it out
4251e545
TH
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 {
2507947f 137 postfaq(\$ActName,\$File,\$From,\$Subject,\$NG,\$Fup2,\$MIDF,\$ExtHea,\$Config{'Sender'},\$TDY,\$TDM,\$TDD,\$ReplyTo,\$SupersedeMID,\$Expire);
4251e545
TH
138 }
139 } elsif($Options{'v'}) {
140 print "$ActName: Nothing to do.\n";
dc88d139
TH
141 }
142}
143
144exit;
145
d60c2d5f
TH
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
dc88d139 166################################## readconfig ##################################
4251e545
TH
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
dc88d139
TH
169
170sub readconfig{
4251e545 171 my ($File, $Config, $Faq) = @_;
dc88d139
TH
172 my ($LastEntry, $Error, $i) = ('','',0);
173
b802358a 174 print "Reading configuration from $$File.\n" if($Options{'v'});
4251e545 175
74407146 176 open FH, "<$$File" or die "$0: E: Can't open $$File: $!";
dc88d139 177 while (<FH>) {
4251e545 178 next if (defined($$Faq) && !/^\s*=====\s*$/ && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
dc88d139
TH
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){
4251e545 192 next if (defined($$Faq) && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
dbca4ad8
TH
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"
dc88d139 195 }
dbca4ad8
TH
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"
dc88d139
TH
207 }
208 unless(!$$Config[$i]{'fup2'} || $$Config[$i]{'fup2'} =~ /^\S+$/) {
dbca4ad8 209 $Error .= "E: The Followup-To header for your project \"$$Config[$i]{'name'}\" contains whitespaces.\n"
dc88d139 210 }
dbca4ad8 211 unless(defined($$Config[$i]{'posting-frequency'}) && $$Config[$i]{'posting-frequency'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
74407146 212 $Error .= "E: The Posting-frequency for your project \"$$Config[$i]{'name'}\" is invalid.\n"
dc88d139 213 }
5ddba442 214 unless(!$$Config[$i]{'expires'} || $$Config[$i]{'expires'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
ac69c3ee
TH
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
0c6ebe78 217 }
8f067a2f 218 unless(!$$Config[$i]{'mid-format'} || $$Config[$i]{'mid-format'} =~ /^<\S+\@(\S+\.)?\S{2,}\.\S{2,}>/) {
ac69c3ee
TH
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
40847f71 221 }
dc88d139 222 }
dbca4ad8 223 $Error .= "-" x 25 . 'program terminated' . "-" x 25 . "\n" if $Error;
dc88d139
TH
224 die $Error if $Error;
225}
226
0c6ebe78
TH
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}
5a6670c7
TH
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}
0c6ebe78 257
dc88d139
TH
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 {
0c6ebe78 264 my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_;
dc88d139
TH
265 my (@Header,@Body,$MID,$InRealBody,$LastModified);
266
366322b2 267 print "$$ActName: Preparing to post.\n" if($Options{'v'});
4251e545 268
dc88d139
TH
269 #Prepare MID:
270 $$TDM = ($$TDM < 10 && $$TDM !~ /^0/) ? "0" . $$TDM : $$TDM;
271 $$TDD = ($$TDD < 10 && $$TDD !~ /^0/) ? "0" . $$TDD : $$TDD;
13ce8c26 272 my $Timestamp = time;
dc88d139
TH
273
274 $MID = $$MIDF;
ac69c3ee 275 $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID); # set to default if unset
dc88d139
TH
276 $MID =~ s/\%n/$$ActName/g;
277 $MID =~ s/\%d/$$TDD/g;
278 $MID =~ s/\%m/$$TDM/g;
279 $MID =~ s/\%y/$$TDY/g;
13ce8c26 280 $MID =~ s/\%t/$Timestamp/g;
dc88d139 281
dc88d139
TH
282 #Now get the body:
283 open (FH, "<$$File");
284 while (<FH>){
285 s/\r//;
286 push (@Body, $_), next if $InRealBody;
287 $InRealBody++ if /^$/;
8e1cb154 288 $LastModified = $1 if /^Last-modified: (\S+)$/i;
dc88d139
TH
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";
7823ece9
TH
305
306 $$Expire = '3m' if !$$Expire; # set default if unset: 3 month
307
0c6ebe78 308 my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire);
dc88d139
TH
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";
0c6ebe78 313
dc88d139
TH
314 #Replace %LM by the content of the news.answer-pseudo-header Last-modified:
315 if ($LastModified) {
316 $$Subject =~ s/\%LM/$LastModified/;
317 }
318
4251e545
TH
319 # Test mode?
320 if($Options{'t'} and $Options{'t'} !~ /console/i) {
321 $$NG = $Options{'t'};
322 }
323
dc88d139
TH
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
b9550622 343 # sign article if $UsePGP is true
2507947f 344 my @Article = ($Config{'UsePGP'})?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body);
dc88d139 345
b9550622 346 # post article
366322b2 347 print "$$ActName: Posting article ...\n" if($Options{'v'});
5a6670c7
TH
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 }
dc88d139
TH
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) = @_;
5a6670c7 364 my ($failure) = -1;
dc88d139 365
5a6670c7 366 # test mode - print article to console
4251e545 367 if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) {
55bfbd3c 368 print "-----BEGIN--------------------------------------------------\n";
5a6670c7 369 print @$ArticleR;
55bfbd3c 370 print "------END---------------------------------------------------\n";
5a6670c7
TH
371 # pipe article to script
372 } elsif(defined($Options{'s'})) {
b855559e
TH
373 open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n";
374 print POST @$ArticleR;
375 close POST;
5a6670c7
TH
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();
dc88d139 405 }
5a6670c7 406 return $failure;
dc88d139
TH
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') {
2507947f
TH
419 if ($Config{'PathtoPGPPass'} && !$Config{'PGPPass'}) {
420 open (PGPPW, $Config{'PathtoPGPPass'}) or die "$0: E: Can't open $Config{'PathtoPGPPass'}: $!";
421 Config{'$PGPPass'} = <PGPPW>;
dc88d139
TH
422 close PGPPW;
423 }
424
2507947f
TH
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";
dc88d139 427 } else {
74407146 428 die "$0: E: PGP-Passphrase is unknown!\n";
dc88d139
TH
429 }
430 } elsif ($PGPVersion eq '5') {
2507947f
TH
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'};
dc88d139 433 } else {
74407146 434 die "$0: E: PGP-Passphrase is unknown!\n";
dc88d139
TH
435 }
436 } elsif ($PGPVersion =~ m/GPG/io) {
2507947f
TH
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";
dc88d139 439 } else {
74407146 440 die "$0: E: Passphrase is unknown!\n";
dc88d139
TH
441 }
442 } else {
74407146 443 die "$0: E: Unknown PGP-Version $PGPVersion!";
dc88d139
TH
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
2507947f
TH
481 unlink "$Config{'pgptmpf'}.txt";
482 unlink "$Config{'pgptmpf'}.txt.asc";
dc88d139
TH
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
2507947f 492 open(FH, ">" . $Config{'pgptmpf'} . ".txt") or die "$0: E: can't open $Config{'pgptmpf'}: $!\n";
dc88d139 493 print FH $pgphead, "\n", $pgpbody;
2507947f 494 print FH "\n" if ($Config{'PGPVersion'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
74407146 495 close(FH) or warn "$0: W: Couldn't close TMP: $!\n";
dc88d139
TH
496
497 # Start PGP, then read the signature;
2507947f 498 my $PGPCommand = getpgpcommand($Config{'PGPVersion'});
dc88d139
TH
499 `$PGPCommand`;
500
2507947f
TH
501 open (FH, "<" . $Config{'pgptmpf'} . ".txt.asc") or die "$0: E: can't open ".$Config{'pgptmpf'}.".txt.asc: $!\n";
502 $/ = "$Config{'pgpbegin'}\n";
dc88d139 503 $_ = <FH>;
2507947f
TH
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"
dc88d139 508 }
2507947f 509 unlink($Config{'pgptmpf'} . ".txt") or warn "$0: W: Couldn't unlink $Config{'pgptmpf'}.txt: $!\n";
dc88d139
TH
510
511 $/ = "\n";
512 $_ = <FH>;
513 unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
2507947f
TH
514 unlink $Config{'pgptmpf'} . ".txt";
515 unlink $Config{'pgptmpf'} . ".txt.asc";
74407146 516 die "$0: E: didn't find PGP Version line where expected.\n";
dc88d139
TH
517 }
518
519 if (defined($2)) {
2507947f 520 $$HeaderR{$Config{'pgpheader'}} = $1."-".$2." ".$signheaders;
dc88d139 521 } else {
2507947f 522 $$HeaderR{$Config{'pgpheader'}} = $1." ".$signheaders;
dc88d139
TH
523 }
524
525 do { # skip other pgp headers like
526 $_ = <FH>; # "charset:"||"comment:" until empty line
527 } while ! /^$/;
528
529 while (<FH>) {
530 chomp;
2507947f
TH
531 last if /^\Q$Config{'pgpend'}\E$/;
532 $$HeaderR{$Config{'pgpheader'}} .= "\n\t$_";
dc88d139
TH
533 }
534
2507947f 535 $$HeaderR{$Config{'pgpheader'}} .= "\n" unless ($$HeaderR{$Config{'pgpheader'}} =~ /\n$/s);
dc88d139
TH
536
537 $_ = <FH>;
538 unless (eof(FH)) {
2507947f
TH
539 unlink $Config{'pgptmpf'} . ".txt";
540 unlink $Config{'pgptmpf'} . ".txt.asc";
541 die "$0: E: unexpected data following $Config{'pgpend'}\n";
dc88d139
TH
542 }
543 close(FH);
2507947f 544 unlink "$Config{'pgptmpf'}.txt.asc";
dc88d139 545
2507947f
TH
546 my $tmppgpheader = $Config{'pgpheader'} . ": " . $$HeaderR{$Config{'pgpheader'}};
547 delete $$HeaderR{$Config{'pgpheader'}};
dc88d139
TH
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
2507947f 564 push @pgphead, ("X-PGP-Key: " . $Config{'PGPSigner'} . "\n"), $tmppgpheader;
dc88d139
TH
565 undef $tmppgpheader;
566
567 @pgpbody = split /$/m, $pgpbody;
568 my @pgpmessage = (@pgphead, "\n", @pgpbody);
569 return \@pgpmessage;
570}
272b0243
TH
571
572__END__
573
574################################ Documentation #################################
575
576=head1 NAME
577
578yapfaq - Post Usenet FAQs I<(yet another postfaq)>
579
580=head1 SYNOPSIS
581
9817f98a 582B<yapfaq> [B<-Vhvpd>] [B<-t> I<newsgroups> | CONSOLE] [B<-f> I<project name>] [B<-s> I<program>] [B<-c> I<.rc file>]
272b0243
TH
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
227afd47
TH
618of definitions in the form of I<param = value>. Everything after a "#"
619sign is ignored so you may comment your configuration file.
272b0243
TH
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
ac69c3ee 647=item B<Expires> = I<time period> (optional)
272b0243
TH
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
ac69c3ee 655This setting is optional; the default is 3 months.
272b0243
TH
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
ac69c3ee 681=item B<Fup2> = I<newsgroup | poster> (optional)
272b0243
TH
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
ac69c3ee 688=item B<MID-Format> = I<pattern> (optional)
272b0243
TH
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,
13ce8c26
TH
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.
272b0243 697
ac69c3ee
TH
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.
272b0243 703
ac69c3ee 704=item B<Supersede> = I<yes> (optional)
272b0243
TH
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
ac69c3ee 711=item B<ExtraHeader> = I<additional headers> (optional)
272b0243
TH
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
227afd47 720=head3 Example configuration file
272b0243
TH
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
ac69c3ee 735 # Expires = '3m'
272b0243
TH
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:"
ac69c3ee 750 # Fup2 = 'poster'
272b0243
TH
751
752 # Message-ID ("%n" is $Name)
ac69c3ee 753 # MID-Format = '<%n-%d.%m.%y@domain.invalid>'
272b0243
TH
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
227afd47
TH
776=head3 Status Information
777
272b0243
TH
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
227afd47
TH
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
272b0243
TH
871=head1 OPTIONS
872
873=over 3
874
a052296f
TH
875=item B<-V> (version)
876
877Print out version and copyright information on B<yapfaq> and exit.
878
272b0243
TH
879=item B<-h> (help)
880
ae3b1b79 881Print this man page and exit.
272b0243
TH
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
b855559e
TH
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
227afd47
TH
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
272b0243
TH
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
9817f98a
TH
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
272b0243
TH
964=head1 ENVIRONMENT
965
9817f98a
TH
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
272b0243
TH
975
976=head1 FILES
977
978=over 4
979
980=item F<yapfaq.pl>
981
982The script itself.
983
227afd47
TH
984=item F<.yapfaqrc>
985
986Runtime configuration file for B<yapfaq>.
987
272b0243
TH
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
227afd47 1016Original author (up to version 0.5b, dating from 2003):
272b0243
TH
1017Marc Brockschmidt <marc@marcbrockschmidt.de>
1018
272b0243
TH
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.110553 seconds and 4 git commands to generate.