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.7";
  16
  17 my $RCFile = '.yapfaqrc';
  18 my @ValidConfVars = ('NNTPServer','NNTPUser','NNTPPass','Sender','ConfigFile',
  19                      'UsePGP','pgp','PGPVersion','PGPSigner','PGPPass',
  20                      'PathtoPGPPass','pgpbegin','pgpend','pgptmpf','pgpheader');
  21
  22 ################################### Defaults ##################################
  23 my %Config = (NNTPServer => "localhost",
  24               NNTPUser   => "",
  25               NNTPPass   => "",
  26               Sender     => "",
  27               ConfigFile => "yapfaq.cfg",
  28               UsePGP     => 0,
  29
  30               ################################## PGP-Config #################################
  31               pgp           => '/usr/bin/pgp',                  # path to pgp
  32               PGPVersion    => '2',                             # Use 2 for 2.X, 5 for PGP > 2.X and GPG for GPG
  33               PGPSigner     => '',                              # sign as who?
  34               PGPPass       => '',                              # pgp2 only
  35               PathtoPGPPass => '',                              # pgp2, pgp5 and gpg
  36               pgpbegin      => '-----BEGIN PGP SIGNATURE-----', # Begin of PGP-Signature
  37               pgpend        => '-----END PGP SIGNATURE-----',   # End of PGP-Signature
  38               pgptmpf       => 'pgptmp',                        # temporary file for PGP.
  39               pgpheader     => 'X-PGP-Sig');
  40
  41 my @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
  46 my @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
  55 use strict;
  56 use Net::NNTP;
  57 use Net::Domain qw(hostfqdn);
  58 use Date::Calc qw(Add_Delta_YM Add_Delta_Days Delta_Days Today);
  59 use Fcntl ':flock'; # import LOCK_* constants
  60 use Getopt::Std;
  61 my ($TDY, $TDM, $TDD) = Today(); #TD: Today's date
  62
  63 # read commandline options
  64 my %Options;
  65 getopts('Vhvpdt:f:c:s:', \%Options);
  66 # -V: print version / copyright information
  67 if ($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 }
  72 # -h: feed myself to perldoc
  73 if ($Options{'h'}) {
  74   exec ('perldoc', $0);
  75   exit(0);
  76 };
  77 # -f: set $Faq
  78 my ($Faq) = $Options{'f'} if ($Options{'f'});
  79
  80 # read runtime configuration (configuration variables)
  81 $RCFile = $Options{'c'} if ($Options{'c'});
  82 if (-f $RCFile) {
  83   readrc (\$RCFile,\%Config);
  84 } else {
  85   warn "$0: W: .rc file $RCFile does not exist!\n";
  86 }
  87
  88 # read configuration (configured FAQs)
  89 my @Config;
  90 readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq);
  91
  92 # for each FAQ:
  93 # - parse configuration
  94 # - read status data
  95 # - if FAQ is due: call postfaq()
  96 foreach (@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
 101   my ($ActName,$File,$PFreq,$Expire) =($$_{'name'},$$_{'file'},$$_{'posting-frequency'},$$_{'expires'});
 102   my ($From,$Subject,$NG,$Fup2)=($$_{'from'},$$_{'subject'},$$_{'ngs'},$$_{'fup2'});
 103   my ($MIDF,$ReplyTo,$ExtHea)=($$_{'mid-format'},$$_{'reply-to'},$$_{'extraheader'});
 104   my ($Supersede)            =($$_{'supersede'});
 105
 106   # -f: loop if not FAQ to post
 107   next if (defined($Faq) && $ActName ne $Faq);
 108
 109   # read status data
 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 {
 120     warn "$0: W: Couldn't open $File.cfg: $!\n";
 121   }
 122
 123   $SupersedeMID = "" unless $Supersede;
 124
 125   ($NPY,$NPM,$NPD) = calcdelta ($LPY,$LPM,$LPD,$PFreq);
 126
 127   # if FAQ is due: get it out
 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 {
 132       postfaq(\$ActName,\$File,\$From,\$Subject,\$NG,\$Fup2,\$MIDF,\$ExtHea,\$Config{'Sender'},\$TDY,\$TDM,\$TDD,\$ReplyTo,\$SupersedeMID,\$Expire);
 133         }
 134   } elsif($Options{'v'}) {
 135     print "$ActName: Nothing to do.\n";
 136   }
 137 }
 138
 139 exit;
 140
 141 #################################### readrc ####################################
 142 # Takes a filename and the reference to an array which contains the valid options
 143
 144 sub 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
 161 ################################## readconfig ##################################
 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
 164
 165 sub readconfig{
 166   my ($File, $Config, $Faq) = @_;
 167   my ($LastEntry, $Error, $i) = ('','',0);
 168
 169   print "Reading configuration.\n" if($Options{'v'});
 170
 171   open FH, "<$$File" or die "$0: E: Can't open $$File: $!";
 172   while (<FH>) {
 173     next if (defined($$Faq) && !/^\s*=====\s*$/ && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
 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){
 187     next if (defined($$Faq) && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
 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"
 190     }
 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"
 202     }
 203     unless(!$$Config[$i]{'fup2'} || $$Config[$i]{'fup2'} =~ /^\S+$/) {
 204       $Error .= "E: The Followup-To header for your project \"$$Config[$i]{'name'}\" contains whitespaces.\n"
 205     }
 206     unless(defined($$Config[$i]{'posting-frequency'}) && $$Config[$i]{'posting-frequency'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
 207       $Error .= "E: The Posting-frequency for your project \"$$Config[$i]{'name'}\" is invalid.\n"
 208     }
 209     unless(!$$Config[$i]{'expires'} || $$Config[$i]{'expires'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
 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
 212     }
 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
 216     }
 217   }
 218   $Error .= "-" x 25 . 'program terminated' . "-" x 25 . "\n" if $Error;
 219   die $Error if $Error;
 220 }
 221
 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
 226 sub 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 }
 237
 238 ################################ updatestatus ###############################
 239 # Takes a MID and a status file name
 240 # and writes status information to disk
 241
 242 sub 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 }
 252
 253 ################################## postfaq ##################################
 254 # Takes a filename and many other vars.
 255 #
 256 # It reads the data-file $File and then posts the article.
 257
 258 sub postfaq {
 259   my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_;
 260   my (@Header,@Body,$MID,$InRealBody,$LastModified);
 261
 262   print "$$ActName: Preparing to post.\n" if($Options{'v'});
 263
 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;
 269   $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID); # set to default if unset
 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
 275   #Now get the body:
 276   open (FH, "<$$File");
 277   while (<FH>){
 278     s/\r//;
 279     push (@Body, $_), next if $InRealBody;
 280     $InRealBody++ if /^$/;
 281     $LastModified = $1 if /^Last-modified: (\S+)$/i;
 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";
 298
 299   $$Expire = '3m' if !$$Expire; # set default if unset: 3 month
 300
 301   my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire);
 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";
 306
 307   #Replace %LM by the content of the news.answer-pseudo-header Last-modified:
 308   if ($LastModified) {
 309     $$Subject =~ s/\%LM/$LastModified/;
 310   }
 311
 312   # Test mode?
 313   if($Options{'t'} and $Options{'t'} !~ /console/i) {
 314     $$NG = $Options{'t'};
 315   }
 316
 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
 336   # sign article if $UsePGP is true
 337   my @Article = ($Config{'UsePGP'})?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body);
 338
 339   # post article
 340   print "$$ActName: Posting article ...\n" if($Options{'v'});
 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   }
 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
 355 sub post {
 356   my ($ArticleR) = @_;
 357   my ($failure) = -1;
 358
 359   # test mode - print article to console
 360   if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) {
 361     print "-----BEGIN--------------------------------------------------\n";
 362     print @$ArticleR;
 363     print "------END---------------------------------------------------\n";
 364   # pipe article to script
 365   } elsif(defined($Options{'s'})) {
 366     open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n";
 367     print POST @$ArticleR;
 368     close POST;
 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();
 398   }
 399   return $failure;
 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
 407 sub getpgpcommand {
 408   my ($PGPVersion) = @_;
 409   my $PGPCommand;
 410
 411   if ($PGPVersion eq '2') {
 412     if ($Config{'PathtoPGPPass'} && !$Config{'PGPPass'}) {
 413       open (PGPPW, $Config{'PathtoPGPPass'}) or die "$0: E: Can't open $Config{'PathtoPGPPass'}: $!";
 414       Config{'$PGPPass'} = <PGPPW>;
 415       close PGPPW;
 416     }
 417
 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";
 420     } else {
 421       die "$0: E: PGP-Passphrase is unknown!\n";
 422     }
 423   } elsif ($PGPVersion eq '5') {
 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'};
 426     } else {
 427       die "$0: E: PGP-Passphrase is unknown!\n";
 428     }
 429   } elsif ($PGPVersion =~ m/GPG/io) {
 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";
 432     } else {
 433       die "$0: E: Passphrase is unknown!\n";
 434     }
 435   } else {
 436     die "$0: E: Unknown PGP-Version $PGPVersion!";
 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.
 452 sub 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
 474   unlink "$Config{'pgptmpf'}.txt";
 475   unlink "$Config{'pgptmpf'}.txt.asc";
 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
 485   open(FH, ">" . $Config{'pgptmpf'} . ".txt") or die "$0: E: can't open $Config{'pgptmpf'}: $!\n";
 486   print FH $pgphead, "\n", $pgpbody;
 487   print FH "\n" if ($Config{'PGPVersion'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
 488   close(FH) or warn "$0: W: Couldn't close TMP: $!\n";
 489
 490   # Start PGP, then read the signature;
 491   my $PGPCommand = getpgpcommand($Config{'PGPVersion'});
 492   `$PGPCommand`;
 493
 494   open (FH, "<" . $Config{'pgptmpf'} . ".txt.asc") or die "$0: E: can't open ".$Config{'pgptmpf'}.".txt.asc: $!\n";
 495   $/ = "$Config{'pgpbegin'}\n";
 496   $_ = <FH>;
 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"
 501   }
 502   unlink($Config{'pgptmpf'} . ".txt") or warn "$0: W: Couldn't unlink $Config{'pgptmpf'}.txt: $!\n";
 503
 504   $/ = "\n";
 505   $_ = <FH>;
 506   unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
 507     unlink $Config{'pgptmpf'} . ".txt";
 508     unlink $Config{'pgptmpf'} . ".txt.asc";
 509     die "$0: E: didn't find PGP Version line where expected.\n";
 510   }
 511
 512   if (defined($2)) {
 513     $$HeaderR{$Config{'pgpheader'}} = $1."-".$2." ".$signheaders;
 514   } else {
 515     $$HeaderR{$Config{'pgpheader'}} = $1." ".$signheaders;
 516   }
 517
 518   do {          # skip other pgp headers like
 519     $_ = <FH>;  # "charset:"||"comment:" until empty line
 520   } while ! /^$/;
 521
 522   while (<FH>) {
 523     chomp;
 524     last if /^\Q$Config{'pgpend'}\E$/;
 525     $$HeaderR{$Config{'pgpheader'}} .= "\n\t$_";
 526   }
 527
 528   $$HeaderR{$Config{'pgpheader'}} .= "\n" unless ($$HeaderR{$Config{'pgpheader'}} =~ /\n$/s);
 529
 530   $_ = <FH>;
 531   unless (eof(FH)) {
 532     unlink $Config{'pgptmpf'} . ".txt";
 533     unlink $Config{'pgptmpf'} . ".txt.asc";
 534     die "$0: E: unexpected data following $Config{'pgpend'}\n";
 535   }
 536   close(FH);
 537   unlink "$Config{'pgptmpf'}.txt.asc";
 538
 539   my $tmppgpheader = $Config{'pgpheader'} . ": " . $$HeaderR{$Config{'pgpheader'}};
 540   delete $$HeaderR{$Config{'pgpheader'}};
 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
 557   push @pgphead, ("X-PGP-Key: " . $Config{'PGPSigner'} . "\n"), $tmppgpheader;
 558   undef $tmppgpheader;
 559
 560   @pgpbody = split /$/m, $pgpbody;
 561   my @pgpmessage = (@pgphead, "\n", @pgpbody);
 562   return \@pgpmessage;
 563 }
 564
 565 __END__
 566
 567 ################################ Documentation #################################
 568
 569 =head1 NAME
 570
 571 yapfaq - Post Usenet FAQs I<(yet another postfaq)>
 572
 573 =head1 SYNOPSIS
 574
 575 B<yapfaq> [B<-hvpd>] [B<-t> I<newsgroups> | CONSOLE] [B<-f> I<project name>] [B<-s> I<program>] [B<-c> I<.rc file>]
 576
 577 =head1 REQUIREMENTS
 578
 579 =over 2
 580
 581 =item -
 582
 583 Perl 5.8 or later
 584
 585 =item -
 586
 587 Net::NNTP
 588
 589 =item -
 590
 591 Date::Calc
 592
 593 =item -
 594
 595 Getopt::Std
 596
 597 =back
 598
 599 Furthermore you need access to a news server to actually post FAQs.
 600
 601 =head1 DESCRIPTION
 602
 603 B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
 604 frequency (every n days, weeks, months or years), adding all necessary
 605 headers as defined in its config file (by default F<yapfaq.cfg>).
 606
 607 =head2 Configuration
 608
 609 F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
 610 a single line, each containing the configuration for one FAQ as a set
 611 of definitions in the form of I<param = value>. Everything after a "#"
 612 sign is ignored so you may comment your configuration file.
 613
 614 =over 4
 615
 616 =item B<Name> = I<project name>
 617
 618 A name referring to your FAQ, also used for generation of a Message-ID.
 619
 620 This value must be set.
 621
 622 =item B<File> = I<file name>
 623
 624 A file containing the message body of your FAQ and all pseudo headers
 625 (subheaders in the news.answers style).
 626
 627 This value must be set.
 628
 629 =item B<Posting-frequency> = I<time period>
 630
 631 The posting frequency defines how often your FAQ will be posted.
 632 B<yapfaq> will only post your FAQ if this period of time has passed
 633 since the last posting.
 634
 635 You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
 636 or I<B<m>onths> or I<B<y>ears>.
 637
 638 This value must be set.
 639
 640 =item B<Expires> = I<time period> (optional)
 641
 642 The period of time after which your message will expire. An Expires
 643 header will be calculated adding this time period to today's date.
 644
 645 You can declare this  time period either in I<B<d>ays> or I<B<w>weeks>
 646 or I<B<m>onths> or I<B<y>ears>.
 647
 648 This setting is optional; the default is 3 months.
 649
 650 =item B<From> = I<author>
 651
 652 The author of your FAQ as it will appear in the From header of the
 653 message.
 654
 655 This value must be set.
 656
 657 =item B<Subject> = I<subject>
 658
 659 The title of your FAQ as it will appear in the Subject header of the
 660 message.
 661
 662 You may use the special string C<%LM> which will be replaced with
 663 the contents of the Last-Modified subheader in your I<File>.
 664
 665 This value must be set.
 666
 667 =item B<NGs> = I<newsgroups>
 668
 669 A comma-separated list of newsgroup(s) to post your FAQ to as it will
 670 appear in the Newsgroups header of the message.
 671
 672 This value must be set.
 673
 674 =item B<Fup2> = I<newsgroup | poster>  (optional)
 675
 676 A comma-separated list of newsgroup(s) or the special string I<poster>
 677 as it will appear in the Followup-To header of the message.
 678
 679 This setting is optional.
 680
 681 =item B<MID-Format> = I<pattern>  (optional)
 682
 683 A pattern from which the message ID is generated as it will appear in
 684 the Message-ID header of the message.
 685
 686 You may use the special strings C<%n> for the I<Name> of your project,
 687 C<%d> for the date the message is posted, C<%m> for the month and
 688 C<%y> for the year, respectively.
 689
 690 This setting is optional; the default is '<%n-%d.%m.%y@I<YOURHOST>>'
 691 where I<YOURHOST> is the fully qualified domain name (FQDN) of the
 692 host B<yapfaq> is running on. Obviously that will only work if you
 693 have defined a reasonable hostname that the hostfqdn() function of
 694 Net::Domain can return.
 695
 696 =item B<Supersede> = I<yes>  (optional)
 697
 698 Add Supersedes header to the message containing the Message-ID header
 699 of the last posting.
 700
 701 This setting is optional; you should set it to yes or leave it out.
 702
 703 =item B<ExtraHeader> = I<additional headers>  (optional)
 704
 705 The contents of I<ExtraHeader> is added verbatim to the headers of
 706 your message so you can add custom headers like Approved.
 707
 708 This setting is optional.
 709
 710 =back
 711
 712 =head3 Example configuration file
 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
 727     # Expires = '3m'
 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:"
 742     # Fup2 = 'poster'
 743
 744     # Message-ID ("%n" is $Name)
 745     # MID-Format = '<%n-%d.%m.%y@domain.invalid>'
 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
 768 =head3 Status Information
 769
 770 Information about the last post and about how to form message IDs for
 771 posts is stored in a file named F<I<project name>.cfg> which will be
 772 generated if it does not exist. Each of those status files will
 773 contain two lines, the first being the date of the last time the FAQ
 774 was posted and the second being the message ID of that incarnation.
 775
 776 =head2 Runtime Configuration
 777
 778 Apart from configuring which FAQ(s) to post you may (re)set some
 779 runtime configuration variables via the .rcfile (by default
 780 F<.yapfaqrc>). F<.yapfaqrc> must contain one definition in the form of
 781 I<param = value> on each line; everything after a "#" sign is ignored.
 782
 783 If you omit some settings they will be set to default values hardcoded
 784 in F<yapfaq.pl>.
 785
 786 B<Please note that all parameter names are case-sensitive!>
 787
 788 =over 4
 789
 790 =item B<NNTPServer> = I<NNTP server> (mandatory)
 791
 792 Host name of the NNTP server to post to. Must be set (or omitted; the
 793 default is "localhost"); if set to en empty string, B<yapfaq> falls
 794 back to Perl's build-in defaults (contents of environment variables
 795 NNTPSERVER and NEWSHOST; if not set, default from Net::Config; if not
 796 set, "news" is used).
 797
 798 =item B<NNTPUser> = I<user name> (optional)
 799
 800 User name used for authentication with the NNTP server (I<AUTHINFO
 801 USER>).
 802
 803 This setting is optional; if it is not set, I<NNTPPass> is ignored and
 804 no authentication is tried.
 805
 806 =item B<NNTPPass> = I<password> (optional)
 807
 808 Password used for authentication with the NNTP server (I<AUTHINFO
 809 PASS>).
 810
 811 This setting is optional; it must be set if I<NNTPUser> is present.
 812
 813 =item B<Sender> = I<Sender header> (optional)
 814
 815 The Sender header that will be added to every posted message.
 816
 817 This setting is optional.
 818
 819 =item B<ConfigFile> = I<configuration file> (mandatory)
 820
 821 The configuration file defining the FAQ(s) to post. Must be set (or
 822 omitted; the default is "yapfaq.cfg").
 823
 824 =item B<UsePGP> = I<whether to add a digital signature> (optional)
 825
 826 Boolean value (0 or 1) controlling whether the FAQs will get digitally
 827 signed via an X-PGP-Sig header.
 828
 829 This setting is optional; the default is 0.
 830
 831 If you have set I<UsePGP> to 1, you must also supply the necessary
 832 information on your PGP oder GPG installation; please refer to the
 833 sample F<.yapfaqrc> file (see below) for more information on this
 834 topic.
 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
 860 You may use more than one runtime configuration file with the B<-c>
 861 option (see below).
 862
 863 =head1 OPTIONS
 864
 865 =over 3
 866
 867 =item B<-V> (version)
 868
 869 Print out version and copyright information on B<yapfaq> and exit.
 870
 871 =item B<-h> (help)
 872
 873 Print this man page and exit.
 874
 875 =item B<-v> (verbose)
 876
 877 Print out status information while running to STDOUT.
 878
 879 =item B<-p> (post unconditionally)
 880
 881 Post (all) FAQs unconditionally ignoring the posting frequency setting.
 882
 883 You may want to use this with the B<-f> option (see below).
 884
 885 =item B<-d> (dry run)
 886
 887 Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
 888 update any status information.
 889
 890 =item B<-t> I<newsgroup(s) | CONSOLE> (test)
 891
 892 Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
 893 newsgroups given after B<-t> as a comma-separated list or print the
 894 FAQs to STDOUT separated by lines of dashes if the special string
 895 C<CONSOLE> is given.  This can be used to preview what B<yapfaq> would
 896 do without embarassing yourself on Usenet.  The status files are not
 897 updated when this option is given.
 898
 899 You may want to use this with the B<-f> option (see below).
 900
 901 =item B<-f> I<project name>
 902
 903 Just deal with one FAQ only.
 904
 905 By default B<yapfaq> will work on all FAQs that are defined in
 906 F<yapfaq.cfg>, check whether they are due for posting and - if they
 907 are - post them. Consequently when the B<-p> option is set all FAQs
 908 will be posted unconditionally. That may not be what you want to
 909 achieve, so you can limit the operation of B<yapfaq> to the named FAQ
 910 only.
 911
 912 =item B<-s> I<program> (pipe to script)
 913
 914 Instead of posting the article(s) to Usenet pipe them to the external
 915 I<program> on STDIN (which may post the article(s) then). A return
 916 value of 0 will be considered success.
 917
 918 =item B<-c> I<.rc file>
 919
 920 Load another runtime configuration file (.rc file) than F<.yaofaq.rc>.
 921
 922 You may for example define another usenet server to post your FAQ(s)
 923 to or load another configuration file defining (an)other FAQ(s).
 924
 925 =back
 926
 927 =head1 EXAMPLES
 928
 929 Post all FAQs that are due for posting:
 930
 931     yapfaq
 932
 933 Do a dry run, showing which FAQs would be posted:
 934
 935     yapfaq -dv
 936
 937 Do a test run and print on STDOUT what the FAQ I<myfaq> would look
 938 like when posted, regardless whether it is due for posting or not:
 939
 940     yapfaq -pt CONSOLE -f myfaq
 941
 942 Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
 943 if it is due:
 944
 945     yapfaq -t de.test -f myfaq
 946
 947 =head1 ENVIRONMENT
 948
 949 There are no special environment variables used by B<yapfaq>.
 950
 951 =head1 FILES
 952
 953 =over 4
 954
 955 =item F<yapfaq.pl>
 956
 957 The script itself.
 958
 959 =item F<.yapfaqrc>
 960
 961 Runtime configuration file for B<yapfaq>.
 962
 963 =item F<yapfaq.cfg>
 964
 965 Configuration file for B<yapfaq>.
 966
 967 =item F<*.cfg>
 968
 969 Status data on FAQs.
 970
 971 The status files will be created on successful posting if they don't
 972 already exist. The first line of the file will be the date of the last
 973 time the FAQ was posted and the second line will be the message ID of
 974 the last post of that FAQ.
 975
 976 =back
 977
 978 =head1 BUGS
 979
 980 Many, I'm sure.
 981
 982 =head1 SEE ALSO
 983
 984 L<http://th-h.de/download/scripts.php> will have the current
 985 version of this program.
 986
 987 =head1 AUTHOR
 988
 989 Thomas Hochstein <thh@inter.net>
 990
 991 Original author (up to version 0.5b, dating from 2003):
 992 Marc Brockschmidt <marc@marcbrockschmidt.de>
 993
 994 =head1 COPYRIGHT AND LICENSE
 995
 996 Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
 997
 998 Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
 999
1000 This program is free software; you may redistribute it and/or modify it
1001 under the same terms as Perl itself.
1002
1003 =cut