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>]
 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>.
 593
 594 =over 4
 595
 596 =item B<Name> = I<project name>
 597
 598 A name referring to your FAQ, also used for generation of a Message-ID.
 599
 600 This value must be set.
 601
 602 =item B<File> = I<file name>
 603
 604 A file containing the message body of your FAQ and all pseudo headers
 605 (subheaders in the news.answers style).
 606
 607 This value must be set.
 608
 609 =item B<Posting-frequency> = I<time period>
 610
 611 The posting frequency defines how often your FAQ will be posted.
 612 B<yapfaq> will only post your FAQ if this period of time has passed
 613 since the last posting.
 614
 615 You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
 616 or I<B<m>onths> or I<B<y>ears>.
 617
 618 This value must be set.
 619
 620 =item B<Expires> = I<time period>
 621
 622 The period of time after which your message will expire. An Expires
 623 header will be calculated adding this time period to today's date.
 624
 625 You can declare this  time period either in I<B<d>ays> or I<B<w>weeks>
 626 or I<B<m>onths> or I<B<y>ears>.
 627
 628 This setting is optional; the default  is 3 months.
 629
 630 =item B<From> = I<author>
 631
 632 The author of your FAQ as it will appear in the From header of the
 633 message.
 634
 635 This value must be set.
 636
 637 =item B<Subject> = I<subject>
 638
 639 The title of your FAQ as it will appear in the Subject header of the
 640 message.
 641
 642 You may use the special string C<%LM> which will be replaced with
 643 the contents of the Last-Modified subheader in your I<File>.
 644
 645 This value must be set.
 646
 647 =item B<NGs> = I<newsgroups>
 648
 649 A comma-separated list of newsgroup(s) to post your FAQ to as it will
 650 appear in the Newsgroups header of the message.
 651
 652 This value must be set.
 653
 654 =item B<Fup2> = I<newsgroup | poster>
 655
 656 A comma-separated list of newsgroup(s) or the special string I<poster>
 657 as it will appear in the Followup-To header of the message.
 658
 659 This setting is optional.
 660
 661 =item B<MID-Format> = I<pattern>
 662
 663 A pattern from which the message ID is generated as it will appear in
 664 the Message-ID header of the message.
 665
 666 You may use the special strings C<%n> for the I<Name> of your project,
 667 C<%d> for the date the message is posted, C<%m> for the month and
 668 C<%y> for the year, respectively.
 669
 670 This value must be set.
 671
 672 =item B<Supersede> = I<yes>
 673
 674 Add Supersedes header to the message containing the Message-ID header
 675 of the last posting.
 676
 677 This setting is optional; you should set it to yes or leave it out.
 678
 679 =item B<ExtraHeader> = I<additional headers>
 680
 681 The contents of I<ExtraHeader> is added verbatim to the headers of
 682 your message so you can add custom headers like Approved.
 683
 684 This setting is optional.
 685
 686 =back
 687
 688 =head2 Example configuration file
 689
 690     # name of your project
 691     Name = 'testpost'
 692
 693     # file to post (complete body and pseudo-headers)
 694     # ($File.cfg contains data on last posting and last MID)
 695     File = 'test.txt'
 696
 697     # how often your project should be posted
 698     # use (d)ay OR (w)eek OR (m)onth OR (y)ear
 699     Posting-frequency = '1d'
 700
 701     # time period after which the posting should expire
 702     # use (d)ay OR (w)eek OR (m)onth OR (y)ear
 703     Expires = '3m'
 704
 705     # header "From:"
 706     From = 'test@domain.invalid'
 707
 708     # header "Subject:"
 709     # (may contain "%LM" which will be replaced by the contents of the
 710     #  Last-Modified pseudo header).
 711     Subject = 'test noreply ignore'
 712
 713     # comma-separated list of newsgroup(s) to post to
 714     # (header "Newsgroups:")
 715     NGs = 'de.test'
 716
 717     # header "Followup-To:"
 718     Fup2 = 'poster'
 719
 720     # Message-ID ("%n" is $Name)
 721     MID-Format = '<%n-%d.%m.%y@domain.invalid>'
 722
 723     # Supersede last posting?
 724     Supersede = yes
 725
 726     # extra headers (appended verbatim)
 727     # use this for custom headers like "Approved:"
 728     ExtraHeader = 'Approved: moderator@domain.invalid
 729     X-Header: Some text'
 730
 731     # other projects may follow separated with "====="
 732     =====
 733
 734     Name = 'othertest'
 735     File = 'test.txt'
 736     Posting-frequency = '2m'
 737     From = 'My Name <my.name@domain.invalid>'
 738     Subject = 'Test of yapfag <%LM>'
 739     NGs = 'de.test,de.alt.test'
 740     Fup2 = 'de.test'
 741     MID-Format = '<%n-%m.%y@domain.invalid>'
 742     Supersede = yes
 743
 744 Information about the last post and about how to form message IDs for
 745 posts is stored in a file named F<I<project name>.cfg> which will be
 746 generated if it does not exist. Each of those status files will
 747 contain two lines, the first being the date of the last time the FAQ
 748 was posted and the second being the message ID of that incarnation.
 749
 750 =head1 OPTIONS
 751
 752 =over 3
 753
 754 =item B<-V> (version)
 755
 756 Print out version and copyright information on B<yapfaq> and exit.
 757
 758 =item B<-h> (help)
 759
 760 Print this man page and exit.
 761
 762 =item B<-v> (verbose)
 763
 764 Print out status information while running to STDOUT.
 765
 766 =item B<-p> (post unconditionally)
 767
 768 Post (all) FAQs unconditionally ignoring the posting frequency setting.
 769
 770 You may want to use this with the B<-f> option (see below).
 771
 772 =item B<-d> (dry run)
 773
 774 Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
 775 update any status information.
 776
 777 =item B<-t> I<newsgroup(s) | CONSOLE> (test)
 778
 779 Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
 780 newsgroups given after B<-t> as a comma-separated list or print the
 781 FAQs to STDOUT separated by lines of dashes if the special string
 782 C<CONSOLE> is given.  This can be used to preview what B<yapfaq> would
 783 do without embarassing yourself on Usenet.  The status files are not
 784 updated when this option is given.
 785
 786 You may want to use this with the B<-f> option (see below).
 787
 788 =item B<-f> I<project name>
 789
 790 Just deal with one FAQ only.
 791
 792 By default B<yapfaq> will work on all FAQs that are defined in
 793 F<yapfaq.cfg>, check whether they are due for posting and - if they
 794 are - post them. Consequently when the B<-p> option is set all FAQs
 795 will be posted unconditionally. That may not be what you want to
 796 achieve, so you can limit the operation of B<yapfaq> to the named FAQ
 797 only.
 798
 799 =item B<-s> I<program> (pipe to script)
 800
 801 Instead of posting the article(s) to Usenet pipe them to the external
 802 I<program> on STDIN (which may post the article(s) then). A return
 803 value of 0 will be considered success.
 804
 805 =back
 806
 807 =head1 EXAMPLES
 808
 809 Post all FAQs that are due for posting:
 810
 811     yapfaq
 812
 813 Do a dry run, showing which FAQs would be posted:
 814
 815     yapfaq -dv
 816
 817 Do a test run and print on STDOUT what the FAQ I<myfaq> would look
 818 like when posted, regardless whether it is due for posting or not:
 819
 820     yapfaq -pt CONSOLE -f myfaq
 821
 822 Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
 823 if it is due:
 824
 825     yapfaq -t de.test -f myfaq
 826
 827 =head1 ENVIRONMENT
 828
 829 There are no special environment variables used by B<yapfaq>.
 830
 831 =head1 FILES
 832
 833 =over 4
 834
 835 =item F<yapfaq.pl>
 836
 837 The script itself.
 838
 839 =item F<yapfaq.cfg>
 840
 841 Configuration file for B<yapfaq>.
 842
 843 =item F<*.cfg>
 844
 845 Status data on FAQs.
 846
 847 The status files will be created on successful posting if they don't
 848 already exist. The first line of the file will be the date of the last
 849 time the FAQ was posted and the second line will be the message ID of
 850 the last post of that FAQ.
 851
 852 =back
 853
 854 =head1 BUGS
 855
 856 Many, I'm sure.
 857
 858 =head1 SEE ALSO
 859
 860 L<http://th-h.de/download/scripts.php> will have the current
 861 version of this program.
 862
 863 =head1 AUTHOR
 864
 865 Thomas Hochstein <thh@inter.net>
 866
 867 Original author (until version 0.5b from 2003):
 868 Marc Brockschmidt <marc@marcbrockschmidt.de>
 869
 870
 871 =head1 COPYRIGHT AND LICENSE
 872
 873 Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
 874
 875 Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
 876
 877 This program is free software; you may redistribute it and/or modify it
 878 under the same terms as Perl itself.
 879
 880 =cut