122 lines
4.0 KiB
Perl
122 lines
4.0 KiB
Perl
# $Id$
|
|
# Mirror robot for HPT
|
|
# (c) 2006 Gremlin
|
|
# (c) 2006 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.
|
|
#
|
|
|
|
# Look messages in specified (echo)aread. Check toname for "All" and robot name
|
|
# (now "Mirror robot"), check subject for specified (now "test"), (see
|
|
# "Configuration" below). If matchs then post reply with original message text
|
|
# and invalidated cludges.
|
|
#
|
|
# usage example:
|
|
# ==============
|
|
# BEGIN{ require "testmsg.tpl" }
|
|
# sub filter() { &testmsg; }
|
|
# sub process_pkt{}
|
|
# sub after_unpack{}
|
|
# sub before_pack{}
|
|
# sub pkt_done{}
|
|
# sub scan{}
|
|
# sub route{}
|
|
# sub hpt_exit{}
|
|
# ==============
|
|
|
|
sub testmsg()
|
|
{
|
|
if ($DEBUG_MODE) {
|
|
w_log('1',"filter-testmsg.pl: begin [$area]");
|
|
}
|
|
|
|
# Configuration set in testmsg_config()
|
|
local %testarea; # Area configuration
|
|
local $myaddr; # Robot address
|
|
|
|
testmsg_config;
|
|
|
|
#== CONFIGURATION ==#
|
|
my $check_toname = 'all'; # Act on messages addressed to
|
|
my $check_subject = 'test'; # Lower case!
|
|
my $myname = $FILTER_FROM; # Robot name, uses in reply and check "to" name
|
|
my $report_subj = "$myname Report"; # Subject of report message
|
|
my $report_tearline = "$myname: HPT-perl hook"; # Origin of report message
|
|
my $report_origin = $FILTER_ORIGIN;
|
|
|
|
my $txt2pkt = '/usr/local/bin/txt2pkt'; # txt2pkt program (with path) uses for post
|
|
# into passthrough areas
|
|
my $pkt_dir = '/fido/mailer/in.loc'; # Directory to write PKT for
|
|
# passtrough areas
|
|
my @ignore_from_regexp=( # if these regexp's is matched with $fromname
|
|
'hustler', # then message will be ignored.
|
|
'steve wolf'
|
|
);
|
|
#== END CONFIGURATION ==#
|
|
|
|
if (($testarea{$area})
|
|
&& (lc($toname) eq $check_toname)
|
|
&& (lc($subject) eq $check_subject))
|
|
{
|
|
foreach my $ignore_from (@ignore_from_regexp)
|
|
{
|
|
return "" if( $fromname =~ /$ignore_from/i );
|
|
}
|
|
|
|
# $text contains original message and must be left as is
|
|
my $msgtext = $text;
|
|
|
|
# invalidate control stuff
|
|
$msgtext =~ s/\x01/@/gm;
|
|
$msgtext =~ s/\n/\\x0A/gm;
|
|
$msgtext =~ s/\rSEEN-BY/\rSEEN+BY/gm;
|
|
$msgtext =~ s/\r--- /\r=== /gm;
|
|
$msgtext =~ s/\r \* Origin: /\r + Origin: /gm;
|
|
$msgtext="$date $fromname ($fromaddr) wrote:\r\r"
|
|
."..............| -BEGIN MESSAGE- |..............\r"
|
|
."$msgtext"
|
|
."..............| -END MESSAGE- |..............\r"
|
|
." \r"
|
|
."(The original tear line has been replaced with ===, and the original asterisk used in the Origin line ' * Origin' has been replaced with plus (+).)\r";
|
|
|
|
if ($testarea{$area}==1)
|
|
{
|
|
$msgtext = $msgtext."--- $report_tearline\r * Origin: $report_origin ($myaddr)\r";
|
|
putMsgInArea($area,$myname,$fromname,$myaddr,$myaddr,$report_subj,'',($MSG_LOCAL),add_tz($msgtext),1);
|
|
$newecho = 1;
|
|
w_log('E',"Responding to test in [$area].");
|
|
|
|
} else {
|
|
$msgtext =~ s/\r/\n/gm;
|
|
|
|
my $cmd="$txt2pkt -e $area -xf $myaddr -xt $myaddr -nf '$myname'"
|
|
." -nt '$fromname' -s '$report_subj' -t '$report_tearline'"
|
|
." -o '$report_origin' -d '$pkt_dir' -";
|
|
|
|
if (open(PIPE,"|$cmd"))
|
|
{
|
|
print PIPE $msgtext;
|
|
close PIPE;
|
|
|
|
w_log('7',"PKT with reply is created from $myname using txt2pkt");
|
|
|
|
} else {
|
|
w_log('1',"Can't open pipe to txt2pkt");
|
|
}
|
|
}
|
|
}
|
|
|
|
return '';
|
|
}
|
|
|
|
w_log('U','filter-testmsg is LOADED');
|
|
1;
|