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: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 readrc (\$RCFile,\%Config) if -f $RCFile;
  82
  83 # read configuration (configured FAQs)
  84 my @Config;
  85 readconfig (\$Config{'ConfigFile'}, \@Config, \$Faq);
  86
  87 # for each FAQ:
  88 # - parse configuration
  89 # - read status data
  90 # - if FAQ is due: call postfaq()
  91 foreach (@Config) {
  92   my ($LPD,$LPM,$LPY) = (01, 01, 0001);  #LP: Last posting-date
  93   my ($NPY,$NPM,$NPD);                   #NP: Next posting-date
  94   my $SupersedeMID;
  95
  96   my ($ActName,$File,$PFreq,$Expire) =($$_{'name'},$$_{'file'},$$_{'posting-frequency'},$$_{'expires'});
  97   my ($From,$Subject,$NG,$Fup2)=($$_{'from'},$$_{'subject'},$$_{'ngs'},$$_{'fup2'});
  98   my ($MIDF,$ReplyTo,$ExtHea)=($$_{'mid-format'},$$_{'reply-to'},$$_{'extraheader'});
  99   my ($Supersede)            =($$_{'supersede'});
 100
 101   # -f: loop if not FAQ to post
 102   next if (defined($Faq) && $ActName ne $Faq);
 103
 104   # read status data
 105   if (open (FH, "<$File.cfg")) {
 106     while(<FH>){
 107       if (/##;; Lastpost:\s*(\d{1,2})\.(\d{1,2})\.(\d{2}(\d{2})?)/){
 108         ($LPD, $LPM, $LPY) = ($1, $2, $3);
 109       } elsif (/^##;;\s*LastMID:\s*(<\S+@\S+>)\s*$/) {
 110         $SupersedeMID = $1;
 111       }
 112     }
 113     close FH;
 114   } else {
 115     warn "$0: W: Couldn't open $File.cfg: $!\n";
 116   }
 117
 118   $SupersedeMID = "" unless $Supersede;
 119
 120   ($NPY,$NPM,$NPD) = calcdelta ($LPY,$LPM,$LPD,$PFreq);
 121
 122   # if FAQ is due: get it out
 123   if (Delta_Days($NPY,$NPM,$NPD,$TDY,$TDM,$TDD) >= 0 or ($Options{'p'})) {
 124     if($Options{'d'}) {
 125           print "$ActName: Would be posted now (but running in simulation mode [$0 -d]).\n" if $Options{'v'};
 126         } else {
 127       postfaq(\$ActName,\$File,\$From,\$Subject,\$NG,\$Fup2,\$MIDF,\$ExtHea,\$Config{'Sender'},\$TDY,\$TDM,\$TDD,\$ReplyTo,\$SupersedeMID,\$Expire);
 128         }
 129   } elsif($Options{'v'}) {
 130     print "$ActName: Nothing to do.\n";
 131   }
 132 }
 133
 134 exit;
 135
 136 #################################### readrc ####################################
 137 # Takes a filename and the reference to an array which contains the valid options
 138
 139 sub readrc{
 140   my ($File, $Config) = @_;
 141
 142   print "Reading $$File.\n" if($Options{'v'});
 143
 144   open FH, "<$$File" or die "$0: Can't open $$File: $!";
 145   while (<FH>) {
 146     if (/^\s*(\S+)\s*=\s*'?(.*?)'?\s*(#.*$|$)/) {
 147       if (grep(/$1/,@ValidConfVars)) {
 148         $$Config{$1} = $2 if $2 ne '';
 149       } else {
 150         warn "$0: W: $1 is not a valid configuration variable (reading from $$File)\n";
 151       }
 152     }
 153   }
 154 }
 155
 156 ################################## readconfig ##################################
 157 # Takes a filename, a reference to an array, which will hold hashes with
 158 # the data from $File, and - optionally - the name of the (single) FAQ to post
 159
 160 sub readconfig{
 161   my ($File, $Config, $Faq) = @_;
 162   my ($LastEntry, $Error, $i) = ('','',0);
 163
 164   print "Reading configuration.\n" if($Options{'v'});
 165
 166   open FH, "<$$File" or die "$0: E: Can't open $$File: $!";
 167   while (<FH>) {
 168     next if (defined($$Faq) && !/^\s*=====\s*$/ && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
 169     if (/^(\s*(\S+)\s*=\s*'?(.*?)'?\s*(#.*$|$)|^(.*?)'?\s*(#.*$|$))/ && not /^\s*$/) {
 170       $LastEntry = lc($2) if $2;
 171       $$Config[$i]{$LastEntry} .= $3 if $3;
 172       $$Config[$i]{$LastEntry} .= "\n$5" if $5 && $5;
 173     }
 174     if (/^\s*=====\s*$/) {
 175       $i++;
 176     }
 177   }
 178   close FH;
 179
 180   #Check saved values:
 181   for $i (0..$i){
 182     next if (defined($$Faq) && defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} ne $$Faq );
 183     unless(defined($$Config[$i]{'name'}) && $$Config[$i]{'name'} =~ /^\S+$/) {
 184       $Error .= "E: The name of your project \"$$Config[$i]{'name'}\" is not defined or contains whitespaces.\n"
 185     }
 186     unless(defined($$Config[$i]{'file'}) && -f $$Config[$i]{'file'}) {
 187       $Error .= "E: The file to post for your project \"$$Config[$i]{'name'}\" is not defined or does not exist.\n"
 188     }
 189     unless(defined($$Config[$i]{'from'}) && $$Config[$i]{'from'} =~ /\S+\@(\S+\.)?\S{2,}\.\S{2,}/) {
 190       $Error .= "E: The From header for your project \"$$Config[$i]{'name'}\" seems to be incorrect.\n"
 191     }
 192     unless(defined($$Config[$i]{'ngs'}) && $$Config[$i]{'ngs'} =~ /^\S+$/) {
 193       $Error .= "E: The Newsgroups header for your project \"$$Config[$i]{'name'}\" is not defined or contains whitespaces.\n"
 194     }
 195     unless(defined($$Config[$i]{'subject'})) {
 196       $Error .= "E: The Subject header for your project \"$$Config[$i]{'name'}\" is not defined.\n"
 197     }
 198     unless(!$$Config[$i]{'fup2'} || $$Config[$i]{'fup2'} =~ /^\S+$/) {
 199       $Error .= "E: The Followup-To header for your project \"$$Config[$i]{'name'}\" contains whitespaces.\n"
 200     }
 201     unless(defined($$Config[$i]{'posting-frequency'}) && $$Config[$i]{'posting-frequency'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
 202       $Error .= "E: The Posting-frequency for your project \"$$Config[$i]{'name'}\" is invalid.\n"
 203     }
 204     unless(!$$Config[$i]{'expires'} || $$Config[$i]{'expires'} =~ /^\s*\d+\s*[dwmy]\s*$/) {
 205           warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" is invalid - set to 3 month.\n";
 206     }
 207     unless(defined($$Config[$i]{'mid-format'}) && $$Config[$i]{'mid-format'} =~ /^<\S+\@\S{2,}\.\S{2,}>$/) {
 208           warn "$0: W: The Expires for your project \"$$Config[$i]{'name'}\" seems to be invalid - set to default.\n";
 209     }
 210   }
 211   $Error .= "-" x 25 . 'program terminated' . "-" x 25 . "\n" if $Error;
 212   die $Error if $Error;
 213 }
 214
 215 ################################# calcdelta #################################
 216 # Takes a date (year,  month and day) and a time period (1d, 1w, 1m, 1y, ...)
 217 # and adds the latter to the former
 218
 219 sub calcdelta {
 220   my ($Year, $Month, $Day, $Period) = @_;
 221   my ($NYear, $NMonth, $NDay);
 222
 223   if ($Period =~ /(\d+)\s*([dw])/) { # Is counted in days or weeks: Use Add_Delta_Days.
 224     ($NYear, $NMonth, $NDay) = Add_Delta_Days($Year, $Month, $Day, (($2 eq "w")?$1 * 7: $1 * 1));
 225   } elsif ($Period =~ /(\d+)\s*([my])/) { #Is counted in months or years: Use Add_Delta_YM
 226     ($NYear, $NMonth, $NDay) = Add_Delta_YM($Year, $Month, $Day, (($2 eq "m")?(0,$1):($1,0)));
 227   }
 228   return ($NYear, $NMonth, $NDay);
 229 }
 230
 231 ################################## postfaq ##################################
 232 # Takes a filename and many other vars.
 233 #
 234 # It reads the data-file $File and then posts the article.
 235
 236 sub postfaq {
 237   my ($ActName,$File,$From,$Subject,$NG,$Fup2,$MIDF,$ExtraHeaders,$Sender,$TDY,$TDM,$TDD,$ReplyTo,$Supersedes,$Expire) = @_;
 238   my (@Header,@Body,$MID,$InRealBody,$LastModified);
 239
 240   print "$$ActName: Preparing to post.\n" if($Options{'v'});
 241
 242   #Prepare MID:
 243   $$TDM = ($$TDM < 10 && $$TDM !~ /^0/) ? "0" . $$TDM : $$TDM;
 244   $$TDD = ($$TDD < 10 && $$TDD !~ /^0/) ? "0" . $$TDD : $$TDD;
 245
 246   $MID = $$MIDF;
 247   $MID = '<%n-%d.%m.%y@'.hostfqdn.'>' if !defined($MID);
 248   $MID =~ s/\%n/$$ActName/g;
 249   $MID =~ s/\%d/$$TDD/g;
 250   $MID =~ s/\%m/$$TDM/g;
 251   $MID =~ s/\%y/$$TDY/g;
 252
 253   #Now get the body:
 254   open (FH, "<$$File");
 255   while (<FH>){
 256     s/\r//;
 257     push (@Body, $_), next if $InRealBody;
 258     $InRealBody++ if /^$/;
 259     $LastModified = $1 if /^Last-modified: (\S+)$/i;
 260     push @Body, $_;
 261   }
 262   close FH;
 263   push @Body, "\n" if ($Body[-1] ne "\n");
 264
 265   #Create Date- and Expires-Header:
 266   my @time = localtime;
 267   my $ss =  ($time[0]<10) ? "0" . $time[0] : $time[0];
 268   my $mm =  ($time[1]<10) ? "0" . $time[1] : $time[1];
 269   my $hh =  ($time[2]<10) ? "0" . $time[2] : $time[2];
 270   my $day = $time[3];
 271   my $month = ($time[4]+1<10) ? "0" . ($time[4]+1) : $time[4]+1;
 272   my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]];
 273   my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]];
 274   my $year = (1900 + $time[5]);
 275   my $tz = $time[8] ? " +0200" : " +0100";
 276
 277   $$Expire = '3m' if !$$Expire; # set default if unset: 3 month
 278
 279   my ($expY,$expM,$expD) = calcdelta ($year,$month,$day,$$Expire);
 280   my $expmonthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$expM-1];
 281
 282   my $date = "$day $monthN $year " . $hh . ":" . $mm . ":" . $ss . $tz;
 283   my $expdate = "$expD $expmonthN $expY $hh:$mm:$ss$tz";
 284
 285   #Replace %LM by the content of the news.answer-pseudo-header Last-modified:
 286   if ($LastModified) {
 287     $$Subject =~ s/\%LM/$LastModified/;
 288   }
 289
 290   # Test mode?
 291   if($Options{'t'} and $Options{'t'} !~ /console/i) {
 292     $$NG = $Options{'t'};
 293   }
 294
 295   #Now create the complete Header:
 296   push @Header, "From: $$From\n";
 297   push @Header, "Newsgroups: $$NG\n";
 298   push @Header, "Followup-To: $$Fup2\n" if $$Fup2;
 299   push @Header, "Subject: $$Subject\n";
 300   push @Header, "Message-ID: $MID\n";
 301   push @Header, "Supersedes: $$Supersedes\n" if $$Supersedes;
 302   push @Header, "Date: $date\n";
 303   push @Header, "Expires: $expdate\n";
 304   push @Header, "Sender: $$Sender\n" if $$Sender;
 305   push @Header, "Mime-Version: 1.0\n";
 306   push @Header, "Reply-To: $$ReplyTo\n" if $$ReplyTo;
 307   push @Header, "Content-Type: text/plain; charset=ISO-8859-15\n";
 308   push @Header, "Content-Transfer-Encoding: 8bit\n";
 309   push @Header, "User-Agent: yapfaq/$Version\n";
 310   if ($$ExtraHeaders) {
 311     push @Header, "$_\n" for (split /\n/, $$ExtraHeaders);
 312   }
 313
 314   # sign article if $UsePGP is true
 315   my @Article = ($Config{'UsePGP'})?@{signpgp(\@Header, \@Body)}:(@Header, "\n", @Body);
 316
 317   # post article
 318   print "$$ActName: Posting article ...\n" if($Options{'v'});
 319   post(\@Article);
 320
 321   # Test mode?
 322   return if($Options{'t'});
 323
 324   # otherwise: update status data
 325   print "$$ActName: Save status information.\n" if($Options{'v'});
 326
 327   open (FH, ">$$File.cfg") or die "$0: E: Can't open $$File.cfg: $!";
 328   print FH "##;; Lastpost: $day.$month.$year\n";
 329   print FH "##;; LastMID: $MID\n";
 330   close FH;
 331 }
 332
 333 ################################## post ##################################
 334 # Takes a complete article (Header and Body).
 335 #
 336 # It opens a connection to $NNTPServer and posts the message.
 337
 338 sub post {
 339   my ($ArticleR) = @_;
 340
 341   # Test mode?
 342   if(defined($Options{'t'}) and $Options{'t'} =~ /console/i) {
 343     print "-----BEGIN--------------------------------------------------\n";
 344         print @$ArticleR;
 345     print "------END---------------------------------------------------\n";
 346         return;
 347   }
 348
 349   # pipe to script?
 350   if(defined($Options{'s'})) {
 351     open (POST, "| $Options{'s'}") or die "$0: E: Cannot fork $Options{'s'}: $!\n";
 352     print POST @$ArticleR;
 353     close POST;
 354     return;
 355   }
 356
 357   my $NewsConnection = Net::NNTP->new($Config{'NNTPServer'}, Reader => 1)    or die "$0: E: Can't connect to news server '$Config{'NNTPServer'}'!\n";
 358   $NewsConnection->authinfo ($Config{'NNTPUser'}, $Config{'NNTPPass'}) if (defined($Config{'NNTPUser'}));
 359   $NewsConnection->post();
 360   $NewsConnection->datasend (@$ArticleR);
 361   $NewsConnection->dataend();
 362
 363   # Posting failed? Save to ERROR.dat
 364   if (!$NewsConnection->ok()) {
 365     open FH, ">>ERROR.dat";
 366     print FH "\nPosting failed! Saving to ERROR.dat. Response from news server:\n";
 367     print FH $NewsConnection->code();
 368     print FH $NewsConnection->message();
 369     print FH "\n";
 370     print FH @$ArticleR;
 371     print FH "-" x 80, "\n";
 372     close FH;
 373   }
 374
 375   $NewsConnection->quit();
 376 }
 377
 378 #-------- sub getpgpcommand
 379 # getpgpcommand generates the command to sign the message and returns it.
 380 #
 381 # Receives:
 382 #       - $PGPVersion: A scalar holding the PGPVersion
 383 sub getpgpcommand {
 384   my ($PGPVersion) = @_;
 385   my $PGPCommand;
 386
 387   if ($PGPVersion eq '2') {
 388     if ($Config{'PathtoPGPPass'} && !$Config{'PGPPass'}) {
 389       open (PGPPW, $Config{'PathtoPGPPass'}) or die "$0: E: Can't open $Config{'PathtoPGPPass'}: $!";
 390       Config{'$PGPPass'} = <PGPPW>;
 391       close PGPPW;
 392     }
 393
 394     if (Config{'$PGPPass'}) {
 395       $PGPCommand = "PGPPASS=\"".$Config{'PGPPass'}."\" ".$Config{'pgp'}." -u \"".$Config{'PGPSigner'}."\" +verbose=0 language='en' -saft <".$Config{'pgptmpf'}.".txt >".$Config{'pgptmpf'}.".txt.asc";
 396     } else {
 397       die "$0: E: PGP-Passphrase is unknown!\n";
 398     }
 399   } elsif ($PGPVersion eq '5') {
 400     if ($Config{'PathtoPGPPass'}) {
 401       $PGPCommand = "PGPPASSFD=2 ".$Config{'pgp'}."s -u \"".$Config{'PGPSigner'}."\" -t --armor -o ".$Config{'pgptmpf'}.".txt.asc -z -f < ".$Config{'pgptmpf'}.".txt 2<".$Config{'PathtoPGPPass'};
 402     } else {
 403       die "$0: E: PGP-Passphrase is unknown!\n";
 404     }
 405   } elsif ($PGPVersion =~ m/GPG/io) {
 406     if (Config{'$PathtoPGPPass'}) {
 407       $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";
 408     } else {
 409       die "$0: E: Passphrase is unknown!\n";
 410     }
 411   } else {
 412     die "$0: E: Unknown PGP-Version $PGPVersion!";
 413   }
 414   return $PGPCommand;
 415 }
 416
 417
 418 #-------- sub signarticle
 419 # signarticle signs an articel and returns a reference to an array
 420 #       containing the whole signed Message.
 421 #
 422 # Receives:
 423 #       - $HeaderAR: A reference to a array containing the articles headers.
 424 #       - $BodyR: A reference to an array containing the body.
 425 #
 426 # Returns:
 427 #       - $MessageRef: A reference to an array containing the whole message.
 428 sub signpgp {
 429   my ($HeaderAR, $BodyR) = @_;
 430   my (@pgphead, @pgpbody, $pgphead, $pgpbody, $header, $signheaders, @signheaders, $currentheader, $HeaderR, $line);
 431
 432   foreach my $line (@$HeaderAR) {
 433     if ($line =~ /^(\S+):\s+(.*)$/s) {
 434       $currentheader = $1;
 435       $$HeaderR{lc($currentheader)} = "$1: $2";
 436     } else {
 437       $$HeaderR{lc($currentheader)} .= $line;
 438     }
 439   }
 440
 441   foreach (@PGPSignHeaders) {
 442     if (defined($$HeaderR{lc($_)}) && $$HeaderR{lc($_)} =~ m/^[^\s:]+: .+/o) {
 443       push @signheaders, $_;
 444     }
 445   }
 446
 447   $pgpbody = join ("", @$BodyR);
 448
 449   # Delete and create the temporary pgp-Files
 450   unlink "$Config{'pgptmpf'}.txt";
 451   unlink "$Config{'pgptmpf'}.txt.asc";
 452   $signheaders = join(",", @signheaders);
 453
 454   $pgphead = "X-Signed-Headers: $signheaders\n";
 455   foreach $header (@signheaders) {
 456     if ($$HeaderR{lc($header)} =~ m/^[^\s:]+: (.+?)\n?$/so) {
 457       $pgphead .= $header.": ".$1."\n";
 458     }
 459   }
 460
 461   open(FH, ">" . $Config{'pgptmpf'} . ".txt") or die "$0: E: can't open $Config{'pgptmpf'}: $!\n";
 462   print FH $pgphead, "\n", $pgpbody;
 463   print FH "\n" if ($Config{'PGPVersion'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
 464   close(FH) or warn "$0: W: Couldn't close TMP: $!\n";
 465
 466   # Start PGP, then read the signature;
 467   my $PGPCommand = getpgpcommand($Config{'PGPVersion'});
 468   `$PGPCommand`;
 469
 470   open (FH, "<" . $Config{'pgptmpf'} . ".txt.asc") or die "$0: E: can't open ".$Config{'pgptmpf'}.".txt.asc: $!\n";
 471   $/ = "$Config{'pgpbegin'}\n";
 472   $_ = <FH>;
 473   unless (m/\Q$Config{'pgpbegin'}\E$/o) {
 474 #    unlink $Config{'pgptmpf'} . ".txt";
 475 #    unlink $Config{'pgptmpf'} . ".txt.asc";
 476     die "$0: E: $Config{'pgpbegin'} not found in ".$Config{'pgptmpf'}.".txt.asc\n"
 477   }
 478   unlink($Config{'pgptmpf'} . ".txt") or warn "$0: W: Couldn't unlink $Config{'pgptmpf'}.txt: $!\n";
 479
 480   $/ = "\n";
 481   $_ = <FH>;
 482   unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
 483     unlink $Config{'pgptmpf'} . ".txt";
 484     unlink $Config{'pgptmpf'} . ".txt.asc";
 485     die "$0: E: didn't find PGP Version line where expected.\n";
 486   }
 487
 488   if (defined($2)) {
 489     $$HeaderR{$Config{'pgpheader'}} = $1."-".$2." ".$signheaders;
 490   } else {
 491     $$HeaderR{$Config{'pgpheader'}} = $1." ".$signheaders;
 492   }
 493
 494   do {          # skip other pgp headers like
 495     $_ = <FH>;  # "charset:"||"comment:" until empty line
 496   } while ! /^$/;
 497
 498   while (<FH>) {
 499     chomp;
 500     last if /^\Q$Config{'pgpend'}\E$/;
 501     $$HeaderR{$Config{'pgpheader'}} .= "\n\t$_";
 502   }
 503
 504   $$HeaderR{$Config{'pgpheader'}} .= "\n" unless ($$HeaderR{$Config{'pgpheader'}} =~ /\n$/s);
 505
 506   $_ = <FH>;
 507   unless (eof(FH)) {
 508     unlink $Config{'pgptmpf'} . ".txt";
 509     unlink $Config{'pgptmpf'} . ".txt.asc";
 510     die "$0: E: unexpected data following $Config{'pgpend'}\n";
 511   }
 512   close(FH);
 513   unlink "$Config{'pgptmpf'}.txt.asc";
 514
 515   my $tmppgpheader = $Config{'pgpheader'} . ": " . $$HeaderR{$Config{'pgpheader'}};
 516   delete $$HeaderR{$Config{'pgpheader'}};
 517
 518   @pgphead = ();
 519   foreach $header (@PGPorderheaders) {
 520     if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
 521       push(@pgphead, "$$HeaderR{$header}");
 522       delete $$HeaderR{$header};
 523     }
 524   }
 525
 526   foreach $header (keys %$HeaderR) {
 527     if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
 528       push(@pgphead, "$$HeaderR{$header}");
 529       delete $$HeaderR{$header};
 530     }
 531   }
 532
 533   push @pgphead, ("X-PGP-Key: " . $Config{'PGPSigner'} . "\n"), $tmppgpheader;
 534   undef $tmppgpheader;
 535
 536   @pgpbody = split /$/m, $pgpbody;
 537   my @pgpmessage = (@pgphead, "\n", @pgpbody);
 538   return \@pgpmessage;
 539 }
 540
 541 __END__
 542
 543 ################################ Documentation #################################
 544
 545 =head1 NAME
 546
 547 yapfaq - Post Usenet FAQs I<(yet another postfaq)>
 548
 549 =head1 SYNOPSIS
 550
 551 B<yapfaq> [B<-hvpd>] [B<-t> I<newsgroups> | CONSOLE] [B<-f> I<project name>] [B<-s> I<program>]
 552
 553 =head1 REQUIREMENTS
 554
 555 =over 2
 556
 557 =item -
 558
 559 Perl 5.8 or later
 560
 561 =item -
 562
 563 Net::NNTP
 564
 565 =item -
 566
 567 Date::Calc
 568
 569 =item -
 570
 571 Getopt::Std
 572
 573 =back
 574
 575 Furthermore you need access to a news server to actually post FAQs.
 576
 577 =head1 DESCRIPTION
 578
 579 B<yapfaq> posts (one or more) FAQs to Usenet with a certain posting
 580 frequency (every n days, weeks, months or years), adding all necessary
 581 headers as defined in its config file (by default F<yapfaq.cfg>).
 582
 583 =head2 Configuration
 584
 585 F<yapfaq.cfg> consists of one or more blocks, separated by C<=====> on
 586 a single line, each containing the configuration for one FAQ as a set
 587 of definitions in the form of I<param = value>.
 588
 589 =over 4
 590
 591 =item B<Name> = I<project name>
 592
 593 A name referring to your FAQ, also used for generation of a Message-ID.
 594
 595 This value must be set.
 596
 597 =item B<File> = I<file name>
 598
 599 A file containing the message body of your FAQ and all pseudo headers
 600 (subheaders in the news.answers style).
 601
 602 This value must be set.
 603
 604 =item B<Posting-frequency> = I<time period>
 605
 606 The posting frequency defines how often your FAQ will be posted.
 607 B<yapfaq> will only post your FAQ if this period of time has passed
 608 since the last posting.
 609
 610 You can declare that time period either in I<B<d>ays> or I<B<w>weeks>
 611 or I<B<m>onths> or I<B<y>ears>.
 612
 613 This value must be set.
 614
 615 =item B<Expires> = I<time period>
 616
 617 The period of time after which your message will expire. An Expires
 618 header will be calculated adding this time period to today's date.
 619
 620 You can declare this  time period either in I<B<d>ays> or I<B<w>weeks>
 621 or I<B<m>onths> or I<B<y>ears>.
 622
 623 This setting is optional; the default  is 3 months.
 624
 625 =item B<From> = I<author>
 626
 627 The author of your FAQ as it will appear in the From header of the
 628 message.
 629
 630 This value must be set.
 631
 632 =item B<Subject> = I<subject>
 633
 634 The title of your FAQ as it will appear in the Subject header of the
 635 message.
 636
 637 You may use the special string C<%LM> which will be replaced with
 638 the contents of the Last-Modified subheader in your I<File>.
 639
 640 This value must be set.
 641
 642 =item B<NGs> = I<newsgroups>
 643
 644 A comma-separated list of newsgroup(s) to post your FAQ to as it will
 645 appear in the Newsgroups header of the message.
 646
 647 This value must be set.
 648
 649 =item B<Fup2> = I<newsgroup | poster>
 650
 651 A comma-separated list of newsgroup(s) or the special string I<poster>
 652 as it will appear in the Followup-To header of the message.
 653
 654 This setting is optional.
 655
 656 =item B<MID-Format> = I<pattern>
 657
 658 A pattern from which the message ID is generated as it will appear in
 659 the Message-ID header of the message.
 660
 661 You may use the special strings C<%n> for the I<Name> of your project,
 662 C<%d> for the date the message is posted, C<%m> for the month and
 663 C<%y> for the year, respectively.
 664
 665 This value must be set.
 666
 667 =item B<Supersede> = I<yes>
 668
 669 Add Supersedes header to the message containing the Message-ID header
 670 of the last posting.
 671
 672 This setting is optional; you should set it to yes or leave it out.
 673
 674 =item B<ExtraHeader> = I<additional headers>
 675
 676 The contents of I<ExtraHeader> is added verbatim to the headers of
 677 your message so you can add custom headers like Approved.
 678
 679 This setting is optional.
 680
 681 =back
 682
 683 =head2 Example configuration file
 684
 685     # name of your project
 686     Name = 'testpost'
 687
 688     # file to post (complete body and pseudo-headers)
 689     # ($File.cfg contains data on last posting and last MID)
 690     File = 'test.txt'
 691
 692     # how often your project should be posted
 693     # use (d)ay OR (w)eek OR (m)onth OR (y)ear
 694     Posting-frequency = '1d'
 695
 696     # time period after which the posting should expire
 697     # use (d)ay OR (w)eek OR (m)onth OR (y)ear
 698     Expires = '3m'
 699
 700     # header "From:"
 701     From = 'test@domain.invalid'
 702
 703     # header "Subject:"
 704     # (may contain "%LM" which will be replaced by the contents of the
 705     #  Last-Modified pseudo header).
 706     Subject = 'test noreply ignore'
 707
 708     # comma-separated list of newsgroup(s) to post to
 709     # (header "Newsgroups:")
 710     NGs = 'de.test'
 711
 712     # header "Followup-To:"
 713     Fup2 = 'poster'
 714
 715     # Message-ID ("%n" is $Name)
 716     MID-Format = '<%n-%d.%m.%y@domain.invalid>'
 717
 718     # Supersede last posting?
 719     Supersede = yes
 720
 721     # extra headers (appended verbatim)
 722     # use this for custom headers like "Approved:"
 723     ExtraHeader = 'Approved: moderator@domain.invalid
 724     X-Header: Some text'
 725
 726     # other projects may follow separated with "====="
 727     =====
 728
 729     Name = 'othertest'
 730     File = 'test.txt'
 731     Posting-frequency = '2m'
 732     From = 'My Name <my.name@domain.invalid>'
 733     Subject = 'Test of yapfag <%LM>'
 734     NGs = 'de.test,de.alt.test'
 735     Fup2 = 'de.test'
 736     MID-Format = '<%n-%m.%y@domain.invalid>'
 737     Supersede = yes
 738
 739 Information about the last post and about how to form message IDs for
 740 posts is stored in a file named F<I<project name>.cfg> which will be
 741 generated if it does not exist. Each of those status files will
 742 contain two lines, the first being the date of the last time the FAQ
 743 was posted and the second being the message ID of that incarnation.
 744
 745 =head1 OPTIONS
 746
 747 =over 3
 748
 749 =item B<-V> (version)
 750
 751 Print out version and copyright information on B<yapfaq> and exit.
 752
 753 =item B<-h> (help)
 754
 755 Print this man page and exit.
 756
 757 =item B<-v> (verbose)
 758
 759 Print out status information while running to STDOUT.
 760
 761 =item B<-p> (post unconditionally)
 762
 763 Post (all) FAQs unconditionally ignoring the posting frequency setting.
 764
 765 You may want to use this with the B<-f> option (see below).
 766
 767 =item B<-d> (dry run)
 768
 769 Start B<yapfaq> in simulation mode, i.e. don't post anything and don't
 770 update any status information.
 771
 772 =item B<-t> I<newsgroup(s) | CONSOLE> (test)
 773
 774 Don't post to the newsgroups defined in F<yqpfaq.cfg>, but to the
 775 newsgroups given after B<-t> as a comma-separated list or print the
 776 FAQs to STDOUT separated by lines of dashes if the special string
 777 C<CONSOLE> is given.  This can be used to preview what B<yapfaq> would
 778 do without embarassing yourself on Usenet.  The status files are not
 779 updated when this option is given.
 780
 781 You may want to use this with the B<-f> option (see below).
 782
 783 =item B<-f> I<project name>
 784
 785 Just deal with one FAQ only.
 786
 787 By default B<yapfaq> will work on all FAQs that are defined in
 788 F<yapfaq.cfg>, check whether they are due for posting and - if they
 789 are - post them. Consequently when the B<-p> option is set all FAQs
 790 will be posted unconditionally. That may not be what you want to
 791 achieve, so you can limit the operation of B<yapfaq> to the named FAQ
 792 only.
 793
 794 =item B<-s> I<program> (pipe to script)
 795
 796 Instead of posting the article(s) to Usenet pipe them to the external
 797 I<program> on STDIN (which may post the article(s) then). A return
 798 value of 0 will be considered success.
 799
 800 =back
 801
 802 =head1 EXAMPLES
 803
 804 Post all FAQs that are due for posting:
 805
 806     yapfaq
 807
 808 Do a dry run, showing which FAQs would be posted:
 809
 810     yapfaq -dv
 811
 812 Do a test run and print on STDOUT what the FAQ I<myfaq> would look
 813 like when posted, regardless whether it is due for posting or not:
 814
 815     yapfaq -pt CONSOLE -f myfaq
 816
 817 Do a "real" test run and post the FAQ I<myfaq> to I<de.test>, but only
 818 if it is due:
 819
 820     yapfaq -t de.test -f myfaq
 821
 822 =head1 ENVIRONMENT
 823
 824 There are no special environment variables used by B<yapfaq>.
 825
 826 =head1 FILES
 827
 828 =over 4
 829
 830 =item F<yapfaq.pl>
 831
 832 The script itself.
 833
 834 =item F<yapfaq.cfg>
 835
 836 Configuration file for B<yapfaq>.
 837
 838 =item F<*.cfg>
 839
 840 Status data on FAQs.
 841
 842 The status files will be created on successful posting if they don't
 843 already exist. The first line of the file will be the date of the last
 844 time the FAQ was posted and the second line will be the message ID of
 845 the last post of that FAQ.
 846
 847 =back
 848
 849 =head1 BUGS
 850
 851 Many, I'm sure.
 852
 853 =head1 SEE ALSO
 854
 855 L<http://th-h.de/download/scripts.php> will have the current
 856 version of this program.
 857
 858 =head1 AUTHOR
 859
 860 Thomas Hochstein <thh@inter.net>
 861
 862 Original author (until version 0.5b from 2003):
 863 Marc Brockschmidt <marc@marcbrockschmidt.de>
 864
 865
 866 =head1 COPYRIGHT AND LICENSE
 867
 868 Copyright (c) 2003 Marc Brockschmidt <marc@marcbrockschmidt.de>
 869
 870 Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
 871
 872 This program is free software; you may redistribute it and/or modify it
 873 under the same terms as Perl itself.
 874
 875 =cut