yapfaq.pl

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