#!/usr/bin/perl # # Copyright (C) 2007 Florian Schnabel # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; version 2 dated June, # 1991. # # 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. # # Capabilities # config # autoconf # # Config values # host [optional] # port [optional] # realm [optional] # user # pass # # You need to set up user credentials of a user with admin rights on the tracker. # # $Log$ # Revision 0.2 2007/02/22 19:40:00 fireba11 # added autoconf functionality # added config values # # Revision 0.1 2007/02/20 17:00:00 fireba11 # Created by fireba11 # # Magick markers (optional): #%# family=auto #%# capabilities=autoconf my $host = $ENV{'host'} || 'localhost'; my $port = $ENV{'port'} || '6969'; my $realm = $ENV{'realm'} || 'BNBT'; my $user = $ENV{'user'} || ''; my $pass = $ENV{'pass'} || ''; if ( defined $ARGV[0] and $ARGV[0] eq "config" ) { print "graph_title xbnbt peers\n"; print "graph_args --base 1000 -l 0\n"; print "graph_vlabel peers\n"; print "graph_category filetransfer\n"; print "peers.label peers\n"; print "seeds.label seeds\n"; print "leechers.label leechers\n"; print "unique.label unique\n"; exit 0; } use LWP; my $browser = LWP::UserAgent->new; $browser->credentials($host.':'.$port, $realm, $user => $pass); my $response = $browser->get('http://'.$host.':'.$port.'/xstats.html'); if ($response->content =~ /xpeerstats.*?odd">(\d*).*?even">(\d*).*?odd">(\d*).*?even">(\d*)/s) { $peers = $1; $seeds = $2; $leechers = $3; $unique = $4; } if ( defined $ARGV[0] and $ARGV[0] eq "autoconf") { if (! $response->is_success) { print 'no (Error: ', $response->header('WWW-Authenticate') || ' Error accessing', $response->status_line, ' at http://'.$host.':'.$port.'/xstats.html Aborting)'; } elsif (! defined $peers ) { print "no (Unable to find peer values within the page from the given URL.)"; } else { print "yes"; } exit 0; } print "peers.value ".$peers."\nseeds.value ". $seeds."\nleechers.value ". $leechers."\nunique.value ". $unique;