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