#!/usr/bin/perl -w # Tor router statistics script. (c)2012 Andy Dixon # Conceptual script for communicating with an exit router to pull stats # # 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, either version 3 of the License, or # (at your option) any later version. # # 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, see . use strict; use IO::Socket::INET; # Config our $address = "localhost"; # Default: localhost our $port = 9051; # Default: 9051 our $password = ''; # Password, if set our $cookieFileLocation = ''; # filename of cookie file, if used # Here be dragons my %connections = ("new", 0, "launched", 0, "connected", 0, "failed", 0, "closed", 0); sub Authenticate { my ($socket) = @_; my $authline = "AUTHENTICATE"; if (length($cookieFileLocation)>0) { if (open(COOKIE, "<$cookieFileLocation")) { binmode COOKIE; my $cookie; $authline .= " "; while (read(COOKIE, $cookie, 32)) { foreach my $byte (unpack "C*", $cookie) { $authline .= sprintf "%02x", $byte; } } close COOKIE; } } elsif (length($password)) { $authline .= ' "' . $password . '"'; } print $socket "$authline\r\n"; my $replyline = <$socket>; if (substr($replyline, 0, 1) != '2') { $replyline =~ s/\s*$//; return "Failed to authenticate: $replyline"; } return; } my $socket = IO::Socket::INET->new("$address:$port") or die("Couldn't connect to $address port $port: $!"); my $msg = Authenticate($socket); if (defined($msg)) { print $socket "QUIT\r\n"; close($socket); die "$msg\n"; } print $socket "GETINFO orconn-status\r\n"; my $replyline = <$socket>; if (substr($replyline, 0, 1) != '2') { print $socket "QUIT\r\n"; close($socket); $replyline =~ s/\s*$//; die "Failed to get status info: $replyline\n"; } while (! (($replyline = <$socket>) =~ /^\.\s*$/)) { my @reply = split(/\s+/, $replyline); $connections{lc($reply[1])}++; } $replyline = <$socket>; if (substr($replyline, 0, 1) != '2') { print $socket "QUIT\r\n"; close($socket); $replyline =~ s/\s*$//; die "Failed to authenticate: $replyline\n"; } print $socket "SETEVENTS bw\r\n"; $replyline = <$socket>; if (substr($replyline, 0, 1) != '2') { print $socket "QUIT\r\n"; close($socket); $replyline =~ s/\s*$//; die "Failed to get status info: $replyline\n"; } $replyline = <$socket>; if (substr($replyline, 0, 1) != '6') { print $socket "QUIT\r\n"; close($socket); $replyline =~ s/\s*$//; die "Failed to get bw: $replyline\n"; } my @reply = split(/\s+/, $replyline); print $socket "SETEVENTS\r\n"; $replyline = <$socket>; print $socket "QUIT\r\n"; close($socket); print "read: $reply[2] bytes/sec\n"; print "write: $reply[3] bytes/sec\n"; while (my ($status, $count) = each(%connections)) { print "$status connections: $count\n"; } exit 0; # vim:syntax=perl