Something

# proxy.pl
# honeyclient proxy engine
# Copyright (c) 2004-2005 Kathy Wang <knwang@synacklabs.net>

# proxy.pl opens two sockets, one of which is listening for IE requests,
# and the other is receiving traffic from the remote webserver. proxy.pl
# does not do anything beyond parse out URLs from the remote server and
# save those URLs as external and internal URLs in hash tables.
# proxy.pl and driver.pl communicate with each other through files, namely
# domainfile. 

#!/usr/bin/perl 
use strict;
use Socket;
use IO::Select;
use IO::Socket;
use Net::hostent;
use HTML::LinkExtor;
use Carp;

my $intfile = "intfile";
my $extfile = "extfile";
my $domainfile = "domainfile";
my $donefile = "donefile";
my $proxydonefile = "proxydone";
my $timeout = 10;

my @intlinks = ();
my @extlinks = ();

# my $remote_addr = shift || 'localhost';
my $remote_port = shift || 6768;

my $local_port = 6768;
my $proto = getprotobyname('tcp');
my $local_iaddr = INADDR_ANY;
my $local_paddr = sockaddr_in($local_port, $local_iaddr);
my $remote_paddr;
my $baseurl;

my $done = 0;

# print "Heading into loooooooooop\n";

while(!$done) {

# If domainfile is populated with URL, then open listening and remote sockets.
# Listening socket listens for traffic from IE, and remote socket listens for
# traffic from remote webserver.

    if (-f $domainfile) {
	open DOMAIN, "$domainfile" or die "Could not open $domainfile: $!\n";
	
	my $remote = <DOMAIN>;
	chomp $remote;
	close(DOMAIN);
	unlink $domainfile;
	my $remote_iaddr = inet_aton($remote);
	if($remote_iaddr) {
	    $remote_paddr = sockaddr_in($remote_port, $remote_iaddr);
	    
	    my $server = IO::Socket::INET->new( Proto     => 'tcp',
						LocalPort => $local_port,
						Listen    => SOMAXCONN,
						Reuse     => 1);
	    
	    
	    $baseurl = $remote;
	    my $local_socket = $server->accept();
	    proxyrun($local_socket);
	    close($local_socket);
	} else {
	    print "Proxy did not detect address for $remote\n";
	    open INTFILE, ">$intfile" or die "Cannot open $intfile: $!\n";
	    print INTFILE "\n";
	    close INTFILE;
	    open EXTFILE, ">$extfile" or die "Cannot open $extfile: $!\n";
	    print EXTFILE "\n";
	    close EXTFILE;
	    open PROXYDONE, ">$proxydonefile" or die "Cannot open $proxydonefile: $!\n";
	    print PROXYDONE "Done!\n";
	    close PROXYDONE;
	}
    }
    if(-f $donefile) {
	$done = 1;
    }

# Process sleeps for one second before checking whether domainfile is
# populated. If not, then sleep for another second, then check again, etc

    sleep(1);
}

# This subroutine writes all internal URLs to intfile, and all external
# links to extfile when proxy times out, which is currently set to 5 secs.

sub proxycomplete {
    my $self = shift;
#   print "Completing!\n";
    open INTFILE, ">$intfile" or die "Cannot open $intfile: $!\n";
    foreach my $value (@intlinks) {
	print INTFILE "$value\n";
#	print "INTFILE $value\n";
    }
    print INTFILE "\n";
    close INTFILE;
    open EXTFILE, ">$extfile" or die "Cannot open $extfile: $!\n";
    foreach my $value (@extlinks) {
	print EXTFILE "$value\n";
#	print "EXTFILE $value\n";
    }
    print EXTFILE "\n";
    close EXTFILE;
    open PROXYDONE, ">$proxydonefile" or die "Cannot open $proxydonefile: $!\n";
    print PROXYDONE "Done!\n";
    close PROXYDONE;
    return;
}

# This subroutine extracts URL information and puts the key (tag) and
# value (tag values) into a hash table. Also, the URL is parsed to determine
# whether it is an internal or external link. For example, if the URL starts 
# with 'http://' vs if the URL is internal (e.g. '/project/foo')

sub linkextract {
    my($tag, %attr) = @_;
    return if $tag ne 'a';  # we only look closer at <a href=> tags
#   print "LINKEXTRACT CALLED!\n";
#   print "LINKS: $tag type\n";
#   print values %attr;
    
    foreach my $attribute (values %attr) {
	if ($attribute =~/$baseurl/i) {
	    push(@intlinks, $attribute);
	} elsif ($attribute =~ /http:\/\//i) {
	    push @extlinks, $attribute;
	} elsif ($attribute =~/^\//) {
	    push(@intlinks, $attribute);
	} elsif ($attribute =~/^[a-zA-Z0-9]/) {
	    my $newatt = "/" . $attribute;
	    push(@intlinks, $newatt);
	}
    }
}

sub proxyrun {
    my $local_socket = shift;

    my $done = 0;
    my $readmask = "";
    my $readready = "";
    my @ready_handles = [];
    my $localdone = 0;
    my $remotedone = 0;
    my $readbuf;
    my $readpos = 0;
    my $blksize = 4096;
    my $lasttraffic = time();

    vec($readmask, fileno(Local_Sock), 1) = 1;

    socket(Remote_Sock, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
    connect(Remote_Sock, $remote_paddr)               or die "connect: $!";
    my $select = IO::Select->new();
    my $linkextor = HTML::LinkExtor->new(\&linkextract);
#	$linkextor->end = \&proxycomplete;
    $select->add(\*Remote_Sock);
    $select->add($local_socket);
    while(!$done) {
	@ready_handles = $select->can_read(1);
	foreach my $handle(@ready_handles) {
	    if ($handle == \*Remote_Sock) {
		$lasttraffic = time();
		my $len = sysread(Remote_Sock, $readbuf, $blksize);
		if($len == 0) {
		    $remotedone = 1;
		} else {
#                   print "Back: ". $readbuf;
		    $linkextor->parse($readbuf);
		    syswrite($local_socket, $readbuf, $blksize);
		    if($readbuf =~ /<\/html>/i) {
#			print "Got the end\n";
			$done = 1;
		    }
		}
	    } elsif ($handle == $local_socket) {
		$lasttraffic = time();
		my $len = sysread($local_socket, $readbuf, $blksize);
		if($len == 0) {
		    $localdone = 1;
		} else {
		    #          print "Out: " . $readbuf;
		    syswrite(Remote_Sock, $readbuf, $blksize);
		}
	    } else {
		die "Unknown handle returned by select\n";
	    }
	}
	if($localdone && $remotedone) {
#	    print "Local and Remote Done";
	    $done = 1;
	}
	my $currenttime = time();
	my $differential = $currenttime - $lasttraffic;
	if($differential > $timeout) {
#	    print "Timed out: $lasttraffic $currenttime $differential\n";
	    $done = 1;
	} else {

	}
    }
    $linkextor->eof();
    proxycomplete();
}