#!/usr/bin/perl
#
# Peteris Krumins (peter@catonmat.net)
# http://www.catonmat.net  --  good coders code, great reuse
#
# A simple TCP proxy that implements IP-based access control
# Currently the ports are hard-coded, and it proxies
# 0.0.0.0:1080 to localhost:55555.
#
# Written for the article "Turn any Linux computer into SOCKS5
# proxy in one command," which can be read here:
#
# http://www.catonmat.net/blog/linux-socks5-proxy
# https://github.com/pkrumins/perl-tcp-proxy/raw/master/tcp-proxy.pl

use warnings;
use strict;

my ($from,$to) = @ARGV;
die "usage: $0 10.60.3.9:9100 10.60.3.10:9100\n" unless defined $from && defined $to && $from =~ m/:/ && $to =~ m/:/;

use IO::Socket;
use IO::Select;

my @allowed_ips; # = ('127.0.0.1'); FIXME -- disabled IP check
my $ioset = IO::Select->new;
my %socket_map;

my $debug = $ENV{DEBUG} || 0;

use DBI;

my $database = $ENV{PGINA_DB}   || 'pGinaDB';
my $hostname = $ENV{PGINA_HOST} || '10.60.4.9';
my $port     = $ENV{PGINA_PORT} || 3306;
my $user     = $ENV{PGINA_USER} || 'pGina';
my $password = $ENV{PGINA_PASS} || 'secret';

my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
my $dbh = DBI->connect($dsn, $user, $password);


sub new_conn {
    my ($host, $port) = @_;
    return IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => $port
    ) || die "Unable to connect to $host:$port: $!";
}

sub new_server {
    my ($host, $port) = @_;
    my $server = IO::Socket::INET->new(
        LocalAddr => $host,
        LocalPort => $port,
        ReuseAddr => 1,
        Listen    => 100
    ) || die "Unable to listen on $host:$port: $!";
}

sub new_connection {
    my $server = shift;
    my $client = $server->accept;
    my $client_ip = client_ip($client);

    unless (client_allowed($client)) {
        print "Connection from $client_ip denied.\n" if $debug;
        $client->close;
        return;
    }
    print "Connection from $client_ip accepted.\n" if $debug;

    my $remote = new_conn(split(/:/,$to));
    $ioset->add($client);
    $ioset->add($remote);

    $socket_map{$client} = $remote;
    $socket_map{$remote} = $client;
}

sub close_connection {
    my $client = shift;
    my $client_ip = client_ip($client);
    my $remote = $socket_map{$client};
    
    $ioset->remove($client);
    $ioset->remove($remote);

    delete $socket_map{$client};
    delete $socket_map{$remote};

    $client->close;
    $remote->close;

    print "Connection from $client_ip closed.\n" if $debug;
}

sub client_ip {
    my $client = shift;
    return inet_ntoa($client->sockaddr);
}

sub client_allowed {
	return 1 unless @allowed_ips;
    my $client = shift;
    my $client_ip = client_ip($client);
    return grep { $_ eq $client_ip } @allowed_ips;
}

print "Starting a server on $from -> $to\n";
my $server = new_server(split(/:/,$from));
$ioset->add($server);

use Data::Dump qw(dump);

while (1) {
    for my $socket ($ioset->can_read) {
        if ($socket == $server) {
            new_connection($server);
        }
        else {
            next unless exists $socket_map{$socket};
            my $remote = $socket_map{$socket};
            my $buffer;
            my $read = $socket->sysread($buffer, 4096);
            if ($read) {
		warn "# ", inet_ntoa($socket->peeraddr), " buffer=", dump($buffer) if $debug;
		if ( $buffer =~ m/\n%%%SmartQ-For: (\w+)\n/s ) {
			my $win_username = $1;
			my $ip = inet_ntoa($socket->peeraddr);

			my $sth = $dbh->prepare(qq{
				select * from pGinaSession where ipaddress = ? and logoutstamp is null order by loginstamp desc
			}) or die "prepare statement failed: $dbh->errstr()";
			$sth->execute($ip) or die "execution failed: $dbh->errstr()";
			if ( $sth->rows < 1 ) {
				die "can't find IP for job";
			} elsif ( $sth->rows > 1 ) {
				warn "ERROR: found $sth->rows() rows usng first one\n";
			}
			my $row = $sth->fetchrow_hashref();
			warn "## row = ",dump($row) if $debug;

			$sth->finish;

			my $username = $row->{username} || die "no username in row = ",dump($row);
			$username =~ s/\@ffzg.hr$//; # strip domain, same as pGina
			$username .= '@ffzg.hr';

			$buffer =~ s/(\n%%%SmartQ-For: )(\w+)(\n)/$1$username$3/s || die "can't replace user with $username";

			warn "%%%SmartQ-For: $win_username FROM $ip is $username";
		}
                $remote->syswrite($buffer);
            }
            else {
                close_connection($socket);
            }
        }
    }
}

