yapfaq.pl

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