1#!/usr/bin/perl 2# $Id$ 3# Netmail loop detection robot for HPT 4# (c) 2010 Grumbler 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16 17# Look netmail messages and compare all "^aVia" lines with local address 18# for duplicated path 19# If matchs then post (bounce) reply with original message, drop message 20# to badmail and report to sysop. 21# 22# usage example: 23# ============== 24# BEGIN{ require "loop.pl" } 25# sub filter(){ my $r=checkloop(); if( length($r)>0 ){ return $r; } } 26# sub process_pkt{} 27# sub after_unpack{} 28# sub before_pack{} 29# sub pkt_done{} 30# sub scan{} 31# sub route{ if(length(checkloop()>0){ return (myaddr())[0]; } } 32# sub hpt_exit{} 33# ============== 34 35my $report_area="ERRORS"; 36my @Id = split(/ /,'$Id$'); 37my $file = $Id[1]; 38$file =~ s/,v$//; 39my @myaddr=myaddr(); 40my $myaddr=$myaddr[0]; 41undef @myaddr; 42my $myname="Loop detect robot"; # Robot name, uses in reports 43my $report_subj="Loop report"; # Subject of report message 44my $report_tearline="$Id[1] $Id[2]: HPT Perl hook"; # Tearline of report message 45undef @Id; 46 47sub checkloop() 48{ 49 50 w_log( 'u',"checkloop(): start (caller: " . caller() ); 51 52 if( $area eq "" || $area =~ /netmail/i ) 53 { 54 my $duplines=""; 55 my @vialines = grep( /^\x01Via /, split("\r",$text) ); 56# while( $v=pop(@vialines) ) 57# { 58# if( $v =~ m%([0-9]+:[0-9]+/[0-9]+(\.[0-9]+)?(\@[a-zA-z]*)?.*) % ) # Extract FTN address from Via line 59# { 60#w_log('z',"checkloop(): check addr " . $1); 61# my @duplicates = grep( /$1/, @vialines ); 62# if( $#duplicates > -1 ) 63# { 64# $duplines .= $v ."\r" . join( "\r", @duplicates ) ."\r"; 65#w_log('z',"checkloop(): loop lines "); 66# } 67# } 68# } 69 70 for( my $num=$#vialines-1; $num > -1; $num-- ) 71 { 72 if( $vialines[$num] =~ / $myaddr(\@.*)? / ) 73 { 74 if( $vialines[$num+1] !~ /$myaddr(\@.*)? / ) 75 { # loop detected: message already routed via me 76 $duplines += $vialines[$num] . " \r" . $vialines[$num+1]; 77 last; 78 } 79 } 80 elsif( $route and ($vialines[$num] =~ / $route(\@.* |[^\.]|\.[^0-9])/) ) 81 # false-positive may be if $vialines[$num] contain point address of $route node 82 { # loop detected 83 $duplines += $vialines[$num] . "\r" . "and next hop is $route"; 84 last; 85 } 86 } 87 88 if( $duplines ne "" ) 89 { 90 my $msgtext = $text; 91 92 # invalidate control stuff 93 $msgtext =~ s/\x01/@/gm; 94 $msgtext =~ s/\n/\\x0A/gm; 95 $msgtext =~ s/\rSEEN-BY/\rSEEN+BY/gm; 96 $msgtext =~ s/\r---([ \r])/\r-+-\1/gm; 97 $msgtext =~ s/\r \* Origin: /\r + Origin: /gm; 98 $duplines =~ s/\x01/@/g; 99 $msgtext= 100 "\r Loop detected in message from $fromname, $fromaddr to $toname, $toaddr\r" 101 . "Loop Via lines" . ($route? " (default destination is $route)" : "") . ":\r" 102 . $duplines . "\r" 103 . "This message cant' delivered to recipient via my node\r\n" 104 . "Original message with all kludges:\r" 105 . "==== Message header ====\r" 106 . "From: $fromname, $fromaddr Date: $date\r" 107 . "To: $toname, $toaddr\r" 108 . "Subject: $subject\r" 109 . "==== Message text ====\r" 110 . "$msgtext\r" 111 . "==== End of message ====\r" 112 . "\r--- $report_tearline"; 113 114 w_log('7',"Loop detected: Msg from $fromname, $fromaddr to $toname, $toaddr at $date"); 115 putMsgInArea( $report_area, $myname, $fromname, $myaddr, $myaddr, 116 $report_subj, "", "Uns Loc" . ($report_area? "":"pvt"), $msgtext, 1 ); 117 putMsgInArea( "", $myname, $fromname, $myaddr, $fromaddr, 118 $report_subj, "", "Uns Loc pvt cpt", $msgtext, 1 ); 119 return "Loop detected"; 120 } 121 } 122 return ""; 123} 124 125w_log('U',"$file is loaded"); 1261; 127