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