From: pdcawley@ftech.net (Piers Cawley)
Newsgroups: comp.lang.perl.misc
Subject: Raw Sockets in Perl
Date: 22 Aug 1996 12:57:00 GMT
Organization: Frontier Internet Services
Lines: 142
Message-ID: <4vhles$ppl@alpha.ftech.net>
NNTP-Posting-Host: mercury.ftech.net
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
X-Newsreader: knews 0.9.6

It's like this: I'm trying to implement IP address based access
control lists for my linux based quake server. The simple way to do
this is just to use the Linux firewalling code to deny packets from
any host in the ban list.

However, in a fit of elegance (and bolstered by the fact that ID have
released partial specs to Quake's network protocol) I thought it would
be neat to have the server send back a proper deny message for hosts
outside the domain. Now, sitting something on the quake port and
sending back deny messages is an absolute doddle, the sample udp
client in the perlipc manpage can be adopted very easily. But of
course this won't work 'cos if you start the denier up then quake
can't bind on the port.

So, what I did was to use the linux firewalling's transparent proxy
code, so that any udp packets that arrive from disallowed hosts are
automatically passed to a different port. The responder then needs to
send back spoofed denial packets (they need to appear to come from the
port they were sent to) and there's the rub.

I've tried doing some (vaguely voodoo) raw socket coding to spoof the
packets, but as far as tcpdump can see no packets are getting out to
the net...

Here's the code. As far as the code can see it's sending the packets
out (I'm seeing no errors). As far as the network can see, those
packets are nowhere to be seen. I'm sure that it all boils down to me
doing something seriously dumb, but I can't for the life of me see
what it is.

--- *SNIP* ---
#!/usr/bin/perl -w

require 5.002;
use Socket;
use Sys::Hostname;

###
### Subroutines
###

## Build a Quake Deny packet.
## We're using raw sockets here, so we have to build the IP and UDP
## headers as well.

sub makePacket {
    my $message = shift;
    my $hispaddr = shift;
    my ($hisport, $hisiaddr) = sockaddr_in($hispaddr);
    my $ouriaddr = gethostbyname(hostname());

    my $qlength = 7 + length $message; # Length of Quake packet
    my $dlength = 28 + $qlength;       # Length of ip packet
    my $ulength = 13 + $qlength;       # Length of udp packet

    my $packstring = 'CCnn2CCna4a4 n2n2 nnCa' . (length($message) + 1);
    my $packet = pack $packstring,
    0x45, 0, $dlength,
    0x1234, 0x0000,
    0xff, 0x11, 0x0000, # Don't bother with checksums
    $hisiaddr, $ouriaddr,
    $hisport, 26000,    # Standard Quake UDP port, should be a variable...
    $ulength, 0x0000,   # Again, no checksum
    0x8000, $qlength,   # Quake packet header
    0x82,               # CONNECTION_DENY
    $message;           # Reason (null terminated)
    return $packet;
}

## Check to see if packet is a connection request.
sub isaConnect {
    my $packet = shift;

    my ($first ,$length, $type, $string) = (unpack('nnCa5C', $packet))[0 .. 3];

    $type == 0x1 and
        $length == 12 and
            $string eq 'QUAKE' and
                $first == 0x8000;
}

### The Game's afoot!

# Name those variables
my ($iaddr, $paddr, $port, $proto, $rin, $rout,
    $hisiaddr, $hispaddr, $message, $packet);

# Initialize those sockets dude!

$iaddr  = gethostbyname(hostname());
$proto  = getprotobyname('udp');
$outproto = getprotobyname('raw');
$port   = 26001;        # Here's where it's redirected to.
$outport = 26000;
$paddr  = sockaddr_in($port, $iaddr);

socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
bind(SOCKET, $paddr)                        || die "bind: $!";

## Are we brave? Do we like playing with RAW Sockets?
## Can we do it any other way?

socket(OUTSOCKET, PF_INET, SOCK_RAW, $outproto) || die "socket: $!";
setsockopt(OUTSOCKET,getprotobyname('ip'),3,1)   || die "setsockopt: $!";

$| = 1;
$packet = '';

$rin = '';

vec($rin, fileno(SOCKET), 1) = 1;

while (select($rout = $rin, undef, undef, undef)) {
    unless ($hispaddr = recv(SOCKET, $packet, 11, 0)) {
        warn "recv: $!";
        next;
    }
    if(isaConnect($packet)) {
        warn "It's a connect packet!";
        unless (send(OUTSOCKET,
                     makePacket("Sorry, you can't come here.",
                                $hispaddr),
                     0,$hispaddr)) {
            warn "send: $!";
        }
    }
}

--
   Piers Cawley - Systems Sheriff on the Frontier Internet Service
            Purveyors of fine connections to the Internet
          0D 02 A0 20 54 E0 60 02   2B 77 F8 D1 8B EB 3F 36
     finger pdcawley@mercury.ftech.net for PGP key and Geek Code