2010-03-17 07:36:54 +01:00
# File: Interpreter.pm
2010-03-22 08:33:44 +01:00
# Author: pragma_
2010-03-17 07:36:54 +01:00
#
2010-03-22 08:33:44 +01:00
# Purpose:
2010-03-17 07:36:54 +01:00
2017-03-05 22:33:31 +01:00
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
2010-03-17 07:36:54 +01:00
package PBot::Interpreter ;
use warnings ;
use strict ;
2010-03-22 08:33:44 +01:00
use base 'PBot::Registerable' ;
2015-03-29 01:50:43 +01:00
use Time::HiRes qw/gettimeofday/ ;
2015-03-31 00:04:08 +02:00
use Time::Duration ;
2010-04-13 06:17:54 +02:00
use LWP::UserAgent ;
2010-03-22 08:33:44 +01:00
use Carp ( ) ;
2017-09-05 09:27:28 +02:00
use PBot::Utils::ValidateString ;
2010-03-22 08:33:44 +01:00
sub new {
if ( ref ( $ _ [ 1 ] ) eq 'HASH' ) {
2014-05-19 23:34:24 +02:00
Carp:: croak ( "Options to " . __FILE__ . " should be key/value pairs, not hash reference" ) ;
2010-03-22 08:33:44 +01:00
}
my ( $ class , % conf ) = @ _ ;
my $ self = bless { } , $ class ;
$ self - > initialize ( % conf ) ;
return $ self ;
2010-03-17 07:36:54 +01:00
}
2010-03-22 08:33:44 +01:00
sub initialize {
my ( $ self , % conf ) = @ _ ;
$ self - > SUPER:: initialize ( % conf ) ;
2010-03-17 07:36:54 +01:00
2014-05-19 23:34:24 +02:00
$ self - > { pbot } = delete $ conf { pbot } // Carp:: croak ( "Missing pbot reference to " . __FILE__ ) ;
2010-04-13 06:17:54 +02:00
2014-10-14 04:30:57 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'general' , 'compile_blocks' , $ conf { compile_blocks } // 1 ) ;
$ self - > { pbot } - > { registry } - > add_default ( 'array' , 'general' , 'compile_blocks_channels' , $ conf { compile_blocks_channels } // '.*' ) ;
2014-05-19 23:34:24 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'array' , 'general' , 'compile_blocks_ignore_channels' , $ conf { compile_blocks_ignore_channels } // 'none' ) ;
2015-05-16 02:53:13 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'general' , 'paste_ratelimit' , $ conf { paste_ratelimit } // 60 ) ;
2014-05-31 03:05:47 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'interpreter' , 'max_recursion' , 10 ) ;
2015-03-29 01:50:43 +01:00
2016-07-01 22:00:20 +02:00
$ self - > { output_queue } = { } ;
$ self - > { command_queue } = { } ;
$ self - > { last_paste } = 0 ;
2015-03-29 01:50:43 +01:00
2016-07-01 22:00:20 +02:00
$ self - > { pbot } - > { timer } - > register ( sub { $ self - > process_output_queue } , 1 ) ;
$ self - > { pbot } - > { timer } - > register ( sub { $ self - > process_command_queue } , 1 ) ;
2012-07-22 21:22:30 +02:00
}
2010-04-13 06:17:54 +02:00
2010-03-17 07:36:54 +01:00
sub process_line {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
2010-03-17 07:36:54 +01:00
my ( $ from , $ nick , $ user , $ host , $ text ) = @ _ ;
2012-07-22 21:22:30 +02:00
2014-03-14 11:05:11 +01:00
my $ command ;
2012-07-22 21:22:30 +02:00
my $ has_code ;
my $ nick_override ;
2015-04-19 10:55:52 +02:00
my $ botnick = $ self - > { pbot } - > { registry } - > get_value ( 'irc' , 'botnick' ) ;
2015-09-08 10:37:34 +02:00
my $ processed = 0 ;
2010-03-17 07:36:54 +01:00
$ from = lc $ from if defined $ from ;
2017-11-16 18:23:58 +01:00
my $ stuff = { from = > $ from , nick = > $ nick , user = > $ user , host = > $ host , text = > $ text } ;
2014-05-19 23:34:24 +02:00
my $ pbot = $ self - > { pbot } ;
2010-03-22 08:33:44 +01:00
2014-05-13 12:15:52 +02:00
my $ message_account = $ pbot - > { messagehistory } - > get_message_account ( $ nick , $ user , $ host ) ;
$ pbot - > { messagehistory } - > add_message ( $ message_account , "$nick!$user\@$host" , $ from , $ text , $ pbot - > { messagehistory } - > { MSG_CHAT } ) ;
2017-11-16 18:23:58 +01:00
$ stuff - > { message_account } = $ message_account ;
2015-07-08 23:05:55 +02:00
my $ flood_threshold = $ pbot - > { registry } - > get_value ( $ from , 'chat_flood_threshold' ) ;
my $ flood_time_threshold = $ pbot - > { registry } - > get_value ( $ from , 'chat_flood_time_threshold' ) ;
$ flood_threshold = $ pbot - > { registry } - > get_value ( 'antiflood' , 'chat_flood_threshold' ) if not defined $ flood_threshold ;
$ flood_time_threshold = $ pbot - > { registry } - > get_value ( 'antiflood' , 'chat_flood_time_threshold' ) if not defined $ flood_time_threshold ;
2014-05-19 04:42:18 +02:00
$ pbot - > { antiflood } - > check_flood ( $ from , $ nick , $ user , $ host , $ text ,
2015-07-08 23:05:55 +02:00
$ flood_threshold , $ flood_time_threshold ,
2014-05-19 04:42:18 +02:00
$ pbot - > { messagehistory } - > { MSG_CHAT } ) if defined $ from ;
2010-03-17 07:36:54 +01:00
2015-09-08 10:37:34 +02:00
my $ preserve_whitespace = 0 ;
2013-07-24 14:33:19 +02:00
$ text =~ s/^\s+// ;
$ text =~ s/\s+$// ;
2017-09-05 09:27:28 +02:00
$ text = validate_string ( $ text , 0 ) ;
2012-07-22 21:22:30 +02:00
2013-07-24 14:33:19 +02:00
my $ cmd_text = $ text ;
$ cmd_text =~ s/^\/me\s+// ;
2015-03-23 12:27:41 +01:00
# get channel-specific trigger if available
my $ bot_trigger = $ pbot - > { registry } - > get_value ( $ from , 'trigger' ) ;
if ( not defined $ bot_trigger ) {
$ bot_trigger = $ pbot - > { registry } - > get_value ( 'general' , 'trigger' ) ;
}
2014-05-17 22:08:19 +02:00
2015-09-04 05:56:44 +02:00
my $ referenced ;
my $ count = 0 ;
while ( + + $ count <= 3 ) {
$ referenced = 0 ;
$ command = undef ;
$ has_code = undef ;
2017-11-15 00:27:30 +01:00
if ( $ cmd_text =~ s/^(?:$botnick.?)?\s*{\s*(.*)\s*}\s*$// ) {
2015-09-04 05:56:44 +02:00
$ has_code = $ 1 if length $ 1 ;
$ preserve_whitespace = 1 ;
2015-09-08 10:37:34 +02:00
$ processed += 100 ;
2017-11-15 00:27:30 +01:00
} elsif ( $ cmd_text =~ s/^\s*([^!,:\(\)\+\*\/ ]+)[,:]*\s*{\s*(.*)\s*}\s*$// ) {
2015-09-08 10:37:34 +02:00
$ nick_override = $ 1 ;
$ has_code = $ 2 if length $ 2 and $ nick_override !~ /^(?:enum|struct|union)$/ ;
$ preserve_whitespace = 1 ;
2017-11-16 18:23:58 +01:00
$ nick_override = $ self - > { pbot } - > { nicklist } - > is_present ( $ from , $ nick_override ) ;
2015-09-08 10:37:34 +02:00
$ processed += 100 ;
2017-11-15 00:27:30 +01:00
} elsif ( $ cmd_text =~ s/^\s*([^!,:\(\)\+\*\/ ]+)[,:]?\s+$bot_trigger[`\{](.+?)[\}`]\s*// ) {
$ nick_override = $ 1 ;
$ command = $ 2 ;
my $ similar = $ self - > { pbot } - > { nicklist } - > is_present_similar ( $ from , $ nick_override ) ;
if ( $ similar ) {
$ nick_override = $ similar ;
2017-10-05 23:31:00 +02:00
} else {
2017-11-15 00:27:30 +01:00
$ self - > { pbot } - > { logger } - > log ( "No similar nick for $nick_override\n" ) ;
return 0 ;
2017-10-05 23:31:00 +02:00
}
2017-11-15 00:27:30 +01:00
$ cmd_text = "$nick_override: $cmd_text" ;
$ processed += 100 ;
} elsif ( $ cmd_text =~ s/^\s*([^!,:\(\)\+\*\/ ]+)[,:]?\s+$bot_trigger(.+)$// ) {
2016-10-14 14:56:54 +02:00
$ nick_override = $ 1 ;
$ command = $ 2 ;
2016-10-23 12:51:59 +02:00
my $ similar = $ self - > { pbot } - > { nicklist } - > is_present_similar ( $ from , $ nick_override ) ;
if ( $ similar ) {
$ nick_override = $ similar ;
} else {
$ self - > { pbot } - > { logger } - > log ( "No similar nick for $nick_override\n" ) ;
return 0 ;
2016-10-14 14:56:54 +02:00
}
2017-11-15 00:27:30 +01:00
$ cmd_text = "$nick_override: $cmd_text" ;
2016-10-23 12:51:59 +02:00
$ processed += 100 ;
2017-11-15 00:27:30 +01:00
} elsif ( $ cmd_text =~ s/^$bot_trigger(.*)$// ) {
2016-10-23 12:51:59 +02:00
$ command = $ 1 ;
2015-09-08 10:37:34 +02:00
$ processed += 100 ;
2017-11-15 00:27:30 +01:00
} elsif ( $ cmd_text =~ s/$bot_trigger`([^`]+)`\s*// || $ cmd_text =~ s/$bot_trigger\{([^}]+)\}\s*// ) {
my $ cmd = $ 1 ;
my ( $ nick ) = $ cmd_text =~ m/^([^ ,:;]+)/ ;
$ nick = $ self - > { pbot } - > { nicklist } - > is_present ( $ from , $ nick ) ;
if ( $ nick ) {
$ command = "tell $nick about $cmd" ;
} else {
$ command = $ cmd ;
}
$ referenced = 1 ;
} elsif ( $ cmd_text =~ s/^.?$botnick.?\s*(.*?)$//i ) {
2015-09-04 05:56:44 +02:00
$ command = $ 1 ;
2015-09-08 10:37:34 +02:00
$ processed += 100 ;
2016-06-26 03:09:47 +02:00
} elsif ( $ cmd_text =~ s/^(.*?),?\s*$botnick[?!.]*$//i ) {
2016-01-19 15:51:40 +01:00
$ command = $ 1 ;
$ processed += 100 ;
2015-09-04 05:56:44 +02:00
}
2015-09-08 10:37:34 +02:00
last if not defined $ command and not defined $ has_code ;
2010-03-17 07:36:54 +01:00
2015-09-08 10:37:34 +02:00
if ( ( ! defined $ command || $ command !~ /^login / ) && defined $ from && $ pbot - > { ignorelist } - > check_ignore ( $ nick , $ user , $ host , $ from ) ) {
2015-09-07 14:04:54 +02:00
my $ admin = $ pbot - > { admins } - > loggedin ( $ from , "$nick!$user\@$host" ) ;
if ( ! defined $ admin || $ admin - > { level } < 10 ) {
# ignored hostmask
2015-09-08 10:37:34 +02:00
return 1 ;
2010-03-17 07:36:54 +01:00
}
2015-09-07 14:04:54 +02:00
}
2010-03-17 07:36:54 +01:00
2015-09-08 10:37:34 +02:00
if ( defined $ has_code ) {
$ processed += 100 ; # ensure no other plugins try to parse this message
2015-09-07 14:04:54 +02:00
if ( $ pbot - > { registry } - > get_value ( 'general' , 'compile_blocks' ) and not $ pbot - > { registry } - > get_value ( $ from , 'no_compile_blocks' )
and not grep { $ from =~ /$_/i } $ pbot - > { registry } - > get_value ( 'general' , 'compile_blocks_ignore_channels' )
and grep { $ from =~ /$_/i } $ pbot - > { registry } - > get_value ( 'general' , 'compile_blocks_channels' ) ) {
if ( not defined $ nick_override or ( defined $ nick_override and $ self - > { pbot } - > { nicklist } - > is_present ( $ from , $ nick_override ) ) ) {
2017-09-11 04:53:29 +02:00
$ pbot - > { factoids } - > { factoidmodulelauncher } - > execute_module ( $ from , undef , $ nick , $ user , $ host , $ text , "compiler_block" , $ from , '{' , ( defined $ nick_override ? $ nick_override : $ nick ) . " $from $has_code }" , $ preserve_whitespace ) ;
2015-06-20 01:16:23 +02:00
}
2014-05-19 23:34:24 +02:00
}
2015-09-07 14:04:54 +02:00
} else {
2017-11-16 18:23:58 +01:00
$ stuff - > { text } = $ text ;
$ stuff - > { command } = $ command ;
$ stuff - > { nickoverride } = $ nick_override if $ nick_override ;
$ stuff - > { referenced } = $ referenced ;
$ stuff - > { interpret_depth } = 1 ;
$ stuff - > { preserve_whitespace } = $ preserve_whitespace ;
my $ result = $ self - > interpret ( $ stuff ) ;
$ stuff - > { result } = $ result ;
$ processed + + if $ self - > handle_result ( $ stuff , $ result ) ;
2010-04-17 21:22:22 +02:00
}
2014-03-14 11:05:11 +01:00
}
2015-09-08 10:37:34 +02:00
return $ processed ;
2014-03-14 11:05:11 +01:00
}
2010-03-17 07:36:54 +01:00
2015-03-31 00:04:08 +02:00
sub interpret {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff ) = @ _ ;
# my ($from, $nick, $user, $host, $depth, $command, $tonick, $referenced, $root_keyword) = @_;
2015-03-31 00:04:08 +02:00
my ( $ keyword , $ arguments ) = ( "" , "" ) ;
my $ text ;
my $ pbot = $ self - > { pbot } ;
2017-11-16 18:23:58 +01:00
$ pbot - > { logger } - > log ( "=== Enter interpret_command: [" . ( defined $ stuff - > { from } ? $ stuff - > { from } : "(undef)" ) . "][$stuff->{nick}!$stuff->{user}\@$stuff->{host}][$stuff->{interpret_depth}][$stuff->{command}]\n" ) ;
2015-03-31 00:04:08 +02:00
2017-11-16 18:23:58 +01:00
use Data::Dumper ;
$ Data:: Dumper:: Sortkeys = 1 ;
$ self - > { pbot } - > { logger } - > log ( "Interpreter::interpret\n" ) ;
$ self - > { pbot } - > { logger } - > log ( Dumper $ stuff ) ;
2015-03-31 00:04:08 +02:00
2017-11-16 18:23:58 +01:00
return "Too many levels of recursion, aborted." if ( + + $ stuff - > { interpret_depth } > $ self - > { pbot } - > { registry } - > get_value ( 'interpreter' , 'max_recursion' ) ) ;
if ( not defined $ stuff - > { nick } || not defined $ stuff - > { user } || not defined $ stuff - > { host } || not defined $ stuff - > { command } ) {
2015-03-31 00:04:08 +02:00
$ pbot - > { logger } - > log ( "Error 1, bad parameters to interpret_command\n" ) ;
return undef ;
}
2017-11-17 22:53:23 +01:00
if ( $ stuff - > { command } =~ /^tell\s+(\p{PosixGraph}{1,20})\s+about\s+(.*?)\s+(.*)$/is ) {
2017-11-16 18:23:58 +01:00
( $ keyword , $ arguments , $ stuff - > { nickoverride } ) = ( $ 2 , $ 3 , $ 1 ) ;
my $ similar = $ self - > { pbot } - > { nicklist } - > is_present_similar ( $ stuff - > { from } , $ stuff - > { nickoverride } ) ;
if ( $ similar ) {
$ stuff - > { nickoverride } = $ similar ;
} else {
$ stuff - > { nickoverride } = undef ;
}
2017-11-17 22:53:23 +01:00
} elsif ( $ stuff - > { command } =~ /^tell\s+(\p{PosixGraph}{1,20})\s+about\s+(.*)$/is ) {
2017-11-16 18:23:58 +01:00
( $ keyword , $ stuff - > { nickoverride } ) = ( $ 2 , $ 1 ) ;
my $ similar = $ self - > { pbot } - > { nicklist } - > is_present_similar ( $ stuff - > { from } , $ stuff - > { nickoverride } ) ;
if ( $ similar ) {
$ stuff - > { nickoverride } = $ similar ;
} else {
$ stuff - > { nickoverride } = undef ;
}
2017-11-17 22:53:23 +01:00
} elsif ( $ stuff - > { command } =~ /^(.*?)\s+(.*)$/s ) {
2015-03-31 00:04:08 +02:00
( $ keyword , $ arguments ) = ( $ 1 , $ 2 ) ;
} else {
2017-11-16 18:23:58 +01:00
$ keyword = $ stuff - > { command } ;
2015-03-31 00:04:08 +02:00
}
2017-11-13 21:00:34 +01:00
if ( length $ keyword > 30 ) {
$ keyword = substr ( $ keyword , 0 , 30 ) ;
$ self - > { pbot } - > { logger } - > log ( "Truncating keyword to 30 chars: $keyword\n" ) ;
}
2017-11-19 23:39:03 +01:00
my $ got_pipe = 0 ;
2017-11-17 22:53:23 +01:00
if ( defined $ arguments && $ arguments =~ m/\|\s*\{\s*[^}]+\}\s*$/ ) {
$ arguments =~ m/(.*?)\s*\|\s*\{\s*([^}]+)\}(.*)/ ;
my ( $ args , $ pipe , $ rest ) = ( $ 1 , $ 2 , $ 3 ) ;
$ pipe =~ s/\s+$// ;
$ self - > { pbot } - > { logger } - > log ( "piping: [$args][$pipe][$rest]\n" ) ;
$ stuff - > { arguments } = $ args ;
$ stuff - > { pipe } = $ pipe ;
$ stuff - > { pipe_rest } = $ rest ;
2017-11-19 23:39:03 +01:00
$ got_pipe = 1 ;
2017-11-17 22:53:23 +01:00
}
2017-11-16 18:23:58 +01:00
$ stuff - > { nickoverride } = $ stuff - > { nick } if defined $ stuff - > { nickoverride } and $ stuff - > { nickoverride } eq 'me' ;
2017-08-02 06:34:57 +02:00
2017-11-17 22:53:23 +01:00
if ( ( not exists $ stuff - > { pipe } ) and $ keyword !~ /^(?:factrem|forget|set|factdel|factadd|add|factfind|find|factshow|show|forget|factdel|factset|factchange|change|msg|tell|cc|eval|u|udict|ud|actiontrigger|urban|perl)$/ ) {
2015-03-31 00:04:08 +02:00
$ keyword =~ s/(\w+)([?!.]+)$/$1/ ;
2017-11-16 18:23:58 +01:00
$ arguments =~ s/(?<![\w\/\-\\])me\b/$stuff->{nick}/gi if defined $ arguments && $ stuff - > { interpret_depth } <= 2 ;
$ arguments =~ s/(?<![\w\/\-\\])my\b/$stuff->{nick}'s/gi if defined $ arguments && $ stuff - > { interpret_depth } <= 2 ;
$ arguments =~ s/\\my\b/my/gi if defined $ arguments && $ stuff - > { interpret_depth } <= 2 ;
$ arguments =~ s/\\me\b/me/gi if defined $ arguments && $ stuff - > { interpret_depth } <= 2 ;
2015-09-20 05:02:11 +02:00
2017-08-26 13:06:36 +02:00
my $ botnick = $ self - > { pbot } - > { registry } - > get_value ( 'irc' , 'botnick' ) ;
if ( defined $ arguments && ( $ arguments =~ m/^(your|him|her|its|it|them|their)(self|selves)$/i || $ arguments =~ m/^$botnick$/i ) ) {
my $ delay = ( rand 10 ) + 8 ;
my $ message = {
2017-11-16 18:23:58 +01:00
nick = > $ stuff - > { nick } , user = > $ stuff - > { user } , host = > $ stuff - > { host } , command = > $ stuff - > { command } , checkflood = > 1 ,
message = > "$stuff->{nick}: Why would I want to do that to myself?"
2017-08-26 13:06:36 +02:00
} ;
2017-11-16 18:23:58 +01:00
$ self - > add_message_to_output_queue ( $ stuff - > { from } , $ message , $ delay ) ;
2017-08-26 13:06:36 +02:00
$ delay = duration ( $ delay ) ;
$ self - > { pbot } - > { logger } - > log ( "Final result ($delay delay) [$message->{message}]\n" ) ;
return undef ;
}
2015-03-31 00:04:08 +02:00
}
if ( not defined $ keyword ) {
$ pbot - > { logger } - > log ( "Error 2, no keyword\n" ) ;
return undef ;
}
2017-11-16 18:23:58 +01:00
$ stuff - > { keyword } = $ keyword ;
if ( not exists $ stuff - > { root_keyword } ) {
$ stuff - > { root_keyword } = $ keyword ;
}
2017-11-15 00:27:30 +01:00
2017-11-19 23:39:03 +01:00
$ stuff - > { arguments } = $ arguments unless $ got_pipe ;
2017-11-15 00:27:30 +01:00
2017-11-16 18:23:58 +01:00
return $ self - > SUPER:: execute_all ( $ stuff ) ;
2015-03-31 00:04:08 +02:00
}
2014-03-15 02:53:33 +01:00
sub truncate_result {
my ( $ self , $ from , $ nick , $ text , $ original_result , $ result , $ paste ) = @ _ ;
2014-05-17 22:08:19 +02:00
my $ max_msg_len = $ self - > { pbot } - > { registry } - > get_value ( 'irc' , 'max_msg_len' ) ;
2014-03-15 02:53:33 +01:00
2014-05-17 22:08:19 +02:00
if ( length $ result > $ max_msg_len ) {
2014-03-15 02:53:33 +01:00
my $ link ;
if ( $ paste ) {
2017-08-25 00:16:42 +02:00
$ original_result = substr $ original_result , 0 , 8000 ;
2015-05-16 02:53:13 +02:00
$ link = $ self - > paste ( "[" . ( defined $ from ? $ from : "stdin" ) . "] <$nick> $text\n\n$original_result" ) ;
2014-03-15 02:53:33 +01:00
} else {
$ link = 'undef' ;
}
2015-05-07 06:15:25 +02:00
my $ trunc = "... [truncated; " ;
if ( $ link =~ m/^http/ ) {
$ trunc . = "see $link for full text.]" ;
} else {
$ trunc . = "$link]" ;
}
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "Message truncated -- pasted to $link\n" ) if $ paste ;
2014-03-15 02:53:33 +01:00
2014-05-17 22:08:19 +02:00
my $ trunc_len = length $ result < $ max_msg_len ? length $ result : $ max_msg_len ;
2014-03-15 02:53:33 +01:00
$ result = substr ( $ result , 0 , $ trunc_len ) ;
substr ( $ result , $ trunc_len - length $ trunc ) = $ trunc ;
}
return $ result ;
}
2014-03-14 11:05:11 +01:00
sub handle_result {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff , $ result ) = @ _ ;
# my ($self, $from, $nick, $user, $host, $text, $command, $result, $checkflood, $preserve_whitespace) = @_;
$ stuff - > { preserve_whitespace } = 0 if not defined $ stuff - > { preserve_whitespace } ;
use Data::Dumper ;
$ Data:: Dumper:: Sortkeys = 1 ;
$ self - > { pbot } - > { logger } - > log ( "Interpreter::handle_result [$result]\n" ) ;
$ self - > { pbot } - > { logger } - > log ( Dumper $ stuff ) ;
2012-07-22 21:22:30 +02:00
2017-11-16 18:23:58 +01:00
$ result = $ stuff - > { result } if not defined $ result ;
2017-09-11 04:53:29 +02:00
2015-03-29 01:50:43 +01:00
if ( not defined $ result or length $ result == 0 ) {
2015-09-08 10:37:34 +02:00
return 0 ;
2014-03-14 11:05:11 +01:00
}
2012-07-22 21:22:30 +02:00
2017-11-16 18:23:58 +01:00
if ( $ stuff - > { pipe } ) {
my ( $ pipe , $ pipe_rest ) = ( $ stuff - > { pipe } , $ stuff - > { pipe_rest } ) ;
delete $ stuff - > { pipe } ;
delete $ stuff - > { pipe_rest } ;
$ self - > { pbot } - > { logger } - > log ( "Handling pipe [$result][$pipe][$pipe_rest]\n" ) ;
if ( $ result =~ s{^(/say |/me )} {}i ) {
$ stuff - > { prepend } = $ 1 ;
} elsif ( $ result =~ s{^/msg ([^ ]+) } {}i ) {
$ stuff - > { prepend } = "/msg $1 " ;
}
$ stuff - > { command } = "$pipe $result$pipe_rest" ;
$ result = $ self - > interpret ( $ stuff ) ;
$ stuff - > { result } = $ result ;
$ self - > handle_result ( $ stuff , $ result ) ;
return 0 ;
}
if ( $ stuff - > { prepend } ) {
# FIXME: do this better
2017-11-17 22:53:23 +01:00
if ( $ result =~ m {^(/say |/me )}i ) {
} elsif ( $ result =~ m {^/msg ([^ ]+) }i ) {
2017-11-18 06:38:28 +01:00
} elsif ( $ result =~ m {^/kick }i ) {
2017-11-17 22:53:23 +01:00
} else {
$ result = "$stuff->{prepend}$result" ;
$ self - > { pbot } - > { logger } - > log ( "Prepending [$stuff->{prepend}] to result [$result]\n" ) ;
2017-11-16 18:23:58 +01:00
}
}
2014-03-14 11:05:11 +01:00
my $ original_result = $ result ;
2010-03-17 07:36:54 +01:00
2015-03-29 01:50:43 +01:00
my $ use_output_queue = 0 ;
2017-11-16 18:23:58 +01:00
if ( defined $ stuff - > { command } ) {
my ( $ cmd , $ args ) = split /\s+/ , $ stuff - > { command } , 2 ;
2015-04-04 00:33:19 +02:00
if ( not $ self - > { pbot } - > { commands } - > exists ( $ cmd ) ) {
2017-11-16 18:23:58 +01:00
my ( $ chan , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ stuff - > { from } , $ cmd , $ args , 1 , 0 , 1 ) ;
2015-04-04 00:33:19 +02:00
if ( defined $ trigger ) {
2017-11-16 18:23:58 +01:00
if ( $ stuff - > { preserve_whitespace } == 0 ) {
$ stuff - > { preserve_whitespace } = $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { $ chan } - > { $ trigger } - > { preserve_whitespace } ;
$ stuff - > { preserve_whitespace } = 0 if not defined $ stuff - > { preserve_whitespace } ;
2015-04-04 00:33:19 +02:00
}
$ use_output_queue = $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { $ chan } - > { $ trigger } - > { use_output_queue } ;
$ use_output_queue = 0 if not defined $ use_output_queue ;
2015-03-29 01:50:43 +01:00
}
2010-03-17 07:36:54 +01:00
}
2014-03-14 11:05:11 +01:00
}
2013-10-22 20:57:08 +02:00
2017-11-16 18:23:58 +01:00
my $ preserve_newlines = $ self - > { pbot } - > { registry } - > get_value ( $ stuff - > { from } , 'preserve_newlines' ) ;
2014-08-05 00:48:32 +02:00
$ result =~ s/[\n\r]/ /g unless $ preserve_newlines ;
2017-11-16 18:23:58 +01:00
$ result =~ s/[ \t]+/ /g unless $ self - > { preserve_whitespace } ;
2014-08-05 00:48:32 +02:00
2017-11-16 18:23:58 +01:00
my $ max_lines = $ self - > { pbot } - > { registry } - > get_value ( $ stuff - > { from } , 'max_newlines' ) ;
2014-08-06 01:15:11 +02:00
$ max_lines = 4 if not defined $ max_lines ;
2014-08-05 00:48:32 +02:00
my $ lines = 0 ;
2014-08-06 01:15:11 +02:00
2014-08-11 09:32:24 +02:00
my $ stripped_line ;
foreach my $ line ( split /[\n\r]+/ , $ result ) {
$ stripped_line = $ line ;
$ stripped_line =~ s/^\s+// ;
$ stripped_line =~ s/\s+$// ;
next if not length $ stripped_line ;
2014-08-06 01:15:11 +02:00
if ( + + $ lines >= $ max_lines ) {
2017-11-16 18:23:58 +01:00
my $ link = $ self - > paste ( "[" . ( defined $ stuff - > { from } ? $ stuff - > { from } : "stdin" ) . "] <$stuff->{nick}> $stuff->{text}\n\n$original_result" ) ;
2015-03-29 01:50:43 +01:00
if ( $ use_output_queue ) {
my $ message = {
2017-11-16 18:23:58 +01:00
nick = > $ stuff - > { nick } , user = > $ stuff - > { user } , host = > $ stuff - > { host } , command = > $ stuff - > { command } ,
2015-03-29 01:50:43 +01:00
message = > "And that's all I have to say about that. See $link for full text." ,
2017-11-16 18:23:58 +01:00
checkflood = > $ stuff - > { checkflood }
2015-03-29 01:50:43 +01:00
} ;
2017-11-16 18:23:58 +01:00
$ self - > add_message_to_output_queue ( $ stuff - > { from } , $ message , 0 ) ;
2015-03-29 01:50:43 +01:00
} else {
2017-11-16 18:23:58 +01:00
$ self - > { pbot } - > { conn } - > privmsg ( $ stuff - > { from } , "And that's all I have to say about that. See $link for full text." ) ;
2015-03-29 01:50:43 +01:00
}
2014-08-05 00:48:32 +02:00
last ;
2014-03-14 11:05:11 +01:00
}
2014-08-05 00:48:32 +02:00
if ( $ preserve_newlines ) {
2017-11-16 18:23:58 +01:00
$ line = $ self - > truncate_result ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { text } , $ line , $ line , 1 ) ;
2014-08-05 00:48:32 +02:00
} else {
2017-11-16 18:23:58 +01:00
$ line = $ self - > truncate_result ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { text } , $ original_result , $ line , 1 ) ;
2014-03-14 11:05:11 +01:00
}
2014-08-05 00:48:32 +02:00
2015-03-29 01:50:43 +01:00
if ( $ use_output_queue ) {
2015-04-14 00:41:11 +02:00
my $ delay = ( rand 5 ) + 5 ; # initial delay for reading/processing user's message
2015-03-30 05:24:36 +02:00
$ delay += ( length $ line ) / 7 ; # additional delay of 7 characters per second typing speed
2015-03-29 01:50:43 +01:00
my $ message = {
2017-11-16 18:23:58 +01:00
nick = > $ stuff - > { nick } , user = > $ stuff - > { user } , host = > $ stuff - > { host } , command = > $ stuff - > { command } ,
message = > $ line , checkflood = > $ stuff - > { checkflood }
2015-03-29 01:50:43 +01:00
} ;
2017-11-16 18:23:58 +01:00
$ self - > add_message_to_output_queue ( $ stuff - > { from } , $ message , $ delay ) ;
2015-03-31 00:04:08 +02:00
$ delay = duration ( $ delay ) ;
$ self - > { pbot } - > { logger } - > log ( "Final result ($delay delay) [$line]\n" ) ;
2014-03-14 11:05:11 +01:00
} else {
2017-11-16 18:23:58 +01:00
$ stuff - > { line } = $ line ;
$ self - > output_result ( $ stuff ) ;
2015-03-31 00:04:08 +02:00
$ self - > { pbot } - > { logger } - > log ( "Final result: [$line]\n" ) ;
2010-03-22 08:33:44 +01:00
}
2010-03-17 07:36:54 +01:00
}
2015-03-29 01:50:43 +01:00
$ self - > { pbot } - > { logger } - > log ( "---------------------------------------------\n" ) ;
2015-09-08 10:37:34 +02:00
return 1 ;
2015-03-29 01:50:43 +01:00
}
sub output_result {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff ) = @ _ ;
# my ($self, $from, $nick, $user, $host, $command, $line, $checkflood) = @_;
2015-04-19 10:55:52 +02:00
my ( $ pbot , $ botnick ) = ( $ self - > { pbot } , $ self - > { pbot } - > { registry } - > get_value ( 'irc' , 'botnick' ) ) ;
2015-03-29 01:50:43 +01:00
2017-11-16 18:23:58 +01:00
use Data::Dumper ;
$ Data:: Dumper:: Sortkeys = 1 ;
$ self - > { pbot } - > { logger } - > log ( "Interpreter::output_result\n" ) ;
$ self - > { pbot } - > { logger } - > log ( Dumper $ stuff ) ;
my $ line = $ stuff - > { line } ;
return if not defined $ line or not length $ line ;
if ( $ line =~ s/^\/say\s+//i ) {
$ pbot - > { conn } - > privmsg ( $ stuff - > { from } , $ line ) if defined $ stuff - > { from } && $ stuff - > { from } !~ /\Q$botnick\E/i ;
$ pbot - > { antiflood } - > check_flood ( $ stuff - > { from } , $ botnick , $ pbot - > { registry } - > get_value ( 'irc' , 'username' ) , 'localhost' , $ line , 0 , 0 , 0 ) if $ stuff - > { checkflood } ;
} elsif ( $ line =~ s/^\/me\s+//i ) {
$ pbot - > { conn } - > me ( $ stuff - > { from } , $ line ) if defined $ stuff - > { from } && $ stuff - > { from } !~ /\Q$botnick\E/i ;
$ pbot - > { antiflood } - > check_flood ( $ stuff - > { from } , $ botnick , $ pbot - > { registry } - > get_value ( 'irc' , 'username' ) , 'localhost' , '/me ' . $ line , 0 , 0 , 0 ) if $ stuff - > { checkflood } ;
} elsif ( $ line =~ s/^\/msg\s+([^\s]+)\s+//i ) {
2015-03-29 01:50:43 +01:00
my $ to = $ 1 ;
2017-11-16 18:23:58 +01:00
if ( $ to =~ /,/ ) {
$ pbot - > { logger } - > log ( "[HACK] Possible HACK ATTEMPT /msg multiple users: [$stuff->{nick}!$stuff->{user}\@$stuff->{host}] [$stuff->{command}] [$line]\n" ) ;
} elsif ( $ to =~ /.*serv$/i ) {
$ pbot - > { logger } - > log ( "[HACK] Possible HACK ATTEMPT /msg *serv: [$stuff->{nick}!$stuff->{user}\@$stuff->{host}] [$stuff->{command}] [$line]\n" ) ;
} elsif ( $ line =~ s/^\/me\s+//i ) {
2015-04-19 10:55:52 +02:00
$ pbot - > { conn } - > me ( $ to , $ line ) if $ to !~ /\Q$botnick\E/i ;
2017-11-16 18:23:58 +01:00
$ pbot - > { antiflood } - > check_flood ( $ to , $ botnick , $ pbot - > { registry } - > get_value ( 'irc' , 'username' ) , 'localhost' , '/me ' . $ line , 0 , 0 , 0 ) if $ stuff - > { checkflood } ;
2015-03-29 01:50:43 +01:00
} else {
$ line =~ s/^\/say\s+//i ;
2015-04-19 10:55:52 +02:00
$ pbot - > { conn } - > privmsg ( $ to , $ line ) if $ to !~ /\Q$botnick\E/i ;
2017-11-16 18:23:58 +01:00
$ pbot - > { antiflood } - > check_flood ( $ to , $ botnick , $ pbot - > { registry } - > get_value ( 'irc' , 'username' ) , 'localhost' , $ line , 0 , 0 , 0 ) if $ stuff - > { checkflood } ;
2015-03-29 01:50:43 +01:00
}
2017-11-18 06:37:54 +01:00
} elsif ( $ stuff - > { authorized } && $ line =~ s/^\/kick\s+// ) {
2017-11-16 18:23:58 +01:00
$ pbot - > { antiflood } - > check_flood ( $ stuff - > { from } , $ botnick , $ pbot - > { registry } - > get_value ( 'irc' , 'username' ) , 'localhost' , '/kick ' . $ line , 0 , 0 , 0 ) if $ stuff - > { checkflood } ;
2017-09-02 09:39:29 +02:00
my ( $ victim , $ reason ) = split /\s+/ , $ line , 2 ;
2016-11-17 04:07:01 +01:00
if ( not defined $ reason ) {
if ( open my $ fh , '<' , $ self - > { pbot } - > { registry } - > get_value ( 'general' , 'module_dir' ) . '/insults.txt' ) {
my @ insults = <$fh> ;
close $ fh ;
$ reason = $ insults [ rand @ insults ] ;
chomp $ reason ;
} else {
$ reason = 'Bye!' ;
}
}
2017-11-16 18:23:58 +01:00
if ( $ self - > { pbot } - > { chanops } - > can_gain_ops ( $ stuff - > { from } ) ) {
$ self - > { pbot } - > { chanops } - > add_op_command ( $ stuff - > { from } , "kick $stuff->{from} $victim $reason" ) ;
$ self - > { pbot } - > { chanops } - > gain_ops ( $ stuff - > { from } ) ;
2016-11-17 04:07:01 +01:00
} else {
2017-11-16 18:23:58 +01:00
$ pbot - > { conn } - > privmsg ( $ stuff - > { from } , "$victim: $reason" ) if defined $ stuff - > { from } && $ stuff - > { from } !~ /\Q$botnick\E/i ;
2016-11-17 04:07:01 +01:00
}
2015-03-29 01:50:43 +01:00
} else {
2017-11-16 18:23:58 +01:00
$ pbot - > { conn } - > privmsg ( $ stuff - > { from } , $ line ) if defined $ stuff - > { from } && $ stuff - > { from } !~ /\Q$botnick\E/i ;
$ pbot - > { antiflood } - > check_flood ( $ stuff - > { from } , $ botnick , $ pbot - > { registry } - > get_value ( 'irc' , 'username' ) , 'localhost' , $ line , 0 , 0 , 0 ) if $ stuff - > { checkflood } ;
2015-03-29 01:50:43 +01:00
}
2010-03-17 07:36:54 +01:00
}
2015-03-29 01:50:43 +01:00
sub add_message_to_output_queue {
2015-03-30 05:24:36 +02:00
my ( $ self , $ channel , $ message , $ delay ) = @ _ ;
if ( exists $ self - > { output_queue } - > { $ channel } ) {
my $ last_when = $ self - > { output_queue } - > { $ channel } - > [ - 1 ] - > { when } ;
$ message - > { when } = $ last_when + $ delay ;
} else {
$ message - > { when } = gettimeofday + $ delay ;
}
push @ { $ self - > { output_queue } - > { $ channel } } , $ message ;
2015-03-29 01:50:43 +01:00
}
sub process_output_queue {
my $ self = shift ;
2015-03-30 05:24:36 +02:00
foreach my $ channel ( keys % { $ self - > { output_queue } } ) {
for ( my $ i = 0 ; $ i < @ { $ self - > { output_queue } - > { $ channel } } ; $ i + + ) {
my $ message = $ self - > { output_queue } - > { $ channel } - > [ $ i ] ;
if ( gettimeofday >= $ message - > { when } ) {
2017-11-16 18:23:58 +01:00
my $ stuff = {
from = > $ channel ,
nick = > $ message - > { nick } ,
user = > $ message - > { user } ,
host = > $ message - > { host } ,
line = > $ message - > { message } ,
command = > $ message - > { command } ,
checkflood = > $ message - > { checkflood }
} ;
$ self - > output_result ( $ stuff ) ;
2015-03-30 05:24:36 +02:00
splice @ { $ self - > { output_queue } - > { $ channel } } , $ i - - , 1 ;
}
}
if ( not @ { $ self - > { output_queue } - > { $ channel } } ) {
delete $ self - > { output_queue } - > { $ channel } ;
2015-03-29 01:50:43 +01:00
}
}
}
2016-07-01 22:00:20 +02:00
sub add_to_command_queue {
my ( $ self , $ channel , $ command , $ delay ) = @ _ ;
2016-07-01 22:29:26 +02:00
$ command - > { when } = gettimeofday + $ delay ;
2016-07-01 22:00:20 +02:00
push @ { $ self - > { command_queue } - > { $ channel } } , $ command ;
}
sub add_botcmd_to_command_queue {
my ( $ self , $ channel , $ command , $ delay ) = @ _ ;
my $ botcmd = {
nick = > $ self - > { pbot } - > { registry } - > get_value ( 'irc' , 'botnick' ) ,
user = > 'stdin' ,
host = > 'localhost' ,
command = > $ command
} ;
$ self - > add_to_command_queue ( $ channel , $ botcmd , $ delay ) ;
}
sub process_command_queue {
my $ self = shift ;
foreach my $ channel ( keys % { $ self - > { command_queue } } ) {
for ( my $ i = 0 ; $ i < @ { $ self - > { command_queue } - > { $ channel } } ; $ i + + ) {
my $ command = $ self - > { command_queue } - > { $ channel } - > [ $ i ] ;
if ( gettimeofday >= $ command - > { when } ) {
2017-11-16 18:23:58 +01:00
my $ stuff = {
from = > $ channel ,
nick = > $ command - > { nick } ,
user = > $ command - > { user } ,
host = > $ command - > { host } ,
command = > $ command - > { command } ,
interpret_depth = > 0 ,
checkflood = > 0 ,
preserve_whitespace = > 0
} ;
my $ result = $ self - > interpret ( $ stuff ) ;
$ stuff - > { result } = $ result ;
$ self - > handle_result ( $ stuff , $ result ) ;
2016-07-01 22:00:20 +02:00
splice @ { $ self - > { command_queue } - > { $ channel } } , $ i - - , 1 ;
}
}
if ( not @ { $ self - > { command_queue } - > { $ channel } } ) {
delete $ self - > { command_queue } - > { $ channel } ;
}
}
}
2015-05-16 02:53:13 +02:00
sub paste {
my $ self = shift ;
my $ rate_limit = $ self - > { pbot } - > { registry } - > get_value ( 'general' , 'paste_ratelimit' ) ;
my $ now = gettimeofday ;
if ( $ now - $ self - > { last_paste } < $ rate_limit ) {
return "paste rate-limited, try again in " . ( $ rate_limit - int ( $ now - $ self - > { last_paste } ) ) . " seconds" ;
}
$ self - > { last_paste } = $ now ;
my $ text = join ( ' ' , @ _ ) ;
$ text =~ s/(.{120})\s/$1\n/g ;
2017-10-05 23:31:58 +02:00
my $ result = $ self - > paste_ixio ( $ text ) ;
2015-05-16 02:53:13 +02:00
if ( $ result =~ m/error pasting/ ) {
$ result = $ self - > paste_codepad ( $ text ) ;
}
return $ result ;
}
2017-10-05 23:31:58 +02:00
sub paste_ixio {
my $ self = shift ;
my $ text = join ( ' ' , @ _ ) ;
$ text =~ s/(.{120})\s/$1\n/g ;
my $ ua = LWP::UserAgent - > new ( ) ;
$ ua - > agent ( "Mozilla/5.0" ) ;
push @ { $ ua - > requests_redirectable } , 'POST' ;
$ ua - > timeout ( 10 ) ;
my % post = ( 'f:1' = > $ text ) ;
my $ response = $ ua - > post ( "http://ix.io" , \ % post ) ;
if ( not $ response - > is_success ) {
return "error pasting: " . $ response - > status_line ;
}
my $ result = $ response - > content ;
$ result =~ s/^\s+// ;
$ result =~ s/\s+$// ;
return $ result ;
}
2015-03-31 00:04:08 +02:00
sub paste_codepad {
2015-05-16 02:53:13 +02:00
my $ self = shift ;
2015-03-31 00:04:08 +02:00
my $ text = join ( ' ' , @ _ ) ;
$ text =~ s/(.{120})\s/$1\n/g ;
my $ ua = LWP::UserAgent - > new ( ) ;
$ ua - > agent ( "Mozilla/5.0" ) ;
push @ { $ ua - > requests_redirectable } , 'POST' ;
2017-10-05 23:31:58 +02:00
$ ua - > timeout ( 10 ) ;
2015-03-31 00:04:08 +02:00
my % post = ( 'lang' = > 'Plain Text' , 'code' = > $ text , 'private' = > 'True' , 'submit' = > 'Submit' ) ;
my $ response = $ ua - > post ( "http://codepad.org" , \ % post ) ;
if ( not $ response - > is_success ) {
2015-05-16 02:53:13 +02:00
return "error pasting: " . $ response - > status_line ;
2015-03-31 00:04:08 +02:00
}
return $ response - > request - > uri ;
}
2014-05-19 23:34:24 +02:00
sub paste_sprunge {
2015-05-07 06:15:25 +02:00
my $ self = shift ;
2014-05-19 23:34:24 +02:00
my $ text = join ( ' ' , @ _ ) ;
$ text =~ s/(.{120})\s/$1\n/g ;
my $ ua = LWP::UserAgent - > new ( ) ;
$ ua - > agent ( "Mozilla/5.0" ) ;
$ ua - > requests_redirectable ( [ ] ) ;
2017-10-05 23:31:58 +02:00
$ ua - > timeout ( 10 ) ;
2014-05-19 23:34:24 +02:00
my % post = ( 'sprunge' = > $ text , 'submit' = > 'Submit' ) ;
my $ response = $ ua - > post ( "http://sprunge.us" , \ % post ) ;
if ( not $ response - > is_success ) {
2015-05-07 06:22:22 +02:00
return "error pasting: " . $ response - > status_line ;
2014-05-19 23:34:24 +02:00
}
my $ result = $ response - > content ;
$ result =~ s/^\s+// ;
$ result =~ s/\s+$// ;
return $ result ;
2010-03-17 07:36:54 +01:00
}
1 ;