#!/usr/bin/perl

use strict;
use warnings;
use Dancer2;
use Socket;
use DBI;
use File::Fetch;
use PerlIO::gzip;
use HTTP::Tiny;
use HTTP::Request;
use Data::Validate::IP qw(is_ipv4);
use Data::Dumper;


###  README  #########################################################################################################################################
# This is the server for the XTR (XiCoN Trace Route). It's more of a master browser for the clients, so an web frontend can get a list of all the
# available clients combined from one auto-updated source. It opens a port and listening to HTTP requests (GET and PUT). It can list all online and
# offline clients. It also accepts new client entries via a PUT request (target client address in database has to be the request ip). 
# 
# The server keeps the list of clients up2date with checking their availablity with each request of all online clients.
#
# This software uses the iptoasn database (https://iptoasn.com/) to determine the AS for each client. To keep track of all ip to asn relations,
# this software creates a local database file "ip2asn.db", which is a simple SQLite3 database with an index for faster searches.
#
# For now, only IPv4 clients are supported. This will change in the future.
######################################################################################################################################################


###  CHANGELOG  ######################################################################################################################################
# v0.4 (2019-08-22)
#      * ADD: added better documentation
#      * ADD: list of API commands via API
#      * FIX: replaced bug-driven LWP::* with HTTP::Tiny
#      * FIX: limited adding of clients to source ip of target entry (only add a client which you are coming from)
######################################################################################################################################################


###  INSTALL  ########################################################################################################################################
# This is a standalone software which usually runs in the "foreground". Starting it in a screen session or via init.d/systemd/rc.d is
# highly recommended. For testing, starting this script in a screen session is also fine.
#
# Either install all listed modules with "cpan -i <module>" or use your system's package manager (apt, yum, yast).
# 
# On Debian just install there packages:
#  libperlio-gzip-perl
#  libdancer2-perl
#  libdbi-perl
#  libdbd-sqlite3-perl
#  libdata-validate-ip-perl
#
######################################################################################################################################################


### VARS #############################################################################################################################################
my $dbfile                      = 'xtrd.db';
my $ip2asn_csv_url              = 'http://iptoasn.com/data/ip2asn-v4-u32.tsv.gz';
my $server_protocol_version     = 3;
my $min_client_version          = 4;
set port                        => 12110;
######################################################################################################################################################














######################################################################################################################################################
###  NOTHING TO CHANGE BELOW HERE  ###################################################################################################################
######################################################################################################################################################

### connect to database
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","");
$dbh->do("PRAGMA cache_size = 800000");

### create ip2asn database & table if needed and fill with ip information
if(create_db_table($dbh,"ip2asn","ip2asn( ip_from INTEGER, ip_to INTEGER, ip_as INTEGER)","ip2asnIndex ON ip2asn(ip_from,ip_to);"))
{
	get_ipas_data($dbh,$ip2asn_csv_url);
}

### create server database & table if needed
create_db_table($dbh,"server","server( server_ip TEXT, server_port INTEGER, server_as INTEGER, server_status INTEGER)","");



### hook for HTTP "security"
hook 'before' => sub {
    header 'Access-Control-Allow-Origin' => '*';
};

### main get route
get '/v3/server/list/online' => sub {
	refresh_server_status($dbh,"1");
	my $server = get_server($dbh,"1");
	return encode_json $server;
};

get '/v3/server/list/offline' => sub {
	my $server = get_server($dbh,"0");
	return encode_json $server;
};

get '/v3/server/list/all' => sub {
	my $server = get_server($dbh,"");
	return encode_json $server;
};

get '/v3/server/info/version' => sub {
	return $server_protocol_version;
};

get '/v3/server/info/commands' => sub {
	my $commands = "/v".$server_protocol_version."/server/list/online\n";
	$commands   .= "/v".$server_protocol_version."/server/list/offline\n";
	$commands   .= "/v".$server_protocol_version."/server/list/all\n";
	$commands   .= "/v".$server_protocol_version."/server/add/<ip>/<port>/<state>\n";
	$commands   .= "/v".$server_protocol_version."/server/info/version\n";
	$commands   .= "/v".$server_protocol_version."/server/info/commands\n";
	return $commands;
};

put '/v3/server/add/:ip/:port/:state' => sub {
	### collect parameters
	my $ip = route_parameters->get('ip');
	my $port = route_parameters->get('port');
	my $state = route_parameters->get('state');

	### get client ip
	my $client_ip = request->address;
	my $request_ffa = request->forwarded_for_address;
	if(is_ipv4($request_ffa)) { $client_ip = $request_ffa; }
	
	### check input
	if(!is_ipv4($ip) || $client_ip ne $ip) { status('bad_request'); return "invalid IP address"; }
	if(!($port > 0 and $port < 65536)) { status('bad_request'); return "invalid port"; }
	if(!($state >= 0 and $state < 256)) { status('bad_request'); return "invalid status"; }

	my $result = add_server($dbh,$ip,$port,$state);
	return "OK";
};

### start the loop
start;

### if you reach this, you're done
exit;

sub check_server_status
{
	my ($hostname,$port) = @_;
	my $url = "http://".$hostname.":".$port."/v3/client/info/version";
	my $httptiny = HTTP::Tiny->new("timeout" => 2);
	my $response = $httptiny->request("GET",$url);
	my @return_code = ($response->{'success'}, $response->{'content'});
	return @return_code;
}

