ANNOUNCEMENT: UDP<->TCP/HTTP Gateway

C Matthew Curtin (cmcurtin@research.megasoft.com)
Wed, 23 Apr 1997 07:48:43 -0400 (EDT)


--QRLORAW+o36mdXJI24dFkuYp7Y0gOCfeUqtlqDjS
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

OK, here is the code to allow machines behind firewalls to talk to the
keyserver by using HTTP proxies.

Run this script on some machine behind your firewall, start up your
deschall clients, and tell them that the machine running this script
is the keyserver. If you need to go through an HTTP proxy, give the
hostname and port number of the proxy as arguments to this
script. i.e.,

./deschall-u2t.pl proxy 8080

There are two machines that are acting as the other side of the proxy,
to turn the HTTP/TCP request back into UDP, and relay that to the real
keyserver.

If anyone is interested in running a TCP<->UDP gateway (i.e., the
other side of this thing), please let me know, and whether you'll
allow "public" use of it. We'd like to test this just a bit longer
before the other side is handed out. I'll also park this script up on
my web site http://www.research.megasoft.com/deschall/ eventually, but
it's not there yet, so don't look :-)

--QRLORAW+o36mdXJI24dFkuYp7Y0gOCfeUqtlqDjS
Content-Type: text/plain
Content-Description: DESCHALL UDP<->TCP Gateway
Content-Disposition: inline;
filename="deschall-u2t.pl"
Content-Transfer-Encoding: 7bit

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

# TCP_to_UDP, 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.

require 5.003;
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
use Sys::Hostname;
use URI::Escape;

###############################################
# 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.
#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;

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";

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

my $version = "1.0";

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!
kill 9, $runpid;
unlink $runfile;
}
else {
#oops, we're allready running.
exit;
}
}
#we are running, so save the PID
open RUN, "> $runfile";
print RUN "$$\n";
close RUN;

#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;

#set up a UDP socket
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);
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";
}

my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
#logmsg "begat $pid";
return; # i'm the parent
}
# else i'm the child -- go spawn

exit &$coderef(@codeargs);
}

#############################################################
# 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; #teeny workaround for some systems
$foo = uri_escape($message);
print SOCKET "GET http://$gateway:$gateway_port/$foo HTTP/1.0\n";
print SOCKET "User-Agent: UDP2TCPGateway/$version\n";
print SOCKET "\n";
#logmsg "GET http://$gateway:$gateway_port/$foo HTTP/1.0\n\n";
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>) {last if /^$/;}
$reply=<SOCKET>;
alarm 0;
};
if($@ and $@ !~ /timeout/) { confess "TCP timeout"; }
close SOCKET;
$reply = uri_unescape($reply);
#Hmm. Will this always work? IIRC \n is not identical cross-platforms
chomp $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 can
# retry itself.
logmsg "Empty reply from T2U proxy.";
return;
#$reply = "Z U2T: Empty reply from T2U proxy.";
}
}

####################################
# send TCP's reply to client via UDP
($port, $iaddr) = sockaddr_in($paddr) or confess "sockaddr_in: $!";
$name = gethostbyaddr($iaddr,AF_INET);
$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";
};

--QRLORAW+o36mdXJI24dFkuYp7Y0gOCfeUqtlqDjS
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

-- 
Matt Curtin  Chief Scientist  Megasoft, Inc.  cmcurtin@research.megasoft.com
http://www.research.megasoft.com/people/cmcurtin/    I speak only for myself
Death to small keys.  Crack DES NOW!   http://www.frii.com/~rcv/deschall.htm

--QRLORAW+o36mdXJI24dFkuYp7Y0gOCfeUqtlqDjS--