1#!/usr/bin/perl 2# 3# Ping-pong robot for HPT. Designed accordingly FTS-5001.002 4# (c) 2006 Gremlin 5# (c) 2006 Grumbler 6# (c) 2010 Grumbler 7# 8# This program is free software; you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation; either version 2 of the License, or 11# (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# Insert into config: 19# hptperlfile /home/fido/lib/filter.pl 20# and place to filter.pl some like this: 21# BEGIN { require "pong.pl"; } 22# sub filter{ 23# &pong; 24# } 25# 26 27my $flagfile='/fido/flag/netmail-in'; # Flag file for indicating new netmail 28my $myname='Ping-Pong Robot'; 29my $Id='$Id$'; 30my $file=$1 if( $Id =~ /Id: ([^ ]+),v / ); 31my @myaddr=myaddr(); 32my $myaddr=$myaddr[0]; 33 34sub pong() 35{ 36 my $msgtext=""; 37 if ((length($area)==0) && ($toname eq "PING") && ($fromname ne "PING")) 38 { 39 my @Id = split(/ /,$Id); 40 my $report_tearline="$Id[1] $Id[2] $Id[3] $Id[4]"; 41 undef @Id; 42 43 w_log('C',"Perl($file): Make PONG to PING reqiest: area=".((length($area)==0)? "netmail":$area)."; toname=$toname; toaddr=$toaddr fromname=$fromname; fromaddr=$fromaddr" ); 44 45# $text contains original message and must be left as is 46 $msgtext = $text; 47# invalidate control stuff 48 $msgtext =~ s/\x01/@/g; 49 $msgtext =~ s/\n/\\x0A/g; 50 $msgtext =~ s/\r--- /\r-=- /g; 51 $msgtext =~ s/\r\ \* Origin: /\r + Origin: /g; 52 53 $msgtext="\rThis is an answer to PING request sent at $date by $fromname:\r\r" 54 . "==== begin of request body ====\r\r" 55 . "$msgtext\r" 56 . "===== end of request body =====\r\r\r" 57 . "--- $report_tearline\r" 58 ." * Origin: $myname at ($myaddr)\r"; 59 my $err= putMsgInArea($area,$myname,$fromname,$myaddr,$fromaddr, 60 "PONG: ".$subject,"","Uns Loc Pvt K/s cpt",$msgtext,1); 61 if( defined($err) ){ w_log('A',"Perl($file): Can't make new message: $err"); } 62 else{ open( FLAG, ">>$flagfile" ) && close(FLAG); } 63 } 64 return ""; 65} 66 67w_log('U',"$file is loaded"); 681; 69