diff options
author | Yorhel <git@yorhel.nl> | 2009-11-08 15:00:27 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2009-11-08 15:00:27 +0100 |
commit | edfd4d26db8e8157538fe166def8409fe0ef2345 (patch) | |
tree | ee28eac9645e03688050355de0fde6f29e419386 /lib | |
parent | 66a00f986ef00c375187d61e34a7f145410f8f32 (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.pm | 71 | ||||
-rw-r--r-- | lib/Multi/IRC.pm | 61 |
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'); + } +} + + # |