diff options
Diffstat (limited to 'lib/Multi/IRC.pm')
-rw-r--r-- | lib/Multi/IRC.pm | 87 |
1 files changed, 61 insertions, 26 deletions
diff --git a/lib/Multi/IRC.pm b/lib/Multi/IRC.pm index 359e8e4b..7d74ded7 100644 --- a/lib/Multi/IRC.pm +++ b/lib/Multi/IRC.pm @@ -15,6 +15,8 @@ use POE qw| |; use POE::Component::IRC::Common ':ALL'; use URI::Escape 'uri_escape_utf8'; +use Time::HiRes 'time'; + use constant { USER => ARG0, @@ -51,7 +53,7 @@ sub spawn { _start shutdown throttle_gc irc_001 irc_public irc_ctcp_action irc_msg command idlequote reply notify_init notify notify_result cmd_info cmd_list cmd_uptime cmd_vn cmd_vn_results cmd_p cmd_p_results cmd_quote cmd_quote_result - cmd_say cmd_me cmd_notifications cmd_eval cmd_die cmd_post vndbid formatid + cmd_say cmd_me cmd_notifications cmd_eval cmd_die cmd_post cmd_api vndbid formatid |], ], heap => { @@ -77,6 +79,7 @@ sub spawn { eval => 2|8, die => 2|8, post => 2|8, + api => 2|8, }, } ); @@ -89,24 +92,31 @@ sub spawn { # returns false if throttling isn't necessary for that key sub throttle { my($heap, $key, $tm, $num) = @_; + my $time = time; # garbage collect return ($heap->{throttle} = { - map $heap->{throttle}{$_}[$#{$heap->{throttle}{$_}}] > time-3600 ? ($_, $heap->{throttle}{$_}) : (), keys %{$heap->{throttle}} + map $heap->{throttle}{$_} > $time ? ($_, $heap->{throttle}{$_}) : (), keys %{$heap->{throttle}} }) if !$key; + $heap->{throttle}{$key} = $time if !$heap->{throttle}{$key} || $heap->{throttle}{$key} < $time; $num ||= 1; - my $dat = $heap->{throttle}; - if(!$dat->{$key}) { - $dat->{$key} = [ time ]; - return 0; - } - $dat->{$key} = [ grep $_ > time-$tm, @{$dat->{$key}} ]; - return 1 if @{$dat->{$key}} >= $num; - push @{$dat->{$key}}, time; + return 1 if $heap->{throttle}{$key}-$time > $tm*($num-1); + $heap->{throttle}{$key} += $tm; return 0; } +sub age { + return '-' if !$_[0]; + my $d = int $_[0] / 86400; + $_[0] %= 86400; + my $h = int $_[0] / 3600; + $_[0] %= 3600; + my $m = int $_[0] / 60; + $_[0] %= 60; + return sprintf '%s%02d:%02d:%02d', $d ? $d.' day'.($d>1?'s':'').', ' : '', $h, $m, int $_[0]; +} + sub _start { $_[KERNEL]->alias_set('irc'); @@ -239,8 +249,8 @@ sub command { # mask, dest, msg sub idlequote { for (keys %{$_[HEAP]{idlequotes}}) { next if --$_[HEAP]{idlequotes}{$_} > 0; - $_[KERNEL]->yield(cmd_quote => '', [$_]) if $_[HEAP]{idlequotes}{$_} == 0; - $_[HEAP]{idlequotes}{$_} = int(120+rand(600)); + $_[KERNEL]->yield(cmd_quote => '', [$_]) if $_[HEAP]{idlequotes}{$_} == 0 && !throttle $_[HEAP], "idlequote_$_", 48*3600; + $_[HEAP]{idlequotes}{$_} = int(60+rand(300)); } $_[KERNEL]->delay(idlequote => 60); } @@ -323,23 +333,12 @@ sub cmd_list { sub cmd_uptime { - my $age = sub { - return '...down!?' if !$_[0]; - my $d = int $_[0] / 86400; - $_[0] %= 86400; - my $h = int $_[0] / 3600; - $_[0] %= 3600; - my $m = int $_[0] / 60; - $_[0] %= 60; - return sprintf '%s%02d:%02d:%02d', $d ? $d.' day'.($d>1?'s':'').', ' : '', $h, $m, int $_[0]; - }; - open my $R, '<', '/proc/uptime'; my $server = <$R> =~ /^\s*([0-9]+)/ ? $1 : 0; close $R; my $multi = time - $^T; - $_[KERNEL]->yield(reply => $_[DEST], sprintf 'Server uptime: %s -- mine: %s', $age->($server), $age->($multi)); + $_[KERNEL]->yield(reply => $_[DEST], sprintf 'Server uptime: %s -- mine: %s', age($server), age($multi)); } @@ -347,7 +346,7 @@ sub cmd_vn { (my $q = $_[ARG]||'') =~ s/%//g; return $_[KERNEL]->yield(reply => $_[DEST], 'You forgot the search query, dummy~~!', $_[USER]) if !$q; return $_[KERNEL]->yield(reply => $_[DEST], 'Stop abusing me, it\'s not like I enjoy spamming this channel!', $_[USER]) - if throttle $_[HEAP], "query-$_[USER]-$_[DEST][0]", 60, 5; + if throttle $_[HEAP], "query-$_[USER]-$_[DEST][0]", 60, 3; $_[KERNEL]->post(pg => query => q| SELECT 'v'::text AS type, v.id, vr.title @@ -381,7 +380,7 @@ sub cmd_p { (my $q = $_[ARG]||'') =~ s/%//g; return $_[KERNEL]->yield(reply => $_[DEST], 'You forgot the search query, dummy~~!', $_[USER]) if !$q; return $_[KERNEL]->yield(reply => $_[DEST], 'Stop abusing me, it\'s not like I enjoy spamming this channel!', $_[USER]) - if throttle $_[HEAP], "query-$_[USER]-$_[DEST][0]", 60, 5; + if throttle $_[HEAP], "query-$_[USER]-$_[DEST][0]", 60, 3; $_[KERNEL]->post(pg => query => q| SELECT 'p'::text AS type, p.id, pr.name AS title @@ -403,6 +402,8 @@ sub cmd_p_results { # num, res, \@_ sub cmd_quote { + return $_[KERNEL]->yield(reply => $_[DEST], 'Stop abusing me, it\'s not like I enjoy spamming this channel!', $_[USER]) + if throttle $_[HEAP], "query-$_[USER]-$_[DEST][0]", 60, 3; $_[KERNEL]->post(pg => query => q|SELECT quote FROM quotes ORDER BY random() LIMIT 1|, undef, 'cmd_quote_result', $_[DEST]); } @@ -457,6 +458,40 @@ sub cmd_post { } +sub cmd_api { + my($cmd, @arg) = split /\s+/, $_[ARG]||''; + return $_[KERNEL]->yield(reply => $_[DEST], 'API module not enabled.') + if !defined $_[KERNEL]->alias_resolve('api'); + + if(!$cmd) { + my $stats = $_[KERNEL]->call(api => admin => 'stats'); + return $_[KERNEL]->yield(reply => $_[DEST], sprintf + 'API up %s, %d connects (%d online), %d commands (%d errors).', + age(time - $^T), $stats->{conn}, $stats->{online}, $stats->{cmds}, $stats->{cmd_err}); + } + if($cmd eq 'list') { + my $lst = $_[KERNEL]->call(api => admin => 'list'); + return $_[KERNEL]->yield(reply => $_[DEST], 'Nobody connected.') if !@$lst; + $_[KERNEL]->yield(reply => $_[DEST], sprintf '%3d %15s %s%s', $_->{id}, $_->{ip}, age(time-$_->{connected}), + !$_->{username} ? '' : sprintf ' - %s (%s %s) C/E: %d/%d T: %.2f/%.2f', $_->{username}, + $_->{client}, $_->{clientver}, $_->{cmds}, $_->{cmd_err}, $_->{t_cmd}, $_->{t_sql}) + for (sort { $a->{ip} cmp $b->{ip} } @$lst); + } + if($cmd eq 'bans') { + my $lst = $_[KERNEL]->call(api => admin => 'bans'); + return $_[KERNEL]->yield(reply => $_[DEST], !@$lst ? 'Ban list empty.' : join ' ', sort @$lst); + } + if($cmd eq 'ban') { + $_[KERNEL]->call(api => admin => ban => $arg[0]); + return $_[KERNEL]->yield(reply => $_[DEST], 'IP banned'); + } + if($cmd eq 'unban') { + $_[KERNEL]->call(api => admin => unban => $arg[0]); + return $_[KERNEL]->yield(reply => $_[DEST], 'IP unbanned'); + } +} + + # |