New Gateway code...

Justin Dolske (dolske@cis.ohio-state.edu)
Thu, 24 Apr 1997 22:51:53 -0400 (EDT)


Here's the newest UDP to TCP gateway. A few bugs that people have reported
were fixed. The optional ability to spew debugging info was also added.
And finally, support for HTTP proxies that require authentication has been
added. I can't test it (no authorization here :), but it looks like it
should work. Those of you who needed it -- let me know how it works. :-)

Justin Dolske <URL:http://www.cis.ohio-state.edu/~dolske/>
(dolske@cis.ohio-state.edu)
Graduate Fellow / Research Associate at The Ohio State University, CIS Dept.

#!/usr/contrib/bin/perl -T

# UDP_to_TCP, part of a pair of gateways for tunneling DESCHALL
# UDP requests through a TCP link simulating an HTTP exchange.
#
# See <URL:http://www.frii.com/~rcv/deschall.htm>
#
# (C) 1997 Justin Dolske <dolske.1@osu.edu>
# Based on example code from "Programming Perl", 2nd edition.
# Unlimited free distribution is allowed.
#
# Thanks to Matt Curtin and Rocke Verser for assistance in testing
# the gateways in a production environment.
#
# HISTORY:
# 0.9 - Private development version
# 1.0 - Initial release, 23 Apr 1997
# 1.1 - Bug Fix/Prevention release, 24 Apr 1997
# Also added debugging aids, gateway messages, proxy Authentication.

require 5.003;
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
#use lib "/i/put/a/module/someplace/weird";
use Socket;
use Carp;
use Sys::Hostname;
use MIME::Base64;
use URI::Escape;

#What? Don't have URI::Escape and/or MIME::Base64 installed on your system?
#Two choices:
#
# 1. Get just the Escape.pm and/or Base64.pm module from:
# <URL:http://www.cis.ohio-state.edu/~dolske/des97/Escape.pm>
# <URL:http://www.cis.ohio-state.edu/~dolske/des97/Base64.pm>
#
# 2. Get the full libwww distribution (includes Escape and Base64) from:
# <URL:http://www.perl.org/CPAN/modules/by-module/URI/>
#
# You may need to uncomment and adjust the "use lib ..." towards the top
# of the script, if you install libwww, Escape.pm, or Base64.pm in a
# non-standard place.

###############################################
# some defaults...
#
# If you want to hardcode the location of the
# other gateway, this is the place to do it!
###############################################

#The GATEWAY is the other of the UDP/TCP pair.

my $gateway= "deschall-gateway.verser.frii.com";
my $gateway_port = 2345;

#The PROXY is your web proxy, if you have one.
#If you're only using this because you're having problems
# with UDP, you don't need to worry about it.
#Otherwise, specify the proxy's hostname and port
# on the command line.
# eg, "deschall-u2t.pl web-proxy.mydomain.com 8080"
#The web proxy, if specified, will be the host contacted.
# The proxy will contact the other gateway using info
# in the simulated HTTP exchange we're doing.

my $proxy = shift || $gateway;
my $proxy_port = shift || $gateway_port;

#If your proxy requires authentication, enter your
# username and password in the ''s below. "Basic"
# authorization does not use cryptograhy, so entering
# your user/pass here should not be a problem.

my $username = '';
my $password = '';

#set DEBUG to 1 if you want really verbose output for fixing a problem
my $DEBUG = 0;

my $timeout = 20; #seconds to wait for a TCP reply from gateway
my $port = 8669; #this is hardcoded into the DESCHALL clients.
my $runfile = "u2trun.$port"; #used to detect I'm already running

######################################################
# you shouldn't need to modify anything below here...
######################################################

my $version = "1.1";

#################
#sanity checks...
my $test = uri_unescape(uri_escape("Testing :~/ encode"));
if($test ne 'Testing :~/ encode') {
die "ERROR: URI::Escape is not installed right, or is the wrong version.
Without this module properly installed, the gateway will not work.
For further info, read the comments in the gateway's source code.\n";
}
$test = decode_base64(encode_base64('Aladdin:open sesame'));
if($test ne 'Aladdin:open sesame') {
die "ERROR: MIME::Base64 is not installed right, or is the wrong version.
Without this module properly installed, the gateway will not work.
For further info, read the comments in the gateway's source code.\n";
}

###########################################
#forward declarations and some quickie subs
sub spawn;
sub serveit;
sub logmsg {
my $report;
$report = join '', ("U2T $$: @_ at ", scalar localtime, "\n");
print STDERR $report;
}

