home *** CD-ROM | disk | FTP | other *** search
/ ftp.science.tver.ru / ftp.science.tver.ru.tar / ftp.science.tver.ru / pub / filter_nnrpd.pl < prev    next >
Perl Script  |  2006-11-06  |  7KB  |  174 lines
  1. #! /usr/bin/perl
  2.  
  3. # 
  4. # ⁿ╘╧╘ ╞╔╠╪╘╥ ╘╥┼┬╒┼╘ ╒╙╘┴╬╧╫╠┼╬╬╧╟╧ ═╧─╒╠╤ CRC32 ─╠╤ Perl.
  5. # ⌡ ╦╧╟╧ FreeBSD ╔▌╔╘┼ ╫ ╨╧╥╘┴╚. Σ╠╤ linux ╬┼ ┌╬┴└, ╔▌╔╘┼.
  6.  
  7. use String::CRC32;
  8.  
  9. # Σ┴╠┼┼ ╦╒╙╧╦ ╔┌ ─╔╙╘╥╔┬╒╘╔╫┴ inn. ∩╙╘┴╫╪╘┼ ╦┴╦ ┼╙╘╪.
  10.  
  11. # $Id: filter_nnrpd.pl,v 1.2 2002/12/12 05:01:42 vinocur Exp $
  12. #
  13. # Sample perl filtering code for nnrpd hook.
  14. #
  15.  
  16. #
  17. # This file is loaded when nnrpd starts up. If it defines a sub named
  18. # `filter_post', then that function will be called during processing of a
  19. # posting. It has access to the headers of the article via the associative
  20. # array `%hdr'. If it returns a null string then the article is accepted
  21. # for posting. A non-null string rejects it, and the value returned is used
  22. # in the rejection message.
  23. #
  24.  
  25. #
  26. # Do any initialization steps.
  27. #
  28. my %config = (checkincludedtext => 0,
  29.               includedcutoff => 40,
  30.               includedratio => 0.6,
  31.               quotere => '^[>:]',
  32.               antiquotere => '^[<]',  # so as not to reject dict(1) output
  33.              );
  34.  
  35.  
  36. #
  37. # Sample filter
  38. #
  39. sub filter_post {
  40.     my $rval = "" ;             # assume we'll accept.
  41.     
  42. # µ╔╠╪╘╥ ─╠╤ ╞╔─╧, ╨╧─╙╘┴╬╧╫╦┴ X_COMMENT-TO, ┌┴═┼╬┴ msgid ╬┴ ╞╔─╧█╬┘╩.
  43. # H┴╨╔╙┴╬ ┬╠┴╟╧─┴╥╤ ß╠┼╦╙┴╬─╥╒ τ╧╘╠╔┬╒, 2:5080/1003;
  44. # ≈╠┴─╒ ≡╠╒╓╬╔╦╧╫╒ 2:5021/19 ╔ ≤┼╥╟┼└ ≥┼╫╘╧╫╒ 2:5021/49. 
  45. # ≤╨┴╙╔┬╧ ╔═ ╧╟╥╧═╬╧┼ ╧╘ ╫╙┼╚ ╨╧╠╪┌╧╫┴╘┼╠┼╩ ╟┼╩╘┴.
  46. # 
  47. # ≥┼┌╒╠╪╘┴╘ ╔╚ ╥┴┬╧╘┘ ╧┬╧┬▌╔╠ Yuri Kosivtsov, 2:5021/29,
  48. # ╥┼┴╠╔┌╧╫┴╬ ╬┴ news://fido.tver.ru ╔ http://fido.tver.ru
  49.     
  50.     my $grephistory = '/usr/local/news/bin/grephistory';
  51.     my $sm = '/usr/local/news/bin/sm';
  52.  
  53. # Σ┴╠┼┼ ╧╨╤╘╪ ╦┴╦┴╤-╘╧ ╞╔╟╬╤ ╔┌ ─╔╙╘╥╔┬╒╘╔╫┴
  54.  
  55. ### Uncomment this next block to reject articles that have 'make money'
  56. ### in their subject, or which have a "Re: " subject, but no References:
  57. ### header, or which have an invalid From.
  58.  
  59. ##    if ($hdr{"Subject"} =~ /make.*money/i) {
  60. ##        $rval = "Spam is not acceptable here..." ;
  61. ##    } elsif ($hdr{'Subject'} =~ /^Re: /o and $hdr{'References'} eq "") {
  62. ##        $rval = "Followup without References:";
  63. ##    } elsif ($hdr{'From'} =~ /^\w*$/o or
  64. ##             $hdr{'From'} !~ /^(.+?)\@([-\w\d]+\.)*([-\w\d]+)\.([-\w\d]{2,})$/o) {
  65. ##        $rval = "From: is invalid, must be user\@[host.]domain.tld";
  66. ##    }
  67.  
  68.  
  69. ### The next block rejects articles with too much quoted text, if the
  70. ### config hash directs it to.
  71.  
  72.     if ($config{checkincludedtext}) {
  73.         my ($lines, $quoted, $antiquoted) = analyze($body);
  74.         if ($lines > $config{includedcutoff}
  75.                 && $quoted - $antiquoted > $lines * $config{includedratio}) {
  76.             $rval = "Article contains too much quoted text";
  77.         }
  78.     }
  79.  
  80. # ╦╒╙╧╦ ≡╠╒╓╬╔╦╧╫┴ ╔ ≥┼╫╘╧╫┴
  81.  
  82. # ≡╧╨┘╘╦┴ ╙╟┼╬┼╥╔╥╧╫┴╘╪ ╞╔─╧█╬┘╩ MSGID.
  83. # ≡╥╧┬╠┼═┴ ╫ ╙╠┼─╒└▌┼═. ≡╥╔ ╟┼╩╘╧╫┴╬╔╔ ╬╪└╙╧╫ ╟┼╬┼╥╔╥╒┼╘╙╤ ═╙╟╔─
  84. # "<┼═┼╩╠> ╬╧═┼╥".  ⁿ╘╧ ╨╠╧╚╧, ╘.╦. ╨╥╔ ─╫╧╩╬╧═ (╘╥╧╩╬╧═ ╔ ╘.╨., ╫┼─╪ ╘╫╧╩
  85. # ╟┼╩╘ ╬┼ ╧─╔╬ ╙ ╫ ╙┼╘╔ :-)) ╟┼╩╘╧╫┴╬╔╔ ═╧╟╒╘ ┬┘╘╪ ╙┬╧╔. δ╥╧═┼ ╘╧╟╧,
  86. # ╬┼╦╧╘╧╥┘┼ ▐╔╘┴╠╦╔ ┬┼╥╒╘ ╔┌ MSGID ┴─╥┼╙ ╒┌╠┴ ╔ █╔┌┼└╘ ╧╘ ╬┼╞╔─╧█╬╧╟╧
  87. # ╫╔─┴ ╔─┼╬╘╔╞╔╦┴╘╧╥┴. ≡╧▄╘╧═╒, ╘┼ ╨╧╠╪┌╧╫┴╘┼╠╔ ╟┼╩╘┴, ╦╧╘╧╥┘┼ ╔═┼└╘
  88. # ╞╔─╧█╬┘┼ ┴─╥┼╙┴ (╨╧╔╬╘┘ ╔ ╬╧─┘, ╨╧ ╦┴╦╔═-╠╔┬╧ ╨╥╔▐╔╬┴═ ╨╧╠╪┌╒└▌╔═╔╙╤
  89. # ╟┼╩╘╧═), ╨╥┼─▀╤╫╠╤└╘ ┼═┼╩╠ ╫╔─┴ Vasya_Pupkin@pX.fY.nZ.z2.fido.tver.ru.
  90. # z2.fido.tver.ru - ▄╘╧ ═╧╩ ─╧═┼╬, ╬┼ ┌┴┬╒─╪╘┼ ┌┴═┼╬╔╘╪ ╬┴ ╙╫╧╩ :-)
  91. # ⌠┴╦╧╩ ┼═┼╩╠ ┌┴═┼╬╤┼╘╙╤ ╬┴ MSGID ╫╔─┴ "2:Z/Y.X ╬╧═┼╥".
  92. # σ╙╠╔ ┴─╥┼╙ ╬┼ ╙╧╧╘╫┼╘╙╘╫╒┼╘ ═┴╙╦┼, ╘╧ ╟┼╬┼╥╔╥╒┼╘╙╤ MSGID
  93. # ╫╔─┴ "2:5021/29.100 ╬╧═┼╥", ╟─┼ 2:5021/29.100 - ┴─╥┼╙, ╬┴ ╦╧╘╧╥╧═
  94. # ╒╙╘┴╬╧╫╠┼╬ ╟┼╩╘
  95.  
  96. # ╦╒╙╧╦ ≥┼╫╘╧╫┴
  97.  
  98.     $ftn_suff = "z2.fido.tver.ru";                                      
  99.                                                                             
  100.     $tmp = $hdr{"Message-ID"};                                          
  101.     $crc = crc32($tmp);                                                 
  102.     $modify_headers = 1;                                                
  103.                                                                                 
  104.     $id = lc ($hdr{"From"});  # Lower case                              
  105.                                                                                     
  106.     if ($id =~ /^.+\@p(\d+)\.f(\d+)\.n(\d+)\.z2\.fido\.tver\.ru/) {    
  107.     $p = $1;                                                          
  108.     $f = $2;                                                          
  109.     $n = $3;                                                          
  110.     $hdr{"Message-ID"} = sprintf("<%u\@p$p.f$f.n$n.$ftn_suff>", $crc);
  111.     $hdr{"X-FTN-MSGID"} = sprintf("2:$n/$f.$p %x",$crc);              
  112.       } elsif ( $id =~ /^.+\@f(\d+)\.n(\d+)\.z2\.fido\.tver\.ru/) {      
  113.         $f = $1;                                                          
  114.         $n = $2;                                                          
  115.     $hdr{"Message-ID"} = sprintf("<%u\@f$f.n$n.$ftn_suff>", $crc);    
  116.     $hdr{"X-FTN-MSGID"} = sprintf("2:$n/$f %x",$crc);                 
  117.       } else {                                                            
  118.         $hdr{"Message-ID"} = sprintf("<%u\@p100.f29.n5021.$ftn_suff>",$crc);   
  119.         $hdr{"X-FTN-MSGID"} = sprintf("2:5021/29.100 %x",$crc);               
  120.     }
  121.  
  122. # δ╒╙╧╦ ß.τ╧╘╠╔┬┴. Σ┼╠┴┼╘ X-COMMENT-To. ∩╙╬╧╫┴╬ ╬┴ ╒╘╔╠╔╘┼
  123. # grephistory ╔┌ inn
  124. # σ╙╠╔ ╫ ╙╧╧┬▌┼╬╔╔ ╒╓┼ ┼╙╘╪ X-COMMENT-To, ╘╧ ╬╔▐┼╟╧ ╬┼ ╨╥╧╔╙╚╧─╔╘.
  125. # σ╙╠╔ X-COMMENT-To ╬┼╘, ╘╧ ╨╥╧╔┌╫╧─╔╘╙╤ ╨╧╔╙╦ ╨╧ history ╔ ╧╘╘╒─┴
  126. # ┬┼╥┼╘╙╤ ╔═╤ ╧╘╨╥┴╫╔╘┼╠╤. σ╙╠╔ ╬╔▐┼╟╧ ╬┼ ╬┴╩─┼╬╧, ╘╧ X-COMMENT-To
  127. # ╬┼ ╫╙╘┴╫╠╤┼╘╙╤.
  128.  
  129.     if ( !(($hdr{"Comment-To"} ne "") ||
  130.            ($hdr{"X-Comment-To"} ne "") ||
  131.            ($hdr{"X-FTN-To"} ne "") ||
  132.            ($hdr{"X-Fidonet-Comment-To"} ne "") ||
  133.            ($hdr{"X-Apparently-To"} ne "")))  {
  134.            my $refs = $hdr{"References"};
  135.        if( $refs ne "" ) {
  136.                 my @refs = split(/ /, $refs);
  137.             my $msgid = pop @refs;
  138.             $msgid =~ s/[<>|;\s'"]//g;
  139.             my $fn=`$grephistory \'$msgid\' 2>&1`;
  140.         if( (!($fn =~ /\/dev\/null/)) && 
  141.             (!($fn =~ /Not found/)) ) {
  142.             my $orig_from = `$sm $fn`;
  143.             my @orig_from = grep(/^From:/, split(/\n/, $orig_from));
  144.             $orig_from = shift @orig_from;
  145.             $orig_from =~ s/^From:\s*//;
  146.             $orig_from =~ s/^\s*(.+[^\s])\s*<[^\s><"\(\)\@]+\@[^\s><"\(\)\@]+>\s*$/$1/;
  147.             $orig_from =~ s/^\s*<{0,1}[^\s><"\(\)\@]+\@[^\s><"\(\)\@]+>{0,1}\s*\((.+)\)\s*$/$1/;
  148.             $orig_from =~ s/^"//;
  149.             $orig_from =~ s/"$//;
  150.             $hdr{"X-Comment-To"} = $orig_from;
  151.             $modify_headers = 1;
  152.             }
  153.         }
  154.         }
  155.     return $rval;
  156. }
  157.  
  158. # Σ┴╠┼┼ ╦╒╙╧╦ ╔┌ ─╔╙╘╥╔┬╒╘╔╫┴ inn
  159.  
  160. sub analyze {
  161.     my ($lines, $quoted, $antiquoted) = (0, 0, 0);
  162.     local $_ = shift;
  163.  
  164.     do {
  165.         if ( /\G$config{quotere}/mgc ) {
  166.             $quoted++;
  167.         } elsif ( /\G$config{antiquotere}/mgc ) {
  168.             $antiquoted++;
  169.         }
  170.     } while ( /\G(.*)\n/gc && ++$lines );
  171.  
  172.     return ($lines, $quoted, $antiquoted);
  173. }
  174.