4 # Copyright (C) 2004-2007 Jan Kratochvil <project-udpovertcp@jankratochvil.net>
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; exactly version 2 of June 1991 is required
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23 require IO::Socket::INET;
25 use Carp qw(cluck confess);
30 $SIG{__DIE__}=sub { confess @_; };
35 die "$0: <server-addr>:<port> [<local-port>:<server-addr>:<server-port>...]" if !GetOptions(
39 my $forward_arg=shift||"";
40 my($forward_hostuser,$forward_portuser)=($forward_arg=~/^([\S^:]+):([\S^:]+)$/);
41 my($forward_in,$forward_out);
43 if ($forward_arg=~/^\w+$/) {
44 $listen_tcp=IO::Socket::INET->new(
45 LocalPort=>$forward_arg,
49 ) or die "socket(listen-tcp-<$forward_arg>): $!";
50 die "Excessive arguments: @ARGV" if @ARGV;
51 } elsif ($forward_hostuser) {
52 $forward_in=$forward_out=IO::Socket::INET->new(
54 PeerHost=>$forward_hostuser,
55 PeerPort=>$forward_portuser,
56 ) or die "socket(connect-tcp-<$forward_hostuser>:<$forward_portuser>): $!";
57 } elsif ($forward_arg) {
58 IPC::Open2::open2($forward_in,$forward_out,$forward_arg) or die "$forward_arg: $!";
61 $forward_out=\*STDOUT;
62 die "Excessive arguments: @ARGV" if @ARGV;
68 my($localport,$serverhostuser,$serverportuser)=($triple=~/^([\S^:]+):([\S^:]+):([\S^:]+)$/);
69 my $serverhost=gethostbyname $serverhostuser or die "resolving host $serverhostuser: $!";
70 my $serverport=getservbyname($serverportuser,"udp")||$serverportuser;
71 my $serveraddr=sockaddr_in($serverport,$serverhost) or die "assembling ".inet_ntoa($serverhost).":$serverport: $!";
72 die if 16!=length $serveraddr;
73 my $localsock=IO::Socket::INET->new(
74 LocalPort=>$localport,
77 ) or die "socket(listen-udp-<$forward_arg>): $!";
78 die $localport if $listenport{$localsock->sockname()};
79 $listenport{$serveraddr}={
80 "localsock"=>$localsock,
81 "serverhostuser"=>$serverhostuser,
82 "serverportuser"=>$serverportuser,
83 "serveraddr"=>$serveraddr,
87 my $TYPE_SEND=0; # SEND,sockaddr_in-where,sockaddr_in-from,length,data
89 sub sockaddr_in_name($)
92 my($port,$iaddr)=sockaddr_in($sockaddr_in);
93 my $peer_addr=inet_ntoa($iaddr);
94 return "$peer_addr:$port";
99 my($to,$from,$data)=@_;
101 my $listenport=$listenport{$from}||={
103 my($from_port,$from_iaddr)=sockaddr_in $from;
104 warn "UDP-new-local: port=$from_port\n" if $D;
105 IO::Socket::INET->new(
106 LocalPort=>$from_port,
109 ) or die "New local UDP socket";
113 warn "UDP-send: to=<".sockaddr_in_name($to).">,from-stored-serveraddr=<".sockaddr_in_name($from).">\n" if $D;
114 my $got=send $listenport->{"localsock"},$data,0,$to;
115 cluck "sendmsg(): $!" if !$got || $got!=length $data;
120 my($listenport,$peer_addr,$data)=@_;
121 die if 16!=length $peer_addr;
122 warn "TCP-write: to=<".sockaddr_in_name($listenport->{"serveraddr"}).">,from=<".sockaddr_in_name($peer_addr).">\n" if $D;
123 my $packet=pack "Ca16a16Sa*",$TYPE_SEND,$listenport->{"serveraddr"},$peer_addr,length($data),$data;
124 my $got=syswrite $forward_out,$packet;
125 cluck "syswrite(): $!" if !$got || $got!=length $packet;
128 warn "START\n" if $D;
132 vec($rfds,fileno($forward_in),1)=1 if $forward_in;
133 vec($rfds,fileno($listen_tcp),1)=1 if $listen_tcp;
134 for my $listenport (values(%listenport)) {
135 vec($rfds,fileno($listenport->{"localsock"}),1)=1;
137 my $got=select $rfds,undef(),undef(),undef();
138 die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
139 if ($listen_tcp && vec($rfds,fileno($listen_tcp),1)) {
141 $forward_in eq $forward_out or close $forward_out or confess "Error closing old forward_out socket: $!";
142 close $forward_in or confess "Error closing old forward_in socket: $!";
144 accept $forward_in,$listen_tcp or confess "Error accepting new TCP socket: $!";
145 $forward_out=$forward_in;
147 if ($forward_in && vec($rfds,fileno($forward_in),1)) {
149 fcntl($forward_in,F_SETFL,O_NONBLOCK) or die "fnctl(forward_in,F_SETFL,O_NONBLOCK)";
150 my $got=sysread $forward_in,$buf,0x100000;
151 fcntl($forward_in,F_SETFL,0) or die "fnctl(forward_in,F_SETFL,0)";
153 die "Got TCP EOF/error on forward_in";
154 } elsif ($got==length $buf) {
157 confess "Invalid socket read return value: $got";
159 while (length($forward_buf)>=1+16+16+2) {
160 my($type,$to,$from,$length,$data)=unpack "Ca16a16Sa*",$forward_buf;
161 last if length($data)<$length;
162 ($data,$forward_buf)=unpack "a${length}a*",$data;
163 die if $length!=length $data;
164 die if $type!=$TYPE_SEND;
165 send_udp $to,$from,$data;
168 for my $listenport (values(%listenport)) {
169 my $localsock=$listenport->{"localsock"};
170 next if !vec($rfds,fileno($localsock),1);
172 my $peer_addr=recv $localsock,$buf,0x100000,0;
173 if (!$peer_addr || !defined $buf) {
174 die "Got TCP EOF/error on one of the listenports";
176 got_udp $listenport,$peer_addr,$buf;