webstump/scripts/gatekeeper.lib

   1 # These functions are useful for Gatekeeper product.
   2
   3 # check if the header line is to be ignored
   4 sub ignore_header {
   5   my $header = pop( @_ );
   6   my @delete_headers = ( "NNTP-Posting-Host", "X-Originating-IP",
   7                          "Received", "Recieved", "Date", "X400",
   8                          "Approved" );
   9   foreach (@delete_headers) {
  10     return "yes" if( $header =~ /^$_:/i );
  11   }
  12
  13   return ""; # no
  14 }
  15
  16
  17 ######################################################################
  18 # this function reads an article from a file and prepares it for posting.
  19 sub prepareArticle {
  20
  21   my $file = pop( @_ );
  22
  23   my @delete_headers = ( "NNTP-Posting-Host", "X-Originating-IP",
  24                          "Received", "Recieved", "Date", "X400",
  25                          "Approved" );
  26
  27   open ARTICLE, $file || return "";
  28
  29   my $headers = "", $body = "";
  30
  31   # headers
  32   my $header = "";
  33   my $newsgroups_present = 0;
  34
  35   # header
  36   while( <ARTICLE> ) {
  37
  38     next if( /^From /);
  39
  40     if( /^$/ || /^\S/ ) { # non-whitespace or empty line
  41       if( $header ) {
  42         # process old header
  43         if( &ignore_header( $header ) ) {
  44           $header = "";
  45           next;
  46         }
  47
  48         if( $header =~ /^Newsgroups: / ) {
  49           $newsgroups_present = 1;
  50           if( ! ($header =~ $newsgroup)) {
  51             chop $header;
  52             $header .= ",$newsgroup\n";
  53           }
  54         }
  55
  56         $headers .= $header;
  57         last if $_ eq "\n";
  58       }
  59
  60       $header = $_;
  61     } else { # whitespace
  62       $header .= $_;
  63     }
  64   }
  65
  66   $headers .= "$newsgroup\n" if( !$newsgroups_present );
  67
  68   $body .= $_ while( <ARTICLE> );
  69
  70 print "Header:\n\n$header\nBody:\n\n$body\n" or die $!;
  71
  72   return $headers . $body;
  73 }
  74
  75 # processApproved file comment
  76 sub processApproved {
  77   my $comment = pop( @_ );
  78   my $file = pop( @_ );
  79
  80   my $article = &prepareArticle( $file );
  81
  82   if( $comment ) {
  83     $article .= "
  84 =================================================================
  85 == Moderator's comment: $comment\n";
  86   }
  87
  88   &email_message( $article, $posting_gateway ) if( $posting_gateway );
  89
  90   if( $posting_spool_dir ) {
  91     my $time = time;
  92     my $spoolfile = "$posting_spool_dir/$$.$time";
  93     open( SPOOL, ">$posting_spool_dir/$$.$time" )
  94       || &error( "Can't open $spoolfile" );
  95     print SPOOL $message or die $!;
  96     close( SPOOL ) or die $!;
  97   }
  98 }
  99
 100
 101 # processDecision file decision+reason comment
 102 sub gk_approval_decision{
 103   my $comment = pop( @_ );
 104   my $decision = pop( @_ );
 105   my $file = pop( @_ );
 106
 107   if( $decision eq "approve" ) {
 108     &processApproved( $file, $comment );
 109   } elsif( $decision eq "reject" ) {
 110     my ($dummy, $reason) = split( $decision );
 111     &processRejected( $file, $reason, $comment );
 112   }
 113 }
 114
 115 1;