summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2009-11-08 15:00:27 +0100
committerYorhel <git@yorhel.nl>2009-11-08 15:00:27 +0100
commitedfd4d26db8e8157538fe166def8409fe0ef2345 (patch)
treeee28eac9645e03688050355de0fde6f29e419386 /lib
parent66a00f986ef00c375187d61e34a7f145410f8f32 (diff)
Multi::API/IRC: Added runtime API admin/monitoring interface
+ some runtime statistics + IP ban list (which is likely unnecessary, but you never know...)
Diffstat (limited to 'lib')
-rw-r--r--lib/Multi/API.pm71
-rw-r--r--lib/Multi/IRC.pm61
2 files changed, 115 insertions, 17 deletions
diff --git a/lib/Multi/API.pm b/lib/Multi/API.pm
index 75c5faf3..5e9f71d2 100644
--- a/lib/Multi/API.pm
+++ b/lib/Multi/API.pm
@@ -40,6 +40,7 @@ sub spawn {
$p => [qw|
_start shutdown log server_error client_connect client_error client_input
login login_res get_results get_vn get_vn_res get_release get_release_res
+ admin
|],
],
heap => {
@@ -50,8 +51,10 @@ sub spawn {
tcp_keepalive => [ 120, 60, 3 ], # time, intvl, probes
throttle_cmd => [ 2, 30 ], # interval between each command, allowed burst
throttle_sql => [ 60, 1 ], # sql time multiplier, allowed burst (in sql time)
+ ipbans => [],
@_,
- c => {},
+ c => {}, # open connections
+ s => {conn => 0, cmds => 0, cmd_err => 0}, # stats
},
);
}
@@ -61,8 +64,15 @@ sub spawn {
sub cerr {
my($c, $id, $msg, %o) = @_;
+
+ # update stat counters
+ $c->{cmd_err}++;
+ $poe_kernel->get_active_session()->get_heap()->{s}{cmd_err}++;
+
+ # send error
$c->{wheel}->put([ error => { id => $id, msg => $msg, %o }]);
- # using $poe_kernel here isn't really a clean solution...
+
+ # log
$poe_kernel->yield(log => $c, 'error: %s, %s', $id, $msg);
return undef;
}
@@ -215,6 +225,9 @@ sub client_connect {
my $ip = inet_ntoa($_[ARG1]);
my $sock = $_[ARG0];
+ $_[HEAP]{s}{conn}++;
+
+ return close $sock if grep $ip eq $_, @{$_[HEAP]{ipbans}};
if($_[HEAP]{conn_per_ip} <= grep $ip eq $_[HEAP]{c}{$_}{ip}, keys %{$_[HEAP]{c}}) {
$_[KERNEL]->yield(log => 0,
'Connect from %s denied, limit of %d connections per IP reached', $ip, $_[HEAP]{conn_per_ip});
@@ -239,8 +252,12 @@ sub client_connect {
InputEvent => 'client_input',
);
$_[HEAP]{c}{ $w->ID() } = {
- wheel => $w,
- ip => $ip,
+ wheel => $w,
+ ip => $ip,
+ connected => time,
+ cmds => 0,
+ cmd_err => 0,
+ # username, client, clientver are added after logging in
};
$_[KERNEL]->yield(log => $_[HEAP]{c}{ $w->ID() }, 'Connected');
}
@@ -262,6 +279,11 @@ sub client_input {
my $cmd = shift @$arg;
my $c = $_[HEAP]{c}{$id};
+ # stats
+ $_[HEAP]{s}{cmds}++;
+ $c->{cmds}++;
+
+ # parse error?
return cerr $c, $arg->[0]{id}, $arg->[0]{msg} if !defined $cmd;
# when we're here, we can assume that $cmd contains a valid command
@@ -333,6 +355,9 @@ sub login_res { # num, res, [ c, arg ]
$c->{throttle} = $throttle{$arg->{username}};
$c->{username} = $arg->{username};
+ $c->{client} = $arg->{client};
+ $c->{clientver} = $arg->{clientver};
+
$c->{wheel}->put(['ok']);
$_[KERNEL]->yield(log => $c,
'Successful login by %s using client "%s" ver. %s', $arg->{username}, $arg->{client}, $arg->{clientver});
@@ -635,6 +660,44 @@ sub get_release_res {
}
+# can be call()'ed from other sessions (specifically written for IRC)
+sub admin {
+ my($func, @arg) = @_[ARG0..$#_];
+
+ if($func eq 'stats') {
+ return { %{$_[HEAP]{s}}, online => scalar keys %{$_[HEAP]{c}} };
+ }
+ if($func eq 'list') {
+ return [ map {
+ my $c = $_[HEAP]{c}{$_};
+ my $r = { # make sure not to return our wheel
+ id => $_,
+ (map +($_, $c->{$_}), qw|username ip client clientver connected cmds cmd_err|)
+ };
+ if($c->{username}) {
+ $r->{t_cmd} = ($c->{throttle}[0]-time)/$_[HEAP]{throttle_cmd}[0];
+ $r->{t_sql} = ($c->{throttle}[1]-time)/$_[HEAP]{throttle_sql}[0];
+ $r->{t_cmd} = 0 if $r->{t_cmd} < 0;
+ $r->{t_sql} = 0 if $r->{t_sql} < 0;
+ }
+ $r
+ } keys %{$_[HEAP]{c}} ];
+ }
+ if($func eq 'bans') {
+ return $_[HEAP]{ipbans};
+ }
+ if($func eq 'ban') {
+ my $ip = $_[HEAP]{c}{$arg[0]} ? $_[HEAP]{c}{$arg[0]}{ip} : $arg[0];
+ return undef if !$ip || $ip !~ /^\d{1,3}(?:\.\d{1,3}){3}$/;
+ push @{$_[HEAP]{ipbans}}, $ip;
+ delete $_[HEAP]{c}{$_} for grep $_[HEAP]{c}{$_}{ip} eq $ip, keys %{$_[HEAP]{c}};
+ }
+ if($func eq 'unban') {
+ $_[HEAP]{ipbans} = [ grep $_ ne $arg[0], @{$_[HEAP]{ipbans}} ];
+ }
+}
+
+
1;
diff --git a/lib/Multi/IRC.pm b/lib/Multi/IRC.pm
index 359e8e4b..9f792d54 100644
--- a/lib/Multi/IRC.pm
+++ b/lib/Multi/IRC.pm
@@ -51,7 +51,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 +77,7 @@ sub spawn {
eval => 2|8,
die => 2|8,
post => 2|8,
+ api => 2|8,
},
}
);
@@ -107,6 +108,17 @@ sub throttle {
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');
@@ -323,23 +335,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));
}
@@ -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');
+ }
+}
+
+
#