mitm proxy which rewrites user from pGina session data

diff --git a/safeq-pGina-proxy.pl b/safeq-pGina-proxy.pl
new file mode 100755 (executable)
index 0000000..1ac717f
--- /dev/null
+++ b/safeq-pGina-proxy.pl
@@ -0,0 +1,161 @@
+#!/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 = 1;
+
+use DBI;
+
+my $database = 'pGinaDB';
+my $hostname = '10.60.4.9';
+my $port     = 3306;
+my $user     = 'pGina';
+my $password = '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 ( $buffer =~ m/\n%%%SmartQ-For: (\w+)\n/s ) {
+                       my $ip = inet_ntoa($socket->peeraddr);
+                       warn "%%%SmartQ-For: $1 FROM $ip";
+
+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);
+
+$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";
+
+               }
+                $remote->syswrite($buffer);
+            }
+            else {
+                close_connection($socket);
+            }
+        }
+    }
+}
+