yapfaq.pl

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