my $waitedpid = 0;
sub REAPER {
#$SIG{CHLD} = \&REAPER; # if you don't have sigaction(2)
wait;
#logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}
$SIG{CHLD} = \&REAPER;

############################################
#check to see if gateway is already running
if(-e $runfile) {
#are we really running? Get the PID.
open RUN, $runfile;
my $runpid = <RUN>;
if($runpid =~ /^(\d+$)/) { #stupid taint checking
$runpid = $1;
}
close RUN;
#if we can send signals, we're probably alive.
if(!(kill 0, $runpid)) {
#no server running!
logmsg "RUNCHECK: U2T gateway is not running, launching." if($DEBUG);
kill 9, $runpid;
unlink $runfile;
}
else {
#oops, we're allready running.
logmsg "RUNCHECK: U2T gateway is running, exiting." if($DEBUG);
exit;
}
}
#we are running, so save the PID
open RUN, "> $runfile";
print RUN "$$\n";
close RUN;

######################################
#set up a UDP socket, and loop forever
my $proto = getprotobyname('udp');
socket(Server, PF_INET, SOCK_DGRAM, $proto) or die "socket: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";

logmsg "UDP server started on port $port";

my ($paddr, $rin, $rout);

$rin = '';
vec($rin, fileno(Server), 1) = 1;
while(select($rout = $rin, undef, undef, undef)) {
my($message, $port, $iaddr, $name);
$message = '';
undef $paddr;
#slurp in the message, and get the sender's IP/port too
$paddr = recv(Server, $message, 65536, 0);
logmsg "Received possible connection" if ($DEBUG);
if(!defined $paddr) {next;} #oops, probably a SIGCHLD
($port,$iaddr) = sockaddr_in($paddr) or die "Zoinks! $!";
$name = gethostbyaddr($iaddr,AF_INET);

logmsg "connection from $name [" .
inet_ntoa($iaddr) . "] at port $port";

#we'll let someone else deal with the message
spawn \&serveit, $paddr, $message;
}

##############################################################
# ripped straight from Perl, 2nd ed, Ch. 6
# ...plus a slight modification to handle 2 arguments
sub spawn {
my $coderef = shift;
my @codeargs = (shift, shift);

unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}

#if your system does not support fork(), you may comment out the rest
#of this sub, and instead uncomment the following line of code:
#
#return &$coderef(@codeargs);
#
#the limitation if this is that the gateway cannot accept new
#client requests until the current request is completed.

##### comment the below out to avoid fork() #####
my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "fork begat pid $pid" if($DEBUG);
return; # i'm the parent
}
# else i'm the child -- go spawn
exit &$coderef(@codeargs);
##### comment the above out to avoid fork() #####
}

#############################################################
# Here, we deal with a $message from $paddr
# We open a TCP connection, send the message, wait for a
# reply, and dump the reply to $paddr via UDP
sub serveit {
my($paddr, $message) = @_;
my ( $mypaddr, $myiaddr, $server_rep,
$host, $iaddr, $port, $proto, $reply,
$rin, $rout, $rtime, $name);

if($message eq "") {
$reply = "Z Error at U2T: Empty UDP request from the client.";
}
else {
#Forward the request to the exterior gateway (via TCP) and get a reply
#If a Web proxy was not specified, the proxy and gateway are the same
$iaddr = gethostbyname($proxy);
$mypaddr = sockaddr_in($proxy_port, $iaddr) or confess "sockaddr: $!";
$proto = getprotobyname('tcp');
socket(SOCKET,PF_INET,SOCK_STREAM,$proto) or confess "TCP socket: $!";
select((select(SOCKET), $| = 1)[0]); #buffering
connect(SOCKET, $mypaddr) or confess "TCP connect: $!";

my $foo = uri_escape($message); #teeny workaround for some systems
my $auth = encode_base64("$username:$password");
print SOCKET "GET http://$gateway:$gateway_port/$foo HTTP/1.0\n";
print SOCKET "User-Agent: UDP2TCPGateway/$version\n";
print SOCKET "Authorization: Basic $auth\n" if ($password);
print SOCKET "\n";
logmsg "GET http://$gateway:$gateway_port/$foo HTTP/1.0" if($DEBUG);
logmsg "sent TCP request: $message";
$reply = "";

#wait no more than $timeout seconds for a reply
eval {
local $SIG{ALRM} = sub {die "timeout"};
alarm $timeout;
#skip past HTTP headers
while(<SOCKET>) {
chomp;
logmsg "GOT:$_" if($DEBUG);
logmsg "GATEWAY NOTICE: ". join ' ', split '-', $1 if /^Pragma\: DESmessage=(\S+)/;
last if /^\s*$/;
}
$reply=<SOCKET>;
chomp $reply;
logmsg "Reply: $reply" if($DEBUG);
alarm 0;
};
if($@ and $@ !~ /timeout/) { logmsg "TCP timeout!" if ($DEBUG); return;}
close SOCKET;
$reply = uri_unescape($reply);
logmsg "got TCP reply: $reply";

if($reply eq "") {
#This is likely because a packet was dropped or a timeout
#occurred on the other side. No need to kill client, it will
#retry itself.
logmsg "Empty TCP reply.";
return;
#$reply = "Z U2T: Empty TCP reply.";
}
}

####################################
# send TCP's reply to client via UDP
($port, $iaddr) = sockaddr_in($paddr) or confess "sockaddr_in: $!";
$name = gethostbyaddr($iaddr,AF_INET) || inet_ntoa($iaddr);
$proto = getprotobyname('udp');

$myiaddr = gethostbyname(hostname());
$mypaddr = sockaddr_in(0, $myiaddr) or confess "sockaddr_in: $!";
socket(SOCKET,PF_INET,SOCK_DGRAM,$proto) or confess "UDP socket: $!";
bind(SOCKET, $mypaddr) or confess "UDP bind: $!";
defined(send(SOCKET,$reply,0,$paddr)) or confess "UDP send $host: $!";
logmsg "sent UDP reply to $name" if ($DEBUG);
};