Beefy Boxes and Bandwidth Generously Provided by pair Networks BBQ
Problems? Is your data what you think it is?
 
PerlMonks  

SOCKS4 Server in Perl

by strredwolf (Chaplain)
on Jul 01, 2002 at 18:21 UTC ( #178634=sourcecode: print w/ replies, xml ) Need Help??

Category: Networking Code
Author/Contact Info strredwolf
Description: Something I grew frustrated with, so I wrote up my own Socks 4 server. Supports CONNECT and BIND. Probably extensible to Socks 5 (have to pull the specs on it). Quick and dirty hack.

To use, grab netpipes and use socks4.pl outgoingIPaddr

#!/usr/bin/perl

$|=1; # Run this with Faucet.

#use strict;
use IO::Socket;
use Net::hostent;
use bytes;

my $remote=$ARGV[0];
my $buf, $byte, @head, $up, $user, $err, $kidpid, $sock, $op, $server;
my $destip, $destport, $i;

### Read in first bytes of the Socks header.

read(STDIN,$buf,4);
@head=unpack("CCn",$buf);
read(STDIN,$buf,4);
$ip=inet_ntoa($buf);

$user='';
while(read(STDIN,$buf,1)) {
  last unless(ord $buf);
  $user .= $buf;
}

### Do some insanity checking.
$err=91;  $op=-1; # Assume Not OK...
$destip=pack("N",0); $destport=0;

if($head[0] == 4) { # SOCKS 4
  if($head[1] == 1) { # CONNECT
    $sock=IO::Socket::INET->new(Proto=>"tcp",
                PeerAddr=>$ip,
                PeerPort=>$head[2]);
    if($sock) {
      $sock->autoflush(1);
      $err=90;
    }
  } elsif($head[1] == 2) { # BIND
    $destport=$$; $destip=inet_aton($remote);
    $server=IO::Socket::INET->new(Proto=>'tcp',
                  LocalPort=>$$,
                  LocalAddr=>$remote,
                  Listen=>1,
                  Reuse=>1);
    print pack("CCn",0,90,$destport).$destip;
    if($sock=$server->accept()) {
      $sock->autoflush(1);
      if($sock->peerhost eq $ip) {
    $err=90;
      } else {
    close $sock;
      }
    }
    close $server;
  }
}

print pack("CCn",0,$err,$destport).$destip;
exit if($err>90);

die "can't fork: $!" unless defined($kidpid=fork());
if($kidpid) {
  while(read($sock,$byte,1)){
    print STDOUT $byte;
  }
  kill("TERM", $kidpid);
} else {
  while (read(STDIN,$byte,1)) {
    print $sock $byte;
  }
}

Comment on SOCKS4 Server in Perl
Download Code
Re: SOCKS4 Server in Perl
by Anonymous Monk on Sep 18, 2009 at 22:14 UTC
    how to use?
Re: SOCKS4 Server in Perl
by Anonymous Monk on Jan 12, 2010 at 08:35 UTC
    pls give as a code for .net networking,1 server and many clients,,,,just like updating one database only
      Try this instead: https://sourceforge.net/projects/ssspl/

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://178634]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (14)
As of 2014-04-18 11:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (466 votes), past polls