Listing 2: SOCKSLIB.PL

#
# define constants used in the package.  Note that
# the SOCKS_DIRECTS *must* be 4 byte IP subnets.  Zero's
# are "don't care" (ie, anything matches)
#
sub SOCKSinit
{
$SOCKS_GW = "socks.server.internal.com";
@SOCKS_DIRECTS = (   "15.0.0.0",
"163"
)
}
#
#
# The Rconnect subroutine will make a connection to the
# socks gateway (defined in $SOCKS_GW).  It is passed
# two parameters, the server to connect to and the port to talk to.
#
# we return with the constant SOCKS_SERVER setup as a stream already
# connected to the socks gateway, which is proxied to the final
# destination machine.
#
#

sub Rconnect
{

local($address,$port,@server,$socks_server,$d1,$d2,$proto,$socks,$error);
local($bytes1,$byte2,$bytes3,$buff,@gotback,@addr);

if (!defined($SOCKS_GW)) {
SOCKSinit();
}

$address = $_[0];
$port = $_[1];

if (CheckDirect($address) == 1)
{

@server = &getIPaddress("$SOCKS_GW");
$socks_server = pack("C4",@server);

($d1, $d2, $proto) = getprotobyname("tcp");

$socks = pack("Sna4x8",2,1080,$socks_server);
if (socket(SOCKS_SOCKET,2,1,$proto) == 0 ) {
$error = -1;
return($error);
}

if ( connect(SOCKS_SOCKET,$socks) == 0)
{
$error = -2;
return($error);
}

#
# Now we build the SOCKS protocol stream
#

$bytes1 = pack("C2",04,01);
if ($port > 255)  {
$bytes2 = pack("C2", int($port/256),
$port-int($port/256)*256);
##
# need to figure out how to split
# into two bytes
##
}
else {
$bytes2 = \
pack("C2",0,$port);
}
@addr = &getIPaddress("$address");
$address = pack("C4",@addr);

$bytes3 = pack("C5",80,101,114,108,00);
select (SOCKS_SOCKET);
$| = 1;
print SOCKS_SOCKET ($bytes1, $bytes2, $address, $bytes3);
read (SOCKS_SOCKET,$buff,8);
@gotback = unpack("C*",$buff);

select(stdout);

return(@gotback[1]);  # the second byte is the return code
# from the server
}

else {
@server = &getIPaddress("$address");
$socks_server = pack("C4",@server);

($d1, $d2, $proto) = getprotobyname("tcp");

$socks = pack("Sna4x8",2,$port,$socks_server);
if (socket(SOCKS_SOCKET,2,1,$proto) == 0 ) {
$error = -10;
return($error);
}

if ( connect(SOCKS_SOCKET,$socks) == 0)
{
$error = -20;
return($error);
}

select (SOCKS_SOCKET);
$| = 1;
select (stdout);
return(0);
}

}
sub getIPaddress
{

# this routine takes the variable $address and interrogates each element
# (ie, the things between the dots).  If any of them are non-numeric, we
# set the variable $hostname to 1 indicating that the variable $address is
# probably a hostname and not an address (ie, we need to do a
# gethostbyname() call to get the IP address.
#

local ($address,@elements,$hostname,$part,$d1,$d2,$d3,$d4,$hostaddress);

$address = $_[0];
@elements = split(/\./,$address);  # split the octets into an array

$hostname = 0;
foreach $part (@elements) {
if ($part =~ /\D+/) {  $hostname = 1;
#check for non-numeric

}
else {
if ($part > 255) {
$hostname = 1;
}
}

}

if ($hostname == 1) {
@elements = ();
# do a gethostbyname filling in elements

if (!(($d1, $d2, $d3, $d4, $hostaddress) =
gethostbyname("$address")))
{

@elements = (0,0,0,0);
}
else {
@elements = unpack("C4",$hostaddress);

}
}

return(@elements);

}

#
# this routine scans thru the array @SOCKS_DIRECTS to see if the address
# passed matches any of the patterns. Zeros in the SOCKS)_DIRECTS subnet
# indicate a "don't care" byte (ie, anything matches it).
#
# a return value of 1 means use the SOCKS gateway
# a return value of 0 indicates we should connect directly to the server.
#
sub CheckDirect
{
local($address,$subnet,$direct,@sub,@ip,$octet,$match_count);

$address = $_[0];

foreach $subnet (@SOCKS_DIRECTS)
{
$direct = 0;    # assume we use the gateway, zero
# means use it
$match_count = 0;
@sub = getIPaddress("$subnet");
@ip  = getIPaddress("$address");

foreach $octet (0..$#sub)  {
if (@sub[$octet]
== 0)
{
$match_count++;

next;
}
else {
if
(@sub[$octet] == @ip[$octet])
{

$match_count++;
}
}
}
if ($match_count == 4) { return(0); }
}
return(1);
}

1;

# End of File