#!/usr/bin/perl # # Ping-pong robot for HPT. Designed accordingly FTS-5001.002 # (c) 2006 Gremlin # (c) 2006 Grumbler # (c) 2010 Grumbler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Insert into config: # hptperlfile /home/fido/lib/filter.pl # and place to filter.pl some like this: # BEGIN { require "pong.pl"; } # sub filter{ # &pong; # } # my $flagfile='/fido/flag/netmail-in'; # Flag file for indicating new netmail my $myname='Ping-Pong Robot'; my $Id='$Id$'; my $file=$1 if( $Id =~ /Id: ([^ ]+),v / ); my @myaddr=myaddr(); my $myaddr=$myaddr[0]; sub pong() { my $msgtext=""; if ((length($area)==0) && ($toname eq "PING") && ($fromname ne "PING")) { my @Id = split(/ /,$Id); my $report_tearline="$Id[1] $Id[2] $Id[3] $Id[4]"; undef @Id; w_log('C',"Perl($file): Make PONG to PING reqiest: area=".((length($area)==0)? "netmail":$area)."; toname=$toname; toaddr=$toaddr fromname=$fromname; fromaddr=$fromaddr" ); # $text contains original message and must be left as is $msgtext = $text; # invalidate control stuff $msgtext =~ s/\x01/@/g; $msgtext =~ s/\n/\\x0A/g; $msgtext =~ s/\r--- /\r-=- /g; $msgtext =~ s/\r\ \* Origin: /\r + Origin: /g; $msgtext="\rThis is an answer to PING request sent at $date by $fromname:\r\r" . "==== begin of request body ====\r\r" . "$msgtext\r" . "===== end of request body =====\r\r\r" . "--- $report_tearline\r" ." * Origin: $myname at ($myaddr)\r"; my $err= putMsgInArea($area,$myname,$fromname,$myaddr,$fromaddr, "PONG: ".$subject,"","Uns Loc Pvt K/s cpt",$msgtext,1); if( defined($err) ){ w_log('A',"Perl($file): Can't make new message: $err"); } else{ open( FLAG, ">>$flagfile" ) && close(FLAG); } } return ""; } w_log('U',"$file is loaded"); 1;