#!/usr/bin/perl -I/usr/depot/lib/perl5
#
# remote control for Tor: the remoTor!
#	--symlynX 2016
#
# + produce and receive Tor events over the ControlPort
# + forward important messages into a chatroom via PSYC
# + interact with the user over the terminal console

my $host = '127.0.0.1';	    # defaults to try
my $port = 9051;
my $circ = 1;		    # request real-time circuit activity by default?

sub version() { "1.2.1" }

#  0: all debug statements will be optimized away by the perl compiler
#  1: debug Tor control
#  2: debug STDIN
#  4: debug PSYC
#  8: debug Tor log pipe
# 16: debug config parsing
# 32: debug Tor control socket
# 63: full debugging
sub debug() { 0 }

# if PSYC is enabled, should remotor really join the chatroom,
# thus receive ongoing chat directly rather than just manually?
sub chat() { 1 }

use IO::Socket;
use POSIX qw( mkfifo );			# optional, for -s option
use Pod::Usage qw( pod2usage );
use Term::ANSIColor qw( :constants );	# optional but pervasive
use Net::PSYC qw( :event );		# needed for event loop
use Getopt::Std qw( getopt );
getopt('bcilmptHPS');

my $bind = $opt_b || "psyc://$ENV{USER}\@127.0.0.1:4051/\$remotor";
my $ini = $opt_c || "$ENV{HOME}/.tor/remotor.ini";

my $torctrl = undef;
my $torlog = undef;
my $torsock = undef;
my $logpipe = undef;
my $lastsend = undef;
my $quitting = 0;
my $target;
my $nick;
my $log = undef;
my %config;
my %pv;


## SANDWICHES ##

sub say {
	print BOLD, GREEN, @_, RESET, "\n";
}

sub reallyquit { exit; }
sub quit {
	# error condition can be triggered several times
	return if $quitting++;
	tellpsyc(chat? "_request_leave_remotor": "_notice_stopping_remotor", "[_command] stopping on [_nick].");
	tellpsyc("_request_circuit_shutdown", "Seeyasoon.");
	add(2, 't', \&reallyquit);
}

sub tellpsyc {
	my ($mc, $text, $var, $value) = @_;
	# my %v = $value? { $var => $value } : %pv;
	# $pv{_nick} = $nick;
	say "tellpsyc: ", $text if debug & 4;
	return unless $target;
	if (length $text > 404) {
		$mc = "_error_excessive_data$mc";
		$text = "[_amount_data] bytes of excess data ignored. Check remotor console.";
		$var = "_amount_data";
		$value = length $text;
	}
	sendmsg($target, $mc, $text, $value? { $var => $value } : \%pv);
}

sub terror {
	return if $quitting;
	my $msg = "Error on the Tor control socket. $_";
	say $msg;
	tellpsyc('_notice_warning_remotor', $msg);
	return &quit;
}

sub torparse {
	$_ = <$torsock>;
	say "torparse($!): $_" if debug & 1;
	chop; chop;
	terror unless $_;
	return if $_ eq '510 Unrecognized command ""';
	# we're not vidalia.. let's just show built circuits
	return if /^650 CIRC \d+ (LAUNCHED|EXTENDED)/;
	s/ TIME_CREATED=\S+\b//;    # too much information
	s/ SOCKS_PASSWORD="0"//;    # not interesting
	s/ PURPOSE=GENERAL\b//;	    # only show ungeneral purposes
	s/\bPURPOSE=(\S+)\b/ GREEN. $1 .RESET /e;
	s/\bBUILD_FLAGS=(\S+)\b/ BLUE. $1 .RESET /e;
	s/\bREND_QUERY=(\S+)\b/ CYAN. $1 .RESET /e;
	s/\bHS_STATE=\b//;
	# let it be human readable
	s/IS_INTERNAL\b/i/;
	s/ONEHOP_TUNNEL\b/o/;
	s/NEED_CAPACITY\b/c/;
	s/NEED_UPTIME\b/u/;
	s/\$\w+~(\w+)\b/ MAGENTA. $1 .RESET /ge;
	print YELLOW, $_, RESET, "\n";
	tellpsyc('_notice_warning_remotor', $_) if
	    /(FAIL|ERROR|DESTROY|SIGNAL|DANGER|LIVENESS|HIBERNATION|TRANSPORT|GUARD|BAD|HIJACKED|USELESS|UNREACHABLE|CLOCK|BUG|TOO_MANY)\b/;
	print $log "> $_\n" if $log;
	print $torsock "\n";
}

