3 # Peteris Krumins (peter@catonmat.net)
4 # http://www.catonmat.net -- good coders code, great reuse
6 # A simple TCP proxy that implements IP-based access control
7 # Currently the ports are hard-coded, and it proxies
8 # 0.0.0.0:1080 to localhost:55555.
10 # Written for the article "Turn any Linux computer into SOCKS5
11 # proxy in one command," which can be read here:
13 # http://www.catonmat.net/blog/linux-socks5-proxy
14 # https://github.com/pkrumins/perl-tcp-proxy/raw/master/tcp-proxy.pl
19 my ($from,$to) = @ARGV;
20 die "usage: $0 10.60.3.9:9100 10.60.3.10:9100\n" unless defined $from && defined $to && $from =~ m/:/ && $to =~ m/:/;
25 my @allowed_ips; # = ('127.0.0.1'); FIXME -- disabled IP check
26 my $ioset = IO::Select->new;
33 my $database = 'pGinaDB';
34 my $hostname = '10.60.4.9';
37 my $password = 'secret';
39 my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
40 my $dbh = DBI->connect($dsn, $user, $password);
44 my ($host, $port) = @_;
45 return IO::Socket::INET->new(
48 ) || die "Unable to connect to $host:$port: $!";
52 my ($host, $port) = @_;
53 my $server = IO::Socket::INET->new(
58 ) || die "Unable to listen on $host:$port: $!";
63 my $client = $server->accept;
64 my $client_ip = client_ip($client);
66 unless (client_allowed($client)) {
67 print "Connection from $client_ip denied.\n" if $debug;
71 print "Connection from $client_ip accepted.\n" if $debug;
73 my $remote = new_conn(split(/:/,$to));
77 $socket_map{$client} = $remote;
78 $socket_map{$remote} = $client;
81 sub close_connection {
83 my $client_ip = client_ip($client);
84 my $remote = $socket_map{$client};
86 $ioset->remove($client);
87 $ioset->remove($remote);
89 delete $socket_map{$client};
90 delete $socket_map{$remote};
95 print "Connection from $client_ip closed.\n" if $debug;
100 return inet_ntoa($client->sockaddr);
104 return 1 unless @allowed_ips;
106 my $client_ip = client_ip($client);
107 return grep { $_ eq $client_ip } @allowed_ips;
110 print "Starting a server on $from -> $to\n";
111 my $server = new_server(split(/:/,$from));
112 $ioset->add($server);
114 use Data::Dump qw(dump);
117 for my $socket ($ioset->can_read) {
118 if ($socket == $server) {
119 new_connection($server);
122 next unless exists $socket_map{$socket};
123 my $remote = $socket_map{$socket};
125 my $read = $socket->sysread($buffer, 4096);
127 warn "# ", inet_ntoa($socket->peeraddr), " buffer=", dump($buffer);
128 if ( $buffer =~ m/\n%%%SmartQ-For: (\w+)\n/s ) {
129 my $ip = inet_ntoa($socket->peeraddr);
130 warn "%%%SmartQ-For: $1 FROM $ip";
132 my $sth = $dbh->prepare(qq{
133 select * from pGinaSession where ipaddress = ? and logoutstamp is null order by loginstamp desc
134 }) or die "prepare statement failed: $dbh->errstr()";
135 $sth->execute($ip) or die "execution failed: $dbh->errstr()";
136 if ( $sth->rows < 1 ) {
137 die "can't find IP for job";
138 } elsif ( $sth->rows > 1 ) {
139 warn "ERROR: found $sth->rows() rows usng first one\n";
141 my $row = $sth->fetchrow_hashref();
142 warn "## row = ",dump($row);
146 my $username = $row->{username} || die "no username in row = ",dump($row);
147 $username =~ s/\@ffzg.hr$//; # strip domain, same as pGina
148 $username .= '@ffzg.hr';
150 $buffer =~ s/(\n%%%SmartQ-For: )(\w+)(\n)/$1$username$3/s || die "can't replace user with $username";
153 $remote->syswrite($buffer);
156 close_connection($socket);