sub add_server
{
	my ($dbh,$ip,$port,$status) = @_;
	my $id = get_server_id($dbh,$ip,$port);
	if($id ne "0")
	{
		# update server status
		set_server_status($dbh,$id,$status);
	}
	else
	{
		# create
		my $resolve = gethostbyname($ip);
		my $a_record = inet_ntoa($resolve);
		my $as = find_as($dbh,$a_record);
		my $add_server_cmd = "INSERT INTO server VALUES ('".$ip."','".$port."','".$as."','".$status."');";
		my $add_server_sth = $dbh->prepare($add_server_cmd);
		$add_server_sth->execute();
	}
}

sub set_server_status
{
	my ($dbh,$id,$status) = @_;
	
	my $set_status_cmd = "UPDATE server set server_status = '".$status."' WHERE _rowid_ = '".$id."';";
	my $set_status_sth = $dbh->prepare($set_status_cmd);
	$set_status_sth->execute();
}

sub get_server_id
{
	my ($dbh,$ip,$port) = @_;

	my $get_id_cmd = "SELECT _rowid_ FROM server WHERE server_ip = '".$ip."' AND server_port = '".$port."';";
	my $get_id_sth = $dbh->prepare($get_id_cmd);
	$get_id_sth->execute();
	my $result = $get_id_sth->fetch;
	return $result->[0] || 0;
}

sub refresh_server_status
{
	my ($dbh,$status) = @_;
	my $temp_data = get_server($dbh,$status);

	### check all servers and update status
	foreach my $item (@$temp_data)
	{
		my ($success,$version) = check_server_status($item->[0],$item->[1]);
		if($success)
		{
			if($version >= $min_client_version)
			{
				my $id = get_server_id($dbh, $item->[0],$item->[1]);
				set_server_status($dbh, $id, "1");
			}
			else
			{
				my $id = get_server_id($dbh, $item->[0],$item->[1]);
				set_server_status($dbh, $id, "0");
			}
		}
		else
		{
			my $id = get_server_id($dbh, $item->[0],$item->[1]);
			set_server_status($dbh, $id, "0");
		}
	}
}

sub get_server
{
	my ($dbh,$status) = @_;

	my $get_server_cmd = "";

	if($status eq "")
	{
		$get_server_cmd = "SELECT * FROM server;";
	}
	else
	{
		$get_server_cmd = "SELECT * FROM server WHERE server_status = '".$status."';";
	}
	
	my $get_server_sth = $dbh->prepare($get_server_cmd);
	$get_server_sth->execute();
	my $result = $get_server_sth->fetchall_arrayref;

	return $result;
}

sub get_ipas_data
{
	my ($dbh,$ip2asn_csv_url) = @_;

	my $ff = File::Fetch->new(uri => $ip2asn_csv_url);
	my $temp_file = $ff->fetch( to => '/tmp' );

	open(FILE,"<:gzip",$temp_file) or die "Can't open file: $!";
	my @data = <FILE>;
	close(FILE);

	$dbh->do('begin');

	my $max_commit  = 10000;
	my $inserted    = 0;
	my $array_size  = @data;
	my $last_p      = -1;
	print "loading data...\n";
	foreach my $line (@data)
	{
		chomp($line);
		if($line=~/^(\d+)\s+(\d+)\s+(\d+)/)
		{
			if($3 eq "0") { next; }
			#my %temp_hash = ('from' => $1, 'to' => $2, 'as' => $3);
			#push(@ipaslist,\%temp_hash);
			my $insert_cmd .= "INSERT INTO ip2asn VALUES ('".$1."','".$2."','".$3."');";
			my $insert_sth = $dbh->prepare($insert_cmd);
			$inserted += $insert_sth->execute();
			
			# print status for console users
			my $p = int($inserted * 100 / $array_size);
			if($p != $last_p) { print $p % 10 ? "" : "$p%\n"; }
			$last_p = $p;

			# only commit every $max_commit statements (it's faster)	
			unless ($inserted % $max_commit)
			{
				$dbh->do('commit');
				$dbh->do('begin');
			}
		}
	}

	$dbh->do('commit');
	unlink($temp_file);
	print "data prepared for searches!\n";
}

sub find_as
{
	my ($dbh, $ip) = @_;
	my $ip_id = unpack("N", inet_aton($ip));

	my $get_as_cmd = "SELECT ip_as FROM ip2asn WHERE ip_from < '".$ip_id."' AND ip_to > '".$ip_id."';";
	my $get_as_sth = $dbh->prepare($get_as_cmd);
	$get_as_sth->execute();
	my $result = $get_as_sth->fetch;
	return $result->[0] || 0;
}

sub create_db_table
{
	my ($dbh,$table,$schema,$schema_index) = @_;

	my $check_table_cmd = "SELECT name FROM sqlite_master WHERE type='table' AND name='".$table."';";
	my $check_table_sth = $dbh->prepare($check_table_cmd);
	$check_table_sth->execute();
	if(!$check_table_sth->fetch)
	{
		print "creating table '".$table."'...\n";
		my $create_table_cmd = "CREATE TABLE ".$schema;
		my $create_table_sth = $dbh->prepare($create_table_cmd);
		$create_table_sth->execute();
		if($schema_index ne "")
		{
			my $create_index_cmd = "CREATE INDEX ".$schema_index;
			my $create_index_sth = $dbh->prepare($create_index_cmd);
			$create_index_sth->execute();
		}
		return 1;
	}
	else
	{
		return 0;
	}
}