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