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