sub torlogparse {
	$_ = <$logpipe>;
	chop; chomp;
	if ( / \[debug\] / ) {
		return unless / \{APP\} connection_ap_handshake_rewrite... Client asked for (\S+)$/;
		print CYAN, "Request for $1", RESET, "\n";
		tellpsyc('_notice_monitor_remotor',
			 'Request for [_address_web]',
			 '_address_web', $1) if $opt_f;
		return;
	} elsif ( / \[info\] / ) {
		say "torlogparse: $_" if debug & 8;
		return;
	} elsif ( / \[(\w+)\] (.+)/ ) {
		# catch when Tor yields repeated identical messages
		return if $2 eq $lastsend;
		# we don't send *real* PSYC warnings or errors because that would confuse
		# PSYC signaling and gets dumped by the place to avoid potential loops.
		my $mc = $1 eq 'err'? '_notice_error': $1 eq 'warn'? '_notice_warning': '_notice';
		tellpsyc($mc . '_remotor', $lastsend = $2);
		# fall thru
	}
	say $_;
}

sub keyparse {
	$_ = <STDIN>;
	say "keyparse: ", $_ if debug & 2;
	return &quit if /^\s*q\s*$/i;
	return system('/usr/bin/clear') if /^\.$/;
		# should be _converse
	return tellpsyc("_message_public", $1) if m!^\s*/\s+(.*\S.*)$!;
	return unless $torsock;
	return &circtoggle if /^\s*t\s*$/i;
	s/^\s*n\s*$/SIGNAL NEWNYM\n/i;
	s/^\s*c\s*$/GETINFO circuit-status\n/i;
	s/^\s*s\s*$/GETINFO stream-status\n/i;
	s/^\s*g\s*$/GETINFO entry-guards\n/i;
	if ( /^\s*(\S|help)\s*$/i ) {
		print <<X;
	*** Available shortcuts:
	    'q'		to quit
	    'n'		for a new identity
	    'c'		to see the circuit-status
	    's'		to see the stream-status
	    't'		to toggle delivery of circuit events
	    'g'		for the list of entry guards
	    '/ <msg>'	to send a message to the PSYC channel
	    '.'		to clear the screen
X
		return;
	}
	print $torsock $_;
	print $log "<<< $_" if $log;
}

sub circtoggle {
	my $c = "SETEVENTS STATUS_CLIENT STATUS_GENERAL STATUS_SERVER";
	$c .= " CIRC" if $circ;	    # CIRC is pretty verbose
	print $torsock $c, "\n";
	$circ = 1 - $circ;
}

sub msg {
	my ($source, $mc, $data, $vars) = @_;
	say "psyc: $mc from $source" if debug & 4;
	if ($mc =~ /^_(message|converse)/) {
		# message echo will pass through here. legitimate users of
		# your PSYC server can send a message back to the localhost
		# process, so you may see an answer from somebody.
		if (exists $vars->{_nick}) {
			$_ = "<". $vars->{_nick} ."> ". YELLOW . $data;
		} else {
			$_ = "(". $source .") ". YELLOW . $data;
		}
	} elsif (chat and $mc =~ /^_notice.*_remotor/) {
		return;	# do not display our own notices
	} else {
		$_ = psyctext($data, $vars);
	}
	print BOLD, MAGENTA, $_, RESET, "\n";
}

# simple .ini file format parser taken from psyconf
sub iniparse {
	my $cf = shift;
	my $f = "default";
	open C, $cf;
	while(<C>) {
		next if /^;/;
		next if /^\s*$/;
		$f = $1, next if /^\[(\w+)\]\s*$/;
		$config{"$f:$1"} = $2, next
		    if /^(\w+)\s*=\s*(.+?)\s*$/;
		die "cannot parse line $. in $cf\n\t$_\n";
	}
	close C;
	say join ' ', keys %config if debug & 16;
}

