rendered paste body#!/usr/bin/perl
# Copyright (c) Peter Kirk <peterDOTkirkATgmxDOTde>, 2004
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See
# the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use IO::Socket;
use IO::File;
use POSIX 'setsid';
use RRDs;
use warnings;
use strict;
use diagnostics;
use lib "modules";
use Tcpquery;
die "Syntax: gurugrapher path_to_put_the_gifs\n" if (@ARGV != 1);
my $DRAW_PICTURE = 1;
my $DAEMONIZE = 1;
my $DEBUG = 0;
my $DEST_DIR = $ARGV[0];
my $RRD_DIR = "rrds";
die "Bad path syntax !\n" unless($DEST_DIR =~ /[A-Za-z0-9_\/]+/);
my %playerlist = ();
my %servers = ( "test.teamspeak.org" => [ 8767 ],
"stable.teamspeak.org" => [ 10050, 10060 ] );
my %server_labels = ( "test.teamspeak.org8767" => "Public -1-",
"stable.teamspeak.org10050" => "Public -2-",
"stable.teamspeak.org10060" => "Public -3-");
my @idletimes = (7200, 3600, 1800, 900, 600, 300, 60, 0);
my @args = ();
my $ERR;
mkdir($RRD_DIR, 0700);
#create the databases
unless(IO::File->new("$RRD_DIR/teamspeak-users-total.rrd")) #file exists...
{
@args = ("$RRD_DIR/teamspeak-users-total.rrd", "--step", "120",
"DS:users:GAUGE:600:U:U", "RRA:AVERAGE:0.5:1:1400", "RRA:AVERAGE:0.5:7:1400",
"RRA:AVERAGE:0.5:360:1400", "RRA:MAX:0.5:1:1400", "RRA:MAX:0.5:7:1400",
"RRA:MAX:0.5:360:1400" );
RRDs::create(@args); $ERR=RRDs::error; die "rrdtool create @args failed: $ERR" if $ERR;
print "We did rrdtool create @args\n" if($DEBUG);
}
foreach my $server (keys %servers)
{
foreach my $port (@{$servers{$server}})
{
next if(IO::File->new("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd")); #file exists...
@args = ("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd", "--step", "120",
"DS:users:GAUGE:600:U:U", "RRA:AVERAGE:0.5:1:1400", "RRA:AVERAGE:0.5:7:1400",
"RRA:AVERAGE:0.5:360:1400", "RRA:MAX:0.5:1:1400", "RRA:MAX:0.5:7:1400",
"RRA:MAX:0.5:360:1400" );
RRDs::create(@args); $ERR=RRDs::error; die "rrdtool create @args failed: $ERR" if $ERR;
print "We did rrdtool create @args\n" if($DEBUG);
}
}
foreach my $server (keys %servers)
{
foreach my $port (@{$servers{$server}})
{
next if(IO::File->new("$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd")); #file exists...
@args = ("$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd", "--step", "120");
for(my $j = 0; $j < @idletimes; $j++)
{
push @args, "DS:idle_morethan_$idletimes[$j]:GAUGE:600:U:U";
}
push @args, ("RRA:AVERAGE:0.5:1:1400", "RRA:AVERAGE:0.5:7:1400",
"RRA:AVERAGE:0.5:360:1400", "RRA:MAX:0.5:1:1400", "RRA:MAX:0.5:7:1400",
"RRA:MAX:0.5:360:1400" );
RRDs::create(@args); $ERR=RRDs::error; die "rrdtool create @args failed: $ERR" if $ERR;
print "We did rrdtool create @args\n" if($DEBUG);
}
}
while(1)
{
#get data
my %users = ();
my %idlers = ();
my @idler_row = ();
foreach my $server (keys %servers)
{
foreach my $port (@{$servers{$server}})
{
my $previous_includes = 0;
$users{$server.$port} = get_usercount($server, $port, 0);
for(my $j = 0; $j < @idletimes; $j++)
{
$idler_row[$j] = get_usercount($server, $port, $idletimes[$j]) - $previous_includes;
$previous_includes = $previous_includes + $idler_row[$j];
}
$idlers{$server.$port} = [ @idler_row ];
}
}
#fill data into database
my $total_users = 0;
foreach my $server (keys %servers)
{
foreach my $port (@{$servers{$server}})
{
@args = ("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd", "N:$users{$server.$port}");
RRDs::update(@args); $ERR=RRDs::error; die "rrdtool update @args failed: $ERR" if $ERR;
print "We did rrdtool update @args\n" if($DEBUG);
$total_users += $users{$server.$port};
@args = ("$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd");
my $string_to_push = "N";
for(my $j = 0; $j < @idletimes; $j++)
{
$string_to_push = $string_to_push . ":$idlers{$server.$port}[$j]";
}
push @args, $string_to_push;
RRDs::update(@args); $ERR=RRDs::error; die "rrdtool update @args failed: $ERR" if $ERR;
print "We did @args\n" if($DEBUG);
}
}
@args = ("$RRD_DIR/teamspeak-users-total.rrd", "N:$total_users");
RRDs::update(@args); die "rrdtool update @args failed: $ERR" if $ERR;
print "We did rrdtool update @args\n" if($DEBUG);
%idlers = ();
%users = ();
%playerlist = ();
#make picture
if($DRAW_PICTURE)
{
@idletimes = reverse @idletimes;
foreach my $mode ("daily", "weekly", "yearly")
{
my @args = ();
my $timeslice = 120 * 1400;
$timeslice *= 7 if($mode eq "weekly");
$timeslice *= 360 if($mode eq "yearly");
my $rrds = "rrds";
my $variables = "variables";
my $colours = "colours";
my $linecolour = "linecolour";
foreach my $string ($rrds, $variables, $colours, $linecolour)
{
$string = "y".$string if($mode eq "yearly");
}
my $whitespace = 1.1; #leave 10 % whitespace *over* the graph
my @total_rrds = ();
foreach my $server (keys %servers)
{
foreach my $port (@{$servers{$server}})
{
push @total_rrds, "$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd";
}
}
my @idlervars = ();
for(my $i = 0; $i < @idletimes; $i++)
{
my $length = "";
if($i + 1 < @idletimes)
{
$length = "less than ".readable_timeslice($idletimes[$i + 1], 1);
}
else
{
$length = "more than ".readable_timeslice($idletimes[$i], 1);
}
my $allignment = "";
if(length("Users idle $length") < 35)
{
for(my $j = 0; $j < 35 - length("Users idle $length"); $j++)
{
$allignment = $allignment." ";
}
}
push @idlervars, [ ("idle_morethan_$idletimes[$i]", "AVERAGE", "Users idle $length$allignment\\J") ];
}
my %total = ("title" => "Total # of users on TeamSpeak Publics 1, 2 and 3",
"rrds" => [ @total_rrds ],
"variables" => [ [ ("users", "AVERAGE", "Users Public -SUBiSUB-") ] ],
"colours" => [ ("#3be5d1", "#3ce08b", "#9cdb3d") ],
"linecolour" => "#000001",
"ycolours" => [ ("#afafaf", "#000001") ],
"yrrds" => [ ("$RRD_DIR/teamspeak-users-total.rrd") ],
"yvariables" => [ [ ("users", "MAX", "Total user count") ], [ ("users", "AVERAGE", "Average user count") ] ],
"ylinecolour" => "#000000",
"gif" => "$DEST_DIR/teamspeak-users-total-$mode.gif");
my @pubs = ();
foreach my $server (keys %servers)
{
foreach my $port (@{$servers{$server}})
{
push @pubs, {"title" => "# of users on TeamSpeak ".$server_labels{$server.$port},
"rrds" => [ "$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd" ],
"variables" => [ @idlervars ],
"colours" => [ reverse ("#a3182d", "#db551c", "#d89715", "#f9b42a", "#f9ee0e", "#caf90e", "#69f90e", "#59c119") ],
"linecolour" => "#000000",
"ycolours" => [ ("#afafaf", "#000001") ],
"yrrds" => [ ("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd") ],
"yvariables" => [ [ ("users", "MAX", "Total user count") ], [ ("users", "AVERAGE", "Average user count") ] ],
"ylinecolour" => "#000000",
"gif" => "$DEST_DIR/teamspeak-idlers-$server"."_"."$port-$mode.gif"};
}
}
foreach my $what (\%total, @pubs)
{
@args = ($what->{"gif"}, "--start", "-$timeslice",
"-v", "total # of users", "--width", "640", "--height", "250", "-X", "0", "-i",
"-t", $what->{"title"});
print "Now doing $mode - of ".$what->{"title"}."\n";
for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
{
for(my $j = 0; $j < @{$what->{$variables}}; $j++)
{
my $striped_var = $what->{$variables}[$j][0].$what->{$variables}[$j][1];
$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
my $num = (($i + 1) * ($j + 1)) - 1;
push @args, "DEF:unclean_$striped_var$num=".$what->{$rrds}[$i].":".
$what->{$variables}[$j][0].":".$what->{$variables}[$j][1];
my $add_up_string = "0";
for(my $sub_i = 0; $sub_i <= $i; $sub_i++)
{
for(my $sub_j = 0; $sub_j <= $j; $sub_j++)
{
my $striped_var = $what->{$variables}[$sub_j][0].$what->{$variables}[$sub_j][1];
$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
my $sub_num = (($sub_i + 1) * ($sub_j + 1)) - 1;
$add_up_string = $add_up_string . ",$striped_var$sub_num,+";
}
}
push @args, "CDEF:$striped_var$num=unclean_$striped_var$num,UN,0,unclean_$striped_var$num,IF";
push @args, "CDEF:total_$striped_var$num=$add_up_string";
}
}
for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
{
for(my $j = 0; $j < @{$what->{$variables}}; $j++)
{
my $striped_var = $what->{$variables}[$j][0].$what->{$variables}[$j][1];
$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
my $num = (($i + 1) * ($j + 1)) - 1;
my $count = $num + 1;
my $label = $what->{$variables}[$j][2];
$label =~ s/SUBiSUB/$count/;
my $usewhat = "STACK";
$usewhat = "AREA" if($i == 0 && $j == 0);
$usewhat = "LINE2" if(($i > 0 || $j > 0) && $mode eq "yearly");
push @args, "$usewhat:$striped_var$num".$what->{$colours}[$num % @{$what->{$colours}}].":$label";
}
}
for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
{
for(my $j = 0; $j < @{$what->{$variables}}; $j++)
{
my $striped_var = $what->{$variables}[$j][0].$what->{$variables}[$j][1];
$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
my $num = (($i + 1) * ($j + 1)) - 1;
push @args, "LINE1:total_$striped_var$num".$what->{$linecolour};
}
}
#Calculating max point, average, last updated
my $peak = 0;
my $average = 0;
my $datapoints = 0;
my $peaktime = 0;
my $upperlimit = 0;
my $last_updated = 0;
my @start = ();
my @step = ();
my @names = ();
my @data = ();
my @do_these = ("AVERAGE");
@do_these = ("MAX", "AVERAGE") if($mode eq "yearly");
foreach my $selection (@do_these)
{
$average = 0;
$datapoints = 0;
$last_updated = 0;
@start = ();
@step = ();
@names = ();
@data = ();
for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
{
($start[$i],$step[$i],$names[$i],$data[$i])=RRDs::fetch($what->{$rrds}[$i],$selection, "--start", "-$timeslice"); # Get MAX points
}
next unless($data[0] && $start[0]);
for(my $i = 0; $i < @{$data[0]}; $i++) #go through values
{
my $tot_value = 0;
foreach my $diag (@data) #go through diagramms
{
for(my $j = 0; $j < @{$diag->[$i]}; $j++)
{
$tot_value += ${$diag}[$i][$j] if(${$diag}[$i][$j]);
}
}
if($tot_value >= $peak)
{
$peak = $tot_value;
$peaktime = $start[0];
}
if($tot_value > 0)
{
$datapoints++;
$average += $tot_value;
$last_updated = $start[0];
}
$start[0] += $step[0];
}
}
$peak=sprintf("%.f",$peak); # Round the connection number
$average=sprintf("%.f",$average/$datapoints) if($datapoints);
$average="0" unless($datapoints);
$upperlimit = sprintf("%.f",$peak*$whitespace);
push @args, "COMMENT:\\s";
push @args, "COMMENT:\\s";
push @args, "COMMENT:\\s";
if($peak && $peaktime)
{
push @args, "HRULE:$peak\#FF0000:User peak in the last ".readable_timeslice($timeslice, 1)."was";
push @args, "COMMENT:$peak on ".localtime($peaktime)."";
push @args, "COMMENT:\\s";
push @args, "COMMENT:\\s";
push @args, "COMMENT:\\s";
}
if($average)
{
push @args, "HRULE:$average\#1920e5:User average in the last ".readable_timeslice($timeslice, 1)."was";
push @args, "COMMENT:$average";
push @args, "COMMENT:\\s";
push @args, "COMMENT:\\s";
push @args, "COMMENT:\\s";
}
if($last_updated)
{
push @args, "COMMENT:Last update: ".localtime($last_updated)."\\r";
}
else
{
push @args, "COMMENT:Last update: No update yet\\r";
}
push @args, "--lower-limit=0";
push @args, "--upper-limit=$upperlimit";
RRDs::graph(@args); $ERR=RRDs::error; die "rrdtool graph @args failed: $ERR" if $ERR;
print "We did rrdtool graph @args\n" if($DEBUG);
}
}
@idletimes = reverse @idletimes;
}
if($DAEMONIZE)
{
daemonize();
$DAEMONIZE = 0;
}
sleep(120);
}
sub get_usercount # server, port, idletime greater or equal than n (seconds)
{
if(@_ != 3)
{
warn "Called get_usercount with wrong parameter count, aborting...\n";
return 0;
}
my $server = $_[0];
my $port = $_[1];
my $idle_time = $_[2];
$playerlist{$server.$port} = get_playerlist($server, $port) unless exists($playerlist{$server.$port});
return 0 if ($playerlist{$server.$port} == 0);
my $count = 0;
for(my $i = 0; $i < @{$playerlist{$server.$port}}; $i++)
{
$count++ if($playerlist{$server.$port}[$i][9] >= $idle_time); #9 == idle time
}
return $count;
}
sub get_playerlist
{
if(@_ != 2)
{
warn "Called getplayerlist with the wrong parameter count, aborting...\n";
return 0;
}
my $server = $_[0];
my $port = $_[1];
my $sock = Tcpquery::login($server, $port);
unless($sock)
{
warn "Couldnt connect to tcpredirect server\n";
return 0;
}
my $returnme = [ Tcpquery::getplayerlist($sock) ];
print $sock "quit\n";
return $returnme;
}
sub readable_timeslice
{
if(@_ < 1 || @_ > 2)
{
warn "Give readable_timeslice one argument, or two.\n";
return "0";
}
my $simple_output = 0;
$simple_output = 1 if(@_ == 2);
my $number = $_[0];
my $returnstring = "";
my $second = 1;
my $minute = 60 * $second;
my $hour = 60 * $minute;
my $day = 24 * $hour;
my $week = 7 * $day;
my $month = 30 * $day;
my $year = 12 * $month;
my $value = 0;
$value = ($number - ($number % $year)) / $year;
if($value > 1)
{
$returnstring = $returnstring . "$value years ";
$number = $number - $value * $year;
}
$value = ($number - ($number % $month)) / $month;
if($value > 1)
{
$returnstring = $returnstring . "$value months ";
$number = $number - $value * $month;
}
$value = ($number - ($number % $week)) / $week;
if($value > 1)
{
$returnstring = $returnstring . "$value weeks ";
$number = $number - $value * $week;
}
$value = ($number - ($number % $day)) / $day;
if($value > 1)
{
$returnstring = $returnstring . "$value days ";
$number = $number - $value * $day;
}
$value = ($number - ($number % $hour)) / $hour;
if($value > 1)
{
$returnstring = $returnstring . "$value hours ";
$number = $number - $value * $hour;
}
$value = ($number - ($number % $minute)) / $minute;
if($value > 1)
{
$returnstring = $returnstring . "$value minutes ";
$number = $number - $value * $minute;
}
$value = ($number - ($number % $second)) / $second;
if($value > 0)
{
$returnstring = $returnstring . "$value seconds ";
$number = $number - $value * $second;
}
if($simple_output)
{
if($returnstring =~ /^(\d+\s+\w+\s)/)
{
$returnstring = $1;
}
}
return $returnstring;
}
sub daemonize
{
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
defined(my $pid = fork) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}