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