sub idlebilly {
	print $torsock "GETINFO stream-status\n";
}


## MAIN ###

	say "remoTor ", version, " - a console-based Tor controller and log analyzer with PSYC notification";
	$nick = shift || 'default';
	$pv{_nick} = $nick;
	$pv{_command} = $0;
	bind_uniform( $bind );
	register_uniform();
	say "Listening for PSYC controls on $bind";

	$|=1;
	&iniparse($ini);
	$host = $1 if $ENV{http_proxy} =~ m!^http://(\S+):\d+$!;
	$host = $1 if $ENV{HTTP_PROXY} =~ m!^http://(\S+):\d+$!;
	$host = $1 if $ENV{SOCKS_PROXY} =~ m!^socks://(\S+):\d+$!;
	$host = $config{"$nick:host"} if $config{"$nick:host"};
	$port = $config{"$nick:port"} if $config{"$nick:port"};
	$host = $opt_H if $opt_H;
	$port = $opt_P if $opt_P;
	$target = $opt_t || $config{"$nick:notify"}
			 || $config{"default:notify"};

	my $auth = $config{"$nick:auth"};
	$auth = $opt_p if $opt_p;
	if (not $auth and open A, "$ENV{HOME}/.tor/control_auth_cookie") {
		local $/ = undef;
		$auth = <A>;
		close A;
		say "Picked up a cookie of length ", length($auth) if debug;
	}

	$opt_m = $config{"$nick:monitor"} if !$opt_m and $config{"$nick:monitor"};
	$torlog = $opt_m || "/var/run/tor/log.fifo";
	if (($opt_m || $opt_f) and not -p $torlog) {
		undef $!;
		die "Could not mkfifo $torlog: $!" unless mkfifo $torlog, 0600;
		system('chgrp', 'tor', $torlog);
		chmod 0660, $torlog;
	} elsif (not -p $torlog) {
		say "No fifo pipe found at $torlog" if $opt_f or debug & 8;
		undef $torlog;
	}
	if ($torlog) {
		say "Monitoring $torlog for Tor events";
		if (open($logpipe, $torlog)) {
			add($logpipe, 'r', \&torlogparse);
		} else {
			warn "Cannot read from $torlog: $!";
			undef $torlog;
		}
	}

	if ($opt_h or !$auth && !$torlog) {
		print <<X;

Is $host:$port the host and port your Tor router answers on?

X
		pod2usage;
	}

	$torctrl = $opt_S || "/var/run/tor/control.sock";
	if ($opt_S and not -p $torctrl) {
		die "There is no Tor control socket at $torctrl";
	} elsif (not -S $torctrl) {
		say "No unix socket found at $torctrl" if debug & 32;
		undef $torctrl;
	}
	if ($torctrl and $opt_S) {  # FIXME.. remove and $opt_S
		die "Could not connect to $torctrl: $!"
		  unless $torsock = IO::Socket::UNIX->new(
		    Type => SOCK_STREAM(),
		    Peer => $torctrl
		);
		say "Connected to control socket at $torctrl";
	} elsif ($auth) {
		say "Trying to connect Tor router at $host:$port";
		$torsock = IO::Socket::INET->new( Proto => 'tcp',
						  PeerAddr => $host,
						  PeerPort => $port);
		die "Could not connect to $host:$port: $!" unless $torsock;
		say "Connected to ControlPort at $host:$port";
	}
	if ($torsock) {
		add($torsock, 'r', \&torparse);
		add($torsock, 'e', \&terror);
		print GREEN, "Taking Tor commands from STDIN. Type '?' for a list of shortcuts\n", RESET;
		print GREEN, "See also https://gitweb.torproject.org/torspec.git/plain/control-spec.txt\n", RESET;
		$auth = unpack("H*", $auth); # hex encoding
		say "Authenticating using '$auth'" if debug & 1;
		print $torsock <<X;
AUTHENTICATE $auth
USEFEATURE EXTENDED_EVENTS VERBOSE_NAMES
GETINFO stream-status
X
		&circtoggle;
	}
	die "Cannot write to $opt_l: $!"
	    if $opt_l and not open($log, '>>', $opt_l);
	print $log "\n\n\n\n\n*** New session ***\n\n" if $log;

	add(\*STDIN, 'r', \&keyparse);
	add($opt_i, 'i', \&idlebilly) if $opt_i;
	tellpsyc(chat? "_request_enter_remotor": "_notice_starting_remotor", "[_command] starting on [_nick].");
	start_loop();
	exit;

