2010-03-22 08:33:44 +01:00
# File: FactoidModuleLauncher.pm
2010-03-24 07:47:40 +01:00
# Author: pragma_
2010-03-22 08:33:44 +01:00
#
# Purpose: Handles forking and execution of module processes
package PBot::FactoidModuleLauncher ;
use warnings ;
use strict ;
2010-03-24 07:47:40 +01:00
use vars qw( $VERSION ) ;
$ VERSION = $ PBot:: PBot:: VERSION ;
2010-03-22 08:33:44 +01:00
use POSIX qw( WNOHANG ) ; # for children process reaping
use Carp ( ) ;
2010-05-14 00:12:04 +02:00
use Text::Balanced qw( extract_delimited ) ;
2010-03-22 08:33:44 +01:00
# automatically reap children processes in background
$ SIG { CHLD } = sub { while ( waitpid ( - 1 , WNOHANG ) > 0 ) { } } ;
sub new {
if ( ref ( $ _ [ 1 ] ) eq 'HASH' ) {
Carp:: croak ( "Options to Commands should be key/value pairs, not hash reference" ) ;
}
my ( $ class , % conf ) = @ _ ;
my $ self = bless { } , $ class ;
$ self - > initialize ( % conf ) ;
return $ self ;
}
sub initialize {
my ( $ self , % conf ) = @ _ ;
my $ pbot = delete $ conf { pbot } ;
if ( not defined $ pbot ) {
Carp:: croak ( "Missing pbot reference to PBot::FactoidModuleLauncher" ) ;
}
$ self - > { pbot } = $ pbot ;
}
sub execute_module {
2014-03-14 11:05:11 +01:00
my ( $ self , $ from , $ tonick , $ nick , $ user , $ host , $ command , $ keyword , $ arguments , $ preserve_whitespace ) = @ _ ;
2010-03-22 08:33:44 +01:00
my $ text ;
$ arguments = "" if not defined $ arguments ;
2010-06-20 08:16:48 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ from , $ keyword ) ;
if ( not defined $ trigger ) {
2014-03-14 11:05:11 +01:00
$ self - > { pbot } - > { interpreter } - > handle_result ( $ from , $ nick , $ user , $ host , $ command , "$keyword $arguments" , "/msg $nick Failed to find module for '$keyword' in channel $from\n" , 1 , 0 ) ;
return ;
2010-06-20 08:16:48 +02:00
}
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
my $ module = $ self - > { pbot } - > factoids - > factoids - > hash - > { $ channel } - > { $ trigger } - > { action } ;
my $ module_dir = $ self - > { pbot } - > module_dir ;
2010-05-14 01:28:38 +02:00
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > logger - > log ( "(" . ( defined $ from ? $ from : "(undef)" ) . "): $nick!$user\@$host: Executing module $module $arguments\n" ) ;
2010-05-04 07:59:14 +02:00
$ arguments =~ s/\$nick/$nick/g ;
2014-03-04 22:40:13 +01:00
$ arguments =~ s/\$channel/$from/g ;
2010-05-04 07:59:14 +02:00
2010-05-14 01:28:38 +02:00
$ arguments = quotemeta ( $ arguments ) ;
2014-02-24 01:58:00 +01:00
$ arguments =~ s/\\\s/ /g ;
2010-05-14 01:28:38 +02:00
2010-06-20 08:16:48 +02:00
if ( exists $ self - > { pbot } - > factoids - > factoids - > hash - > { $ channel } - > { $ trigger } - > { modulelauncher_subpattern } ) {
if ( $ self - > { pbot } - > factoids - > factoids - > hash - > { $ channel } - > { $ trigger } - > { modulelauncher_subpattern } =~ m/s\/(.*?)\/(.*)\// ) {
2010-05-14 00:12:04 +02:00
my ( $ p1 , $ p2 ) = ( $ 1 , $ 2 ) ;
$ arguments =~ s/$p1/$p2/ ;
2010-06-20 08:16:48 +02:00
my ( $ a , $ b , $ c , $ d , $ e , $ f , $ g , $ h , $ i , $ before , $ after ) = ( $ 1 , $ 2 , $ 3 , $ 4 , $ 5 , $ 6 , $ 7 , $ 8 , $ 9 , $` , $' ) ;
2010-05-14 00:12:04 +02:00
$ arguments =~ s/\$1/$a/g ;
$ arguments =~ s/\$2/$b/g ;
$ arguments =~ s/\$3/$c/g ;
$ arguments =~ s/\$4/$d/g ;
$ arguments =~ s/\$5/$e/g ;
$ arguments =~ s/\$6/$f/g ;
$ arguments =~ s/\$7/$g/g ;
$ arguments =~ s/\$8/$h/g ;
$ arguments =~ s/\$9/$i/g ;
$ arguments =~ s/\$`/$before/g ;
$ arguments =~ s/\$'/$after/g ;
2014-02-24 01:58:00 +01:00
$ self - > { pbot } - > logger - > log ( "arguments subpattern: $arguments\n" ) ;
2010-05-14 00:12:04 +02:00
} else {
2010-06-20 08:16:48 +02:00
$ self - > { pbot } - > logger - > log ( "Invalid module substitution pattern [" . $ self - > { pbot } - > factoids - > factoids - > hash - > { $ channel } - > { $ trigger } - > { modulelauncher_subpattern } . "], ignoring.\n" ) ;
2010-05-14 00:12:04 +02:00
}
}
2010-05-14 01:28:38 +02:00
my $ argsbuf = $ arguments ;
2010-05-14 00:12:04 +02:00
$ arguments = "" ;
2010-05-14 01:28:38 +02:00
my $ lr ;
while ( 1 ) {
my ( $ e , $ r , $ p ) = extract_delimited ( $ argsbuf , "'" , "[^']+" ) ;
2010-05-14 00:12:04 +02:00
2010-05-14 02:08:52 +02:00
$ lr = $ r if not defined $ lr ;
2010-05-14 01:28:38 +02:00
if ( defined $ e ) {
2010-05-25 07:47:13 +02:00
$ e =~ s/\\([^\w])/$1/g ;
2010-05-14 01:28:38 +02:00
$ e =~ s/'/'\\''/g ;
$ e =~ s/^'\\''/'/ ;
$ e =~ s/'\\''$/'/ ;
$ arguments . = $ p ;
2010-05-14 00:12:04 +02:00
$ arguments . = $ e ;
2010-05-14 01:28:38 +02:00
$ lr = $ r ;
} else {
$ arguments . = $ lr ;
last ;
2010-05-14 00:12:04 +02:00
}
}
2014-03-14 11:05:11 +01:00
pipe ( my $ reader , my $ writer ) ;
2010-03-22 08:33:44 +01:00
my $ pid = fork ;
2014-03-14 11:05:11 +01:00
2010-03-22 08:33:44 +01:00
if ( not defined $ pid ) {
$ self - > { pbot } - > logger - > log ( "Could not fork module: $!\n" ) ;
2014-03-14 11:05:11 +01:00
close $ reader ;
close $ writer ;
$ self - > { pbot } - > { interpreter } - > handle_result ( $ from , $ nick , $ user , $ host , $ command , "$keyword $arguments" , "/me groans loudly.\n" , 1 , 0 ) ;
return ;
2010-03-22 08:33:44 +01:00
}
2014-03-14 11:05:11 +01:00
# FIXME -- add check to ensure $module exists
2010-03-22 08:33:44 +01:00
if ( $ pid == 0 ) { # start child block
2014-03-14 11:05:11 +01:00
close $ reader ;
2010-03-22 08:33:44 +01:00
2011-01-22 09:35:31 +01:00
# don't quit the IRC client when the child dies
2010-05-27 11:19:11 +02:00
no warnings ;
2011-01-22 09:35:31 +01:00
* PBot::IRC::Connection:: DESTROY = sub { return ; } ;
2010-05-27 11:19:11 +02:00
use warnings ;
2010-05-27 11:29:17 +02:00
if ( not chdir $ module_dir ) {
$ self - > { pbot } - > logger - > log ( "Could not chdir to '$module_dir': $!\n" ) ;
Carp:: croak ( "Could not chdir to '$module_dir': $!" ) ;
}
2014-02-24 01:58:00 +01:00
# $self->{pbot}->logger->log("module arguments: [$arguments]\n");
$ text = `$module_dir/$module $arguments` ;
2012-07-22 21:22:30 +02:00
2010-03-22 08:33:44 +01:00
if ( defined $ tonick ) {
$ self - > { pbot } - > logger - > log ( "($from): $nick!$user\@$host) sent to $tonick\n" ) ;
if ( defined $ text && length $ text > 0 ) {
2012-08-24 00:50:07 +02:00
# get rid of original caller's nick
$ text =~ s/^\/([^ ]+) \Q$nick\E:\s+/\/$1 / ;
$ text =~ s/^\Q$nick\E:\s+// ;
2014-03-14 11:05:11 +01:00
print $ writer "$from $tonick: $text\n" ;
$ self - > { pbot } - > { interpreter } - > handle_result ( $ from , $ nick , $ user , $ host , $ command , "$keyword $arguments" , "$tonick: $text" , 0 , $ preserve_whitespace ) ;
2010-03-22 08:33:44 +01:00
}
2014-03-14 11:05:11 +01:00
exit 0 ;
2010-03-22 08:33:44 +01:00
} else {
2014-02-24 01:58:00 +01:00
if ( exists $ self - > { pbot } - > factoids - > factoids - > hash - > { $ channel } - > { $ trigger } - > { add_nick } and $ self - > { pbot } - > factoids - > factoids - > hash - > { $ channel } - > { $ trigger } - > { add_nick } != 0 ) {
2014-03-14 11:05:11 +01:00
print $ writer "$from $nick: $text" ;
$ self - > { pbot } - > { interpreter } - > handle_result ( $ from , $ nick , $ user , $ host , $ command , "$keyword $arguments" , "$nick: $text" , 0 , $ preserve_whitespace ) ;
2014-02-24 01:58:00 +01:00
} else {
2014-03-14 11:05:11 +01:00
print $ writer "$from $text" ;
$ self - > { pbot } - > { interpreter } - > handle_result ( $ from , $ nick , $ user , $ host , $ command , "$keyword $arguments" , $ text , 0 , $ preserve_whitespace ) ;
2014-02-24 01:58:00 +01:00
}
2014-03-14 11:05:11 +01:00
exit 0 ;
2010-03-22 08:33:44 +01:00
}
2014-03-14 11:05:11 +01:00
# er, didn't execute the module?
print $ writer "$from /me moans loudly.\n" ;
$ self - > { pbot } - > { interpreter } - > handle_result ( $ from , $ nick , $ user , $ host , $ command , "$keyword $arguments" , "/me moans loudly." , 0 , 0 ) ;
exit 0 ;
2010-03-22 08:33:44 +01:00
} # end child block
2010-03-23 04:09:03 +01:00
else {
2014-03-14 11:05:11 +01:00
close $ writer ;
$ self - > { pbot } - > { select_handler } - > add_reader ( $ reader , sub { $ self - > module_pipe_reader ( @ _ ) } ) ;
return "" ;
2010-03-23 04:09:03 +01:00
}
2014-03-14 11:05:11 +01:00
}
sub module_pipe_reader {
my ( $ self , $ buf ) = @ _ ;
my ( $ channel , $ text ) = split / / , $ buf , 2 ;
2014-03-15 02:53:33 +01:00
return if not defined $ text or not length $ text ;
$ text = $ self - > { pbot } - > interpreter - > truncate_result ( $ channel , $ self - > { pbot } - > { botnick } , 'undef' , $ text , $ text , 0 ) ;
2014-03-14 11:05:11 +01:00
$ self - > { pbot } - > antiflood - > check_flood ( $ channel , $ self - > { pbot } - > { botnick } , $ self - > { pbot } - > { username } , 'localhost' , $ text , 0 , 0 , 0 ) ;
2010-03-22 08:33:44 +01:00
}
1 ;