__END__

=pod

=head1 NAME

remoTor - a console-based Tor controller and log analyzer with PSYC notification

=head1 SYNOPSIS

 remotor [<options>] [<nickname>]
 
 Options:
	 -p <password>	Authentication string needed to take control
	 -H <host>	Tor router host
	 -P <port>	Tor router control port
	 -S <path>	connect to the Tor control unix Socket instead
	 -l <logfile>	Keep a transaction log
	 -i <seconds>	Request a stream status if idle for a while
	 -m <path>	Monitor a logging pipe for interesting Tor events
	 -f		Forward circuit creation requests to PSYC
	 -c <config>	Alternate configuration file to use
	 -t <uniform>	PSYC address to send notifications to
	 -b <uniform>	PSYC address to bind to
 
 <nickname> matches an entry from the <config> file.

=head1 DESCRIPTION

Here's a little console-based perl script that lets you control
your Tor process, monitor circuits as they happen, issue commands
like changing your identity and such.

I found vidalia too heavy and arm too confusing and didn't see 
a simple tool that would leverage the Tor control protocol
without excessive nuisances, just a bit of noise reduction and
text coloring.

=head2 Monitoring outgoing connections

When remotor is running on the same machine as tor, it can
additionally monitor the hostnames the tor process is building
circuits for. You may want to do this if you have devices in
your house that you don't trust, for example. The regular Tor
control protocol doesn't let you have this information other
than by continously polling the stream status, and even then
you may miss out on some short exfiltration going on. remotor
lets you have this information and even lets you study it later
rather than having to keep your eyes on the control console
all the time.

=head2 Forwarding messages to a chatroom

remotor can forward critical Tor events to a chatroom using
the PSYC protocol. With an advanced server such as psyced
you can use a regular IRC client to view the messages, but
you can also use a simple 'psyclisten' as provided with the
Net::PSYC library. Let it run and pass its bind address to
remotor using the '-t' flag.

psyced comes with a "remotor" place which is preset to 
receive messages from this tool, all you need to do is 
install psyced and use your IRC client to join #remotor.

remotor can also forward host monitoring, if you enabled that.
Additionally a person at the remotor console can interact with
the people in the chatroom using the built-in chat.

Be careful when you use other IP addresses than localhost since
Net::PSYC does not encrypt its packets. You may want to learn
about SSH port forwarding, gnunet-vpn, cjdns or other tunneling 
strategies.

=head1 CONFIGURATION

You may want to persist certain configuration settings or
keep separate configurations for different Tor routers.
The default config file resides in ~/.tor/remotor.ini.
Here's an example for the ini syntax in use:

	[default]
	host=192.168.0.1
	port=9051
	auth=somesecretrandomstring
	notify=psyc://127.0.0.1/@remotor
	monitor=/var/run/tor/log.fifo

The configuration file is a safer place to store authentication
strings than the command line which can be read by other users
of the computing device (in case you have any). The 'default'
entry will be used unless you specify a nickname.

=head1 OPTIONS

=head2 Monitoring outgoing connections

remotor can additionally monitor the debug log of the Tor process
using the -s and/or -f flags. In this case remotor needs to be
running on the same system as the Tor router. In the torrc you
need to modify the logging parameters as follows:

	SafeLogging relay
	LogMessageDomains 1
	Log [app]debug-debug file /var/run/tor/log.fifo
	Log           notice file /var/run/tor/log.fifo

You can use a different path and pass it using -s. remotor will 
attempt to mkfifo the necessary pipe if it is missing, so run
remotor *before* you restart tor.

=head1 AUTHORS

carlo von lynX.

=head1 COPYRIGHT

This program is free software, published under the Affero GNU Public
License. A disclaimer isn't necessary in my country, nor do I need
to mention the current year to assert a copyright.