#! /usr/bin/perl
#
# $Id: duat,v 0.93 2010/07/16 10:30:00 lace Exp $
# Copyright (C) 2010 Stephan Q <wesetnebu@gmail.com>
# based on tcpoverudp by Jan Kratochvil <project-tcpoverudp@jankratochvil.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; exactly version 2 of June 1991 is required
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
use strict;
use warnings;
use Getopt::Long;
require IO::Socket::INET;
use Fcntl;
use Carp qw(cluck confess);
use Socket;
use Time::HiRes qw(time);
eval {require Net::Pcap; 1;};
eval {require String::CRC32; 1;};
eval {require Compress::Zlib; 1;};
eval {require Crypt::CBC; 1;};
eval {require Pod::Usage; 1;};
#my $READ_SIZE=256; # 96kbit = 47 x 256B
#my $MAX_UNACKED=8;
my $READ_SIZE=1492; # 96kbit = 47 x 256B
my $MAX_UDP=512; # +header
my $MAX_QUEUE_UDP=58; # +header
my $MAX_UNACKED=8;
my $MAX_LOG=1200;
my $MAX_CONG_TCP=30;
my $V=1;
$|=1;
for (qw(PIPE)) {
$SIG{$_}=eval "sub { warn_r 'INFO: Got signal SIG$_'; };";
}
my $D;
my $detach;
my $opt_udp_listen_port;
my $opt_udp_server;
my $opt_tty;
my @tty;
my $opt_dns_listen_port;
my $opt_dns_server;
my $opt_udp_server_addr;
my $opt_udp_server_port;
my $opt_tcp_listen_ports;
my @opt_tcp_listen_port;
my $opt_tcp_forwards;
my @opt_tcp_forward_addr;
my @opt_tcp_forward_port;
my $opt_timeout=0.1;
my $opt_recvloss=0;
my $opt_udp_retry=20;
my $opt_remote_redir;
my $opt_transparent_proxy;
my $opt_iptables_autoconfig;
my $opt_logfile;
my $opt_remotelog;
my $opt_oldpid;
my $opt_client_timeout=600;
my $opt_tty_snow;
my $opt_layer;
my $opt_multimode;
my $opt_double_ack;
my $opt_slowtcp;
my $blowfish_key;
sub usage () {
Pod::Usage::pod2usage(1);
exit;
}
usage if !GetOptions(
"udp-retry=s",\$opt_udp_retry,
"udp-listen-port=s",\$opt_udp_listen_port,
"dns-listen-port=s",\$opt_dns_listen_port,
"dns-server=s",\$opt_dns_server,
"udp-server=s",\$opt_udp_server,
"tcp-listen-ports=s",\$opt_tcp_listen_ports,
"tcp-forwards=s",\$opt_tcp_forwards,
"t|timeout=s",\$opt_timeout,
"recvloss=s",\$opt_recvloss,
"d|debug+",\$D,
"r|remote-redir",\$opt_remote_redir,
"a|iptables-autoconfig",\$opt_iptables_autoconfig,
"transparent-proxy",\$opt_transparent_proxy,
"detach",\$detach,
"l|logfile=s",\$opt_logfile,
"tty=s",\$opt_tty,
"remote-log",\$opt_remotelog,
"s|size=s",\$MAX_UDP,
"client-timeout=s",\$opt_client_timeout,
"m|multimode",\$opt_multimode,
"slowtcp",\$opt_slowtcp,
"double-ack",\$opt_double_ack,
"oldpid=s",\$opt_oldpid,
"tty-snow=s",\$opt_tty_snow,
"layer=s",\$opt_layer,
"h|help",\&usage,
);
if (defined $opt_layer and $opt_layer=~ m/crypt:/) {
print "please type in a long key to use with encryption :";
$blowfish_key= <STDIN>;
}
if (defined $detach) {
close (STDIN);
close (STDOUT);
close (STDERR);
exit if (fork());
exit if (fork());
}
if (defined $opt_logfile) {
open STDERR, ">".$opt_logfile;
}
if (defined $opt_tcp_forwards) {
my $opta=$opt_tcp_forwards;
my $optp=$opt_tcp_forwards;
$opta=~ s/:[0-9]+//g;
$optp=~ s/[[:alnum:].]+://g;
#warn "-- $opta ------- $optp ---";
@opt_tcp_forward_addr=split(/,/,$opta);
@opt_tcp_forward_port=split(/,/,$optp);
}
@tty=split(/,/,$opt_tty) if (defined $opt_tty);
@opt_tcp_listen_port=split(/,/,$opt_tcp_listen_ports) if (defined $opt_tcp_listen_ports);
($opt_udp_server_addr,$opt_udp_server_port)=split(/:/,$opt_udp_server) if (defined $opt_udp_server);
my $now=time();
my %sock;
my %active;
my %client;
my $own_id;
my $TYPE_OPEN=0; # new_id,which
my $TYPE_SEND=1; # id,seq,data
my $TYPE_ACK=2; # id,seq
my $TYPE_CLOSE=3; # id,seq
my $TYPE_LOG=4; # id,logdata
my $TYPE_DNS=5; # dnsdata
my $TYPE_ACK_CONG=6; # id,seq
my $TYPE_FORCE_CLOSE=7; # id,seq
#my $peer_addr;
my $FLAG_FRAG=0b01000000;
my $FLAG_ORIG=0b10000000;
my $FLAG_TYPE=0b00111111;
my %back_dns;
my $MAGIC=0x31393032;
my @backlog;
my $backtime=0;
my $add_timeout=0;
my $ack_balance=0;
my $uuencode=0;
my $id_max=0;
my $idns;
my $idex;
my $idlog;
my $client_log;
my $lastcheck=$now;
my @sent_queue_udp;
my %config_tty;
my $reudp=0;
sub sendpkt;
sub sock_new;
sub id_new;
$uuencode=1 if (defined $opt_layer and ($opt_layer=~ m/uuencode/i));
sub warn_r($)
{
my ($send_data)=@_;
if (defined $opt_remotelog) {
print STDERR $send_data."\n" if (defined $opt_logfile);
shift (@backlog) if ($#backlog>=$MAX_LOG);
push (@backlog,$send_data);
$send_data="";
# if (defined $peer_addr and $backtime + 1 < time) {
if ((scalar (@sent_queue_udp)<int ($MAX_QUEUE_UDP/2)) and not $reudp and defined $client_log and (defined $client{$client_log}->{"peer_addr"} or defined $client{$client_log}->{"tty"})) {
if (not defined $idlog) {
$idlog=id_new;
sock_new $idlog,0,0,$client_log;
}
$sock{$idlog}->{"client_id"}=$client_log;
$client{$client_log}->{"id_c"}{$idlog}=0xfffffff1;
while (@backlog>0 and length ($send_data) + length ($backlog[0]) < $READ_SIZE) {
$send_data.=shift (@backlog)."\n";
}
sendpkt pack ("a*",$send_data),$TYPE_LOG,$idlog;
}
$backtime=$now;
} else {
print STDERR $send_data."\n";
}
}
sub create_pcap {
my $promisc = 0;
my $snaplen = 60;
my $to_ms = 0;
my $opt = 1;
my($err,$net,$mask,$dev,$filter_t);
my $filter = "tcp[13] == 18 and not src host 127.0.0.1";
my @pnets = ($opt_udp_server_addr,"127.0.0.0/8","10.0.0.0/8","192.168.0.0/16","172.16.0.0/12");
if (defined $opt_iptables_autoconfig) {
system ("iptables -t nat -F OUTPUT");
system ("iptables -t nat -F PREROUTING");
for my $pnet (@pnets) {
system ("iptables -p tcp -d $pnet -t nat -I PREROUTING -j ACCEPT");
system ("iptables -p tcp -d $pnet -t nat -I OUTPUT -j ACCEPT");
}
system ("iptables -p udp -d $opt_udp_server_addr -t nat -I PREROUTING -j ACCEPT");
system ("iptables -p udp -d $opt_udp_server_addr -t nat -I OUTPUT -j ACCEPT");
warn_r "config ->iptables -p tcp -t nat -A OUTPUT/PREROUTING -j DNAT --to-destination 127.0.0.1:".$opt_tcp_listen_port[$#opt_tcp_listen_port] if $D;
system ("iptables -p tcp -t nat -A OUTPUT -j DNAT --to-destination 127.0.0.1:".$opt_tcp_listen_port[$#opt_tcp_listen_port]);
system ("iptables -p tcp -t nat -A PREROUTING -j DNAT --to-destination 127.0.0.1:".$opt_tcp_listen_port[$#opt_tcp_listen_port]);
# if (defined $opt_dns_listen_port) {
# system ("iptables -p udp --dport 53 -t nat -A OUTPUT -j DNAT --to-destination 127.0.0.1:".$opt_dns_listen_port);
# system ("iptables -p udp --dport 53 -t nat -A PREROUTING -j DNAT --to-destination 127.0.0.1:".$opt_dns_listen_port);
# }
}
$dev = "lo";
if ( (Net::Pcap::lookupnet($dev, \$net, \$mask, \$err) ) == -1 ) {
die "Net::Pcap::lookupnet failed. Error was $err";
}
my $pcap_t = Net::Pcap::open_live($dev, $snaplen, $promisc, $to_ms, \$err);
$pcap_t || die "Can't create packet descriptor. Error was $err";
if ( Net::Pcap::compile($pcap_t, \$filter_t, $filter, $opt, $mask) == -1 ) {
die "Unable to compile filter string '$filter'\n";
}
Net::Pcap::setfilter($pcap_t, $filter_t);
$pcap_t;
}
sub process_pkt {
my($id, $hdr, $pkt) = @_;
my($src_ip) = 26;
my($dst_ip) = 30;
my($src_port) = 34;
my($dst_port) = 36;
my $hashref=$sock{$id};
# extract the source IP addr into dotted quad form.
my($source) = sprintf("%d.%d.%d.%d",
ord( substr($pkt, $src_ip, 1) ),
ord( substr($pkt, $src_ip+1, 1) ),
ord( substr($pkt, $src_ip+2, 1) ),
ord( substr($pkt, $src_ip+3, 1) ));
my($source_p) = unpack("n",substr($pkt, $src_port, 2) );
# test trick
if ($source_p == 33) {
$source_p= 22;
}
# extract the destination IP addr into dotted quad form.
my($destination) = sprintf("%d.%d.%d.%d",
ord( substr($pkt, $dst_ip, 1) ),
ord( substr($pkt, $dst_ip+1, 1) ),
ord( substr($pkt, $dst_ip+2, 1) ),
ord( substr($pkt, $dst_ip+3, 1) ));
my($destination_p) = unpack("n",substr($pkt, $dst_port, 2) );
if ($hashref->{"saddr"} eq $destination and $hashref->{"sport"} eq $destination_p) {
$hashref->{"daddr"}=$source;
$hashref->{"dport"}=$source_p;
warn_r "found sync-ack : $source:$source_p -> $destination:$destination_p" if $D;
} else {
warn_r "loosing sync-ack : $source:$source_p -> $destination:$destination_p" if $D;
}
}
if (defined $opt_oldpid) {
sleep 4;
kill 9, $opt_oldpid or warn_r "no old process at pid=$opt_oldpid";
}
my $pcap_t;
if ($opt_transparent_proxy) {
$pcap_t=create_pcap;
}
my @sock_tcp;
for my $tcp_listen_port (@opt_tcp_listen_port) {
my $sock_tcp=IO::Socket::INET->new(
LocalPort=>$tcp_listen_port,
Proto=>"tcp",
Listen=>5,
ReuseAddr=>1,
) or die "socket(): $!";
push @sock_tcp,$sock_tcp;
}
my $sock_udp;
if ($opt_udp_listen_port) {
$sock_udp=IO::Socket::INET->new(
Proto=>"udp",
LocalPort=>$opt_udp_listen_port,
) or die "socket(): $!";
} elsif ($opt_udp_server_port) {
$sock_udp=IO::Socket::INET->new(
Proto=>"udp",
PeerAddr=>$opt_udp_server_addr,
PeerPort=>$opt_udp_server_port,
) or die "socket(): $!";
}
my %fh_tty;
foreach (@tty) {
open $fh_tty{$_}, "+<", $_ or die "Unable to open tty: $_ $!";
if ($uuencode) {
system "stty -F ".$_." -echo ";
} else {
system "stty -F ".$_." raw -echo ";
}
}
my $sock_dns;
if ($opt_dns_listen_port) {
$sock_dns=IO::Socket::INET->new(
Proto=>"udp",
LocalPort=>$opt_dns_listen_port,
) or die "socket(): $!";
} elsif ($opt_dns_server) {
$sock_dns=IO::Socket::INET->new(
Proto=>"udp",
PeerAddr=>$opt_dns_server,
PeerPort=>53,
) or die "socket(): $!";
}
sub id_new()
{
our $id;
$id||=0;
$id_max=$id+1;
return $id++;
}
my %stats;
sub stats($)
{
return if (defined $opt_remotelog);
my($name)=@_;
my $nl="";
$stats{$name}++;
our $last;
$last||=$now;
return if $now<$last+1;
$last=$now;
$nl=" " if $D;
print $nl.join(" ","stats:",map(("$_=".$stats{$_}),sort keys(%stats))).($D ? "\r" : "\r");
}
my $init_deflate;
my $init_inflate;
sub add_layers {
my $layer;
foreach $layer (split (/,/,$opt_layer)) {
if (not defined $_[1]) {
if ($layer eq "crc32") {
my $crc=Compress::Zlib::crc32($_[0]);
if ($uuencode) {
$_[0]=unpack("H8",pack ("N", $crc)).$_[0];
} else {
$_[0]=pack "Na*",$crc,$_[0];
}
} elsif ($layer eq "crc") {
my $crc=String::CRC32::crc32($_[0]);
if ($uuencode) {
$_[0]=unpack("H8",pack ("N", $crc)).$_[0];
} else {
$_[0]=pack "Na*",$crc,$_[0];
}
} elsif ($layer eq "uuencode") {
my $d=length ($_[0]);
$_[0]=pack "u",$_[0];
warn_r "uuencode inbytes: ".$d." outbytes ".length ($_[0]) if $D;
}
} else {
#warn_r "out--$layer--";
if ($layer eq "deflate") {
my ($d,$d2,$clevel,$status);
$clevel=6;
$init_deflate=$_[1]->{"cstream_i"};
$init_deflate=Compress::Zlib::deflateInit(-Level => $clevel) if (not $init_deflate);
($d,$status)=$init_deflate->deflate($_[0]);
if ($status!=0) {
die "zdeflate $status --".$init_deflate->msg;
}
($d2,$status)=$init_deflate->flush(3);
$d.=$d2;
if ($status!=0) {
die "zdeflate $status --".$init_deflate->msg;
}
warn_r "deflate inbytes: ".$init_deflate->total_in()." outbytes ".$init_deflate->total_out() if $D;
$_[0]=$d;
$_[1]->{"cstream_i"}=$init_deflate;
} elsif ($layer eq "gzip") {
my ($d,$d2,$clevel,$status);
$d=Compress::Zlib::memGzip(\$_[0]) or die "gzip error";
warn_r "gzip inbytes: ".length ($_[0])." outbytes ".length ($d) if $D;
$_[0]=$d;
} elsif ($layer=~ m/crypt:/ ) {
my ($d,$d2);
$layer=~s/crypt://;
$layer=ucfirst $layer;
$d2=Crypt::CBC->new( {key => "$blowfish_key", header => "salt", cipher => "$layer"} );
$d=$d2->encrypt($_[0]) or die "encrypt error";
warn_r "encrypt inbytes: ".length ($_[0])." outbytes ".length ($d) if $D;
$_[0]=$d;
}
}
}
}
sub process_layers {
my $layer;
foreach $layer (reverse split (/,/,$opt_layer)) {
if (not defined $_[1]) {
if ($layer eq "crc32") {
my $crc;
if ($uuencode) {
($crc,$_[0])=unpack "a8a*",$_[0];
$crc=unpack "N", pack ("H8",$crc);
} else {
($crc,$_[0])=unpack "Na*",$_[0];
}
if ($crc != Compress::Zlib::crc32($_[0])) {
warn_r "last packet CRC32 checksum error" if $D;
return;
}
} elsif ($layer eq "crc") {
my $crc;
if ($uuencode) {
($crc,$_[0])=unpack "a8a*",$_[0];
$crc=unpack "N", pack ("H8",$crc);
} else {
($crc,$_[0])=unpack "Na*",$_[0];
}
if ($crc != String::CRC32::crc32($_[0])) {
warn_r "last packet CRC32 checksum error" if $D;
return;
}
} elsif ($layer eq "uuencode") {
my $d=length ($_[0]);
$_[0]=unpack "u",$_[0];
warn_r "uudecode inbytes: ".$d." outbytes ".length ($_[0]) if $D;
}
} else {
#warn_r "in--$layer--";
if ($layer eq "deflate") {
my ($d,$status,$i);
$init_inflate=$_[1]->{"cstream_o"};
$init_inflate=Compress::Zlib::inflateInit() if (not $init_inflate);
($i,$status)=$init_inflate->inflate($_[0]);
if (not defined $i or ($status!=0 and $status!=1)) {
warn_r "inflate: ".$init_inflate->msg if $D;
$status=$init_inflate->inflateSync($_[0]);
if ($status!=0) {
warn_r "inflate no sync found no" if $D;
}
return;
}
warn_r "inflate inbytes: ".$init_inflate->total_in()." outbytes ".$init_inflate->total_out() if $D;
$_[0]=$i;
$_[1]->{"cstream_o"}=$init_inflate;
} elsif ($layer eq "gzip") {
my ($i,$d2,$clevel,$status);
$d2=length ($_[0]);
$i=Compress::Zlib::memGunzip(\$_[0]) or return;
warn_r "gunzip inbytes: ".$d2." outbytes ".length ($i) if $D;
$_[0]=$i;
} elsif ( $layer=~ m/crypt:/ ) {
my $d2;
my $i;
$layer=~ s/crypt://;
$layer=ucfirst $layer;
$d2=Crypt::CBC->new( { key => "$blowfish_key", header => "salt", cipher => "$layer" } );
if (not eval { $i=$d2->decrypt($_[0]); } ) {
warn_r "decrypt error";
return;
}
warn_r "decrypt inbytes: ".length ($_[0])." outbytes ".length ($i) if $D;
$_[0]=$i;
}
}
}
return 1;
}
sub sendpkt($$$;$)
{
my($data,$type,$id,$stats)=@_;
my $client_id=$sock{$id}->{"client_id"};
my $peer_addr;
if (not defined $client_id) {
return;
}
if (not defined $client{$client_id}->{"peer_addr"} and not defined $client{$client_id}->{"tty"}) {
warn_r "Still no peer to send";
stats("sentearly");
return;
}
if ($client_id == $own_id) {
$type|=$FLAG_ORIG;
} else {
$id=$client{$client_id}->{"id_c"}{$id};
}
$data=pack "CNa*",$type,$id,$data;
$data=pack "Na*",$own_id,$data if (defined $opt_multimode);
add_layers($data) if (defined $opt_layer);
if (defined $client{$client_id}->{"tty"}) {
my $dlength=length ($data);
if ($uuencode) {
$data=pack "Na*",$MAGIC,unpack("H*",pack ("n", $dlength)).$data;
} else {
$data=pack "Nna*",$MAGIC,$dlength,$data;
}
$data=~ s/a/"$opt_tty_snow"/i if ($opt_tty_snow and rand()<0.3);
if (not defined $config_tty{$client{$client_id}->{"tty"}}->{"sent_queue_tty"} or scalar (@{$config_tty{$client{$client_id}->{"tty"}}->{"sent_queue_tty"}})<20) {
push @{$config_tty{$client{$client_id}->{"tty"}}->{"sent_queue_tty"}},$data;
} else {
warn_r "dropping tty packages due to queue overrun (>20)";
}
# syswrite $fh_tty{$client{$client_id}->{"tty"}},$data or warn_r "Error sending packet: $!";
stats($stats||"sentok");
return;
}
$data=pack "Na*",$MAGIC,$data;
if (scalar (@sent_queue_udp)<$MAX_QUEUE_UDP) {
push @sent_queue_udp,{ "data" => $data, "client_id" => $client_id, };
} else {
warn_r "dropping udp packages due to queue overrun (>$MAX_QUEUE_UDP)";
}
$client{$client_id}->{"lasttime"}=$now;
}
sub printable($)
{
local $_=$_[0];
s/\W/./gs;
return $_;
}
sub seq_new($;$)
{
my($data,$frag)=@_;
return {
"data"=>$data,
"frag"=>$frag,
"timeout"=>$now+$opt_timeout+$add_timeout,
};
}
sub sock_new($$$$)
{
my($id,$which,$stream,$client_id)=@_;
confess if $sock{$id};
$active{$id}=$sock{$id}={
"id"=>$id,
"stream"=>$stream,
"which"=>$which, # for OPEN retransmits
"sent_to_udp"=>0,
"sent_queue"=>{
# 0=>seq_new(undef()),
},
"acked_to_udp"=>0,
"incoming"=>{
# 5=>$udp_data,
},
"frag"=>{
#
},
"sent_queue_tcp"=>[],
"close_tcp_pending"=>undef,
"eof_pending"=>0,
"resent"=>0,
"saddr"=>0,
"sport"=>0,
"daddr"=>0,
"dport"=>0,
"cstream_i"=>0,
"cstream_o"=>0,
"client_id"=>$client_id,
"cong"=>0,
"lasttime"=>$now,
};
}
sub client_new($;$)
{
my($client_id,$peer_addr)=@_;
my($peer_port,$peer_host,$tty);
if (defined $peer_addr and $peer_addr=~ m/dev\//) {
$tty=$peer_addr;
$peer_addr=undef;
} elsif (defined $peer_addr) {
($peer_port,$peer_host)=sockaddr_in $peer_addr;
$peer_host=inet_ntoa $peer_host;
}
$client{$client_id}={
"client_id"=>$client_id,
"max_id"=>0,
"c_id"=>{
#
},
"id_c"=>{
#
},
"auth"=>"",
"peer_addr"=>$peer_addr,
"peer_host"=>$peer_host,
"peer_port"=>$peer_port,
"tty"=>$tty,
"lasttime"=>$now,
};
$client_log=$client_id if ($client_id ne $own_id);
}
sub no_exist($$$) {
my ($client_id,$idc,$type)=@_;
if (not defined $idex) {
$idex=id_new();
sock_new $idex,0,0,$client_id;
}
$client{$client_id}->{"c_id"}{$idc}=$idex;
$client{$client_id}->{"id_c"}{$idex}=$idc;
$sock{$idex}->{"client_id"}=$client_id;
warn_r " Got $type but for nonexisting sock $idc";
sendpkt pack("N",-1),$TYPE_FORCE_CLOSE,$idex;
delete $client{$client_id}->{"c_id"}{$idc};
delete $client{$client_id}->{"id_c"}{$idex};
# delete $sock{$idex};
# delete $active{$idex};
stats("ufosock");
}
$V and warn_r localtime()." START";
my $earliest;
my %tty_back;
$own_id=int(rand(0xfffff000));
warn_r "Own id=".unpack ("H*",pack ("N",$own_id)) if $D;
if (defined $opt_udp_listen_port) {
client_new $own_id;
} elsif (defined $opt_udp_server_addr) {
$client_log=$own_id;
my $peer_host=gethostbyname($opt_udp_server_addr) or die "resolving $opt_udp_server_addr: $!";
my $peer_addr=sockaddr_in($opt_udp_server_port,$peer_host);
client_new $own_id,$peer_addr;
warn_r "Peer server: $opt_udp_server_addr:$opt_udp_server_port";
} elsif (defined $opt_tty) {
client_new $own_id,$tty[0];
}
sub delete_sock ($) {
my ($id)=@_;
my $hashref=$sock{$id};
my $client_id=$hashref->{"client_id"};
if (defined $sock{$id}) {
# and $client{$client_id}{"id_c"}->{$id}) {
my $idc=$client{$client_id}->{"id_c"}{$id};
delete $client{$client_id}->{"c_id"}{$idc};
delete $client{$client_id}->{"id_c"}{$id};
}
if ($hashref->{"stream"}) {
close $hashref->{"stream"} or warn_r "Error closing local socket: $!";
delete $hashref->{"stream"};
warn_r "Closed the local stream, deleted it from active (id=$id)" if $D;
}
delete $active{$id};
delete $sock{$id};
}
sub reset_sock () {
my $hashref;
my $idc;
my $id=-1;
$idex=undef;
# $idlog=undef;
while ($id++ <= $id_max) {
next if (defined $idlog and $id==$idlog);
# next if (defined $idns and $id==$idns);
delete_sock $id;
}
}
sub ttime ($) {
my ($pp)=@_;
our $time;
my $now=time;
print "diff ($pp) =".((($now-$time)*10000)/10)."ms\n";
$time=$now;
}
for (;;) {
my $rfds="";
my $wfds="";
my $efds="";
my $rfds2="";
my $file_no;
my $ack_wait=0;
my $no_read_tcp=0;
for my $sock_tcp (@sock_tcp) {
vec($rfds,fileno($sock_tcp),1)=1;
}
foreach (@tty) {
vec($rfds,fileno($fh_tty{$_}),1)=1;
vec($wfds,fileno($fh_tty{$_}),1)=1 if (defined $config_tty{$_}->{"sent_queue_tty"} and scalar @{$config_tty{$_}->{"sent_queue_tty"}});
}
vec($wfds,fileno($sock_udp),1)=1 if (scalar @sent_queue_udp and $reudp<2);
vec($rfds,fileno($sock_udp),1)=1 if (defined $opt_udp_listen_port or defined $opt_udp_server);
vec($rfds,fileno($sock_dns),1)=1 if (defined $opt_dns_listen_port or defined $opt_dns_server);
for my $hashref (values(%active)) {
next if !$hashref->{"stream"};
if (defined $opt_slowtcp and $hashref->{"lasttime"}+1>$now) {
$earliest=($earliest>$hashref->{"lasttime"}+1 ? $hashref->{"lasttime"}+1 : $earliest) if $earliest;
$earliest=$hashref->{"lasttime"}+1 if not $earliest;
next;
}
vec($efds,fileno($hashref->{"stream"}),1)=1;
vec($wfds,fileno($hashref->{"stream"}),1)=1 if (scalar @{$hashref->{"sent_queue_tcp"}} or defined $hashref->{"close_tcp_pending"});
if (defined $hashref->{"waittime"} and $hashref->{"waittime"}>$now) {
$earliest=($earliest>$hashref->{"waittime"} ? $hashref->{"waittime"} : $earliest) if $earliest;
$earliest=$hashref->{"waittime"} if not $earliest;
next;
}
$ack_wait+=keys(%{$hashref->{"sent_queue"}});
$no_read_tcp=1 if $ack_wait>=$MAX_UNACKED;
$no_read_tcp=1 if $hashref->{"eof_pending"};
vec($rfds2,fileno($hashref->{"stream"}),1)=1 if not $no_read_tcp;
}
$rfds|=$rfds2 if (not $no_read_tcp);
my $periodic_remaining;
$periodic_remaining=($earliest>$now ? $earliest-$now : 0) if $earliest;
my $got=select $rfds,$wfds,$efds,$periodic_remaining;
$earliest=undef();
$now=time();
if (not $got) {
warn_r "-- No more data to process -- $periodic_remaining --" if ($D and not $opt_remotelog);
}
die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
#warn "..../".unpack ("b*",$rfds);
for my $which (0..$#sock_tcp) {
my $sock_tcp=$sock_tcp[$which];
next if !vec($rfds,fileno($sock_tcp),1);
my $sock_tcp_new;
my $paddr=accept $sock_tcp_new,$sock_tcp or confess "Error accepting new TCP socket: $!";
my $id=id_new();
warn_r "Accepted new TCP (id=$id)" if $D;
my $old=select $sock_tcp_new;
$|=1;
select $old;
sock_new $id,$which,$sock_tcp_new,$own_id;
$client{$own_id}->{"c_id"}{$id}=$id;
$client{$own_id}->{"id_c"}{$id}=$id;
my $hashref=$sock{$id};
$hashref->{"client_id"}=$own_id;
$hashref->{"sent_queue"}{0}=seq_new(undef());
if (defined $opt_tcp_forward_addr[$which]) {
sendpkt pack("Nna*",$which,$opt_tcp_forward_port[$which],$opt_tcp_forward_addr[$which]),$TYPE_OPEN,$id;
} elsif (defined $opt_transparent_proxy) {
my ($spt,$sad)=sockaddr_in($paddr);
$sad=$hashref->{"saddr"}=inet_ntoa($sad);
$hashref->{"sport"}=$spt;
warn_r "source = $sad:$spt" if $D;
while (not $hashref->{"daddr"}) {
Net::Pcap::loop($pcap_t, 1, \&process_pkt, $id);
}
sendpkt pack("Nna*",$which,$hashref->{"dport"},$hashref->{"daddr"}),$TYPE_OPEN,$id;
} else {
sendpkt pack("N",$which),$TYPE_OPEN,$id;
}
warn_r "Sent OPEN (id=$id)" if $D;
}
for my $hashref (values(%active)) {
next if !$hashref->{"stream"};
my $id=$hashref->{"id"};
if (vec($wfds,fileno($hashref->{"stream"}),1) and scalar @{$hashref->{"sent_queue_tcp"}} ) {
my $datalength=length($hashref->{"sent_queue_tcp"}[0]);
$hashref->{"lasttime"}=$now;
if ($datalength==((syswrite $hashref->{"stream"},$hashref->{"sent_queue_tcp"}[0],$datalength) || 0)) {
warn_r "Wrote TCP data (local=$id,send=$datalength)" if $D;
warn_r "data=".printable($hashref->{"sent_queue_tcp"}[0]) if $D && $D>2;
shift @{$hashref->{"sent_queue_tcp"}};
} else {
my $seqclose=++$hashref->{"sent_to_udp"};
$hashref->{"sent_queue"}{$seqclose}=seq_new(undef());
warn_r "Error writing TCP data sending CLOSE" if $D;
sendpkt pack("N",$seqclose),$TYPE_CLOSE,$id;
}
} elsif (vec($wfds,fileno($hashref->{"stream"}),1) and $hashref->{"acked_to_udp"}+1==$hashref->{"close_tcp_pending"}) {
delete_sock $id;
# close $hashref->{"stream"} or confess "Cannot close socket of $id";
# delete $hashref->{"stream"};
# $hashref->{"acked_to_udp"}=$seq;
# confess if !$active{$id};
# delete $active{$id};
# warn_r "Closed the local stream, deleted it from active (seq=".($hashref->{"close_tcp_pending"}).",local=$id)" if $D;
next;
}
if (vec($efds,fileno($hashref->{"stream"}),1)) {
warn "----------------k---$id-----------";
}
last if (scalar (@sent_queue_udp)>=$MAX_QUEUE_UDP-$MAX_UNACKED);
next if !vec($rfds,fileno($hashref->{"stream"}),1);
my $client_id=$hashref->{"client_id"};
my $idc=$client{$client_id}->{"id_c"}{$id};
my ($buf,$seq);
my $len_t=$MAX_UDP;
fcntl($hashref->{"stream"},F_SETFL,O_NONBLOCK) or die "fnctl(,F_SETFL,O_NONBLOCK)";
my $got=sysread $hashref->{"stream"},$buf,$READ_SIZE;
fcntl($hashref->{"stream"},F_SETFL,0) or die "fnctl(,F_SETFL,0)";
#defined($got) or confess "Error reading TCP socket: $!";
if (!$got) {
warn_r " Got TCP EOF/error (id=$idc,local=$id)" if $D;
my $seq=++$hashref->{"sent_to_udp"};
$hashref->{"sent_queue"}{$seq}=seq_new(undef());
sendpkt pack("N",$seq),$TYPE_CLOSE,$id;
# close $hashref->{"stream"} or confess "Error closing local socket: $!";
# delete $hashref->{"stream"};
$hashref->{"eof_pending"}=1;
warn_r "Sent CLOSE (id=$idc,seq=$seq,local=$id)" if $D;
} elsif ($got==length $buf) {
warn_r " Got TCP data (id=$idc,got=$got,local=$id)" if $D;
add_layers($buf,$hashref) if (defined $opt_layer);
my $sbuf;
my $len_t2=0;
my @sub_buf;
my $len_t=length $buf;
while ($len_t2!=$len_t) {
($sbuf,$buf)=unpack "a".$MAX_UDP."a*", $buf;
$len_t2+=length($sbuf);
my $type=$TYPE_SEND;
$seq=++$hashref->{"sent_to_udp"};
if ($len_t2!=$len_t) {
$hashref->{"sent_queue"}{$seq}=seq_new($sbuf,$FLAG_FRAG);
$type|=$FLAG_FRAG;
warn_r "Sent SEND frag (id=$idc,seq=$seq,local=$id,send=".length($sbuf).")" if $D;
} else {
$hashref->{"sent_queue"}{$seq}=seq_new($sbuf);
warn_r "Sent SEND (id=$idc,seq=$seq,local=$id,send=".length($sbuf).")" if $D;
}
sendpkt pack("Na*",$seq,$sbuf),$type,$id;
warn_r "data=".printable($sbuf) if $D && $D>2;
}
} else {
confess "Invalid socket read return value: $got";
}
}
if ($reudp) {
my $sock_udp_new;
warn_r "Try to reopen UDP link and resending packet (reudp=$reudp)" if $D;
if ($sock_udp_new=IO::Socket::INET->new(
Proto=>"udp",
PeerAddr=>$opt_udp_server_addr,
PeerPort=>$opt_udp_server_port,
)) {
# if ($reudp==1) {
# sleep 3;
# close $sock_udp_new;
# } else {
$reudp=0;
close $sock_udp;
$sock_udp=$sock_udp_new;
$earliest=$now+5;
warn_r "udp link is up again $opt_udp_server_addr:$opt_udp_server_port -: $!";
# }
} else {
$earliest=$now+20;
sleep 2;
$reudp++;
warn_r "failed to open socket(): $!";
}
}
foreach my $tty_t (@tty) {
if (vec($wfds,fileno($fh_tty{$tty_t}),1)) {
my $tty_data=shift @{$config_tty{$tty_t}->{"sent_queue_tty"}};
syswrite $fh_tty{$tty_t},$tty_data or warn_r "Error sending packet: $!";
}
}
if (defined $sock_udp and vec($wfds,fileno($sock_udp),1) and $reudp<2) {
my $client_id=$sent_queue_udp[0]->{"client_id"};
if (send $sock_udp,$sent_queue_udp[0]->{"data"},0,$client{$client_id}->{"peer_addr"}) {
$reudp=0;
shift @sent_queue_udp;
stats("sentok");
} else {
warn_r "Error sending packet: $!" if $D;
stats("senterr");
$reudp=1;
$earliest=$now+1;
}
}
if ((defined $opt_dns_listen_port or defined $opt_dns_server) and vec($rfds,fileno($sock_dns),1)) {
my $dns_data;
my $got_addr=recv $sock_dns,$dns_data,0x10000,0;
if ($got_addr) {
my $dns_id=unpack("n",$dns_data);
if (defined $opt_dns_listen_port and not defined $idns) {
$idns=id_new;
sock_new $idns,0,0,$own_id;
}
if (defined $opt_dns_listen_port) {
$back_dns{$dns_id}=$got_addr;
} elsif (defined $opt_dns_server) {
$idns=$back_dns{$dns_id};
}
warn_r " Got DNS data id=($dns_id) and sent it (id=$idns,got=".length($dns_data).")" if $D;
sendpkt pack("a*",$dns_data),$TYPE_DNS,$idns;
} else {
warn_r "Error receiving DNS data: $!";
stats("recverr");
}
}
my @recports;
foreach (@tty) {
push @recports,$_ if (vec($rfds,fileno($fh_tty{$_}),1));
}
push @recports,"udp" if (defined $sock_udp and vec($rfds,fileno($sock_udp),1));
foreach my $recport (@recports) {
my($udp_data,$magic,$type,$id,$idc,$orig,$frag);
my $client_id=0xffffff01;
if ($recport eq "udp") {
my $got_addr=recv $sock_udp,$udp_data,0x10000,0;
if (!$got_addr) {
warn_r "Error receiving UDP data: $!";
stats("recverr");
next;
}
($magic,$udp_data)=unpack "Na*",$udp_data;
if (defined $opt_layer) {
process_layers ($udp_data) or $magic=undef;
}
($client_id,$udp_data)=unpack "Na*",$udp_data if (defined $opt_multimode);
if (not defined $client{$client_id}) {
client_new ($client_id,$got_addr);
warn_r "New UDP connexion from address: ".$client{$client_id}->{"peer_host"}.":".$client{$client_id}->{"peer_port"} if $D;
} elsif ($got_addr ne $client{$client_id}->{"peer_addr"}) {
$client{$client_id}->{"peer_addr"}=$got_addr;
my($peer_port,$peer_host)=sockaddr_in $got_addr;
$peer_host=inet_ntoa $peer_host;
warn_r "Packet as from new address: $peer_host:$peer_port old: ".$client{$client_id}->{"peer_host"}.":".$client{$client_id}->{"peer_port"} if $D;
$client{$client_id}->{"peer_host"}=$peer_host;
$client{$client_id}->{"peer_port"}=$peer_port;
stats("ufoaddr");
}
$client{$client_id}->{"lasttime"}=$now;
} elsif ($recport=~ m/dev\//) {
my $data_magic;
my $dlength=$tty_back{$recport}->{"length"};
my ($ma1,$ma2,$dl2);
my $ttyref=$tty_back{$recport};
if (not $ttyref->{"length"}) {
if (defined $ttyref->{"sync"}) {
$ma1=sysread $fh_tty{$recport},$data_magic,1;
$data_magic=$ttyref->{"sync"}.$data_magic;
} else {
$ma1=sysread $fh_tty{$recport},$data_magic,6+(2*$uuencode);
}
if (length $data_magic<6+(2*$uuencode)) {
$ttyref->{"sync"}=$data_magic;
warn_r "tty: $recport need to read more chars from serial" if (defined $D and $D>1);
next;
}
if ($uuencode) {
($data_magic,$dlength)=unpack "Na*",$data_magic or next;
$dl2=$dlength;
$dlength=unpack "n", pack ("H*",$dlength);
} else {
($data_magic,$dlength)=unpack "Nn",$data_magic or next;
$dl2=pack("n",$dlength);
}
if (not $data_magic eq $MAGIC) {
warn_r "tty : $recport out of sync, try to resync" if (not defined $ttyref->{"sync"});
($ma2,$ttyref->{"sync"})=unpack "ca*", pack ("N",$data_magic).$dl2;
next;
}
# warn_r "tty : $opt_tty found the MAGIC and lenght:".$dlength if $D;
}
$ttyref->{"sync"}=undef;
$ma1=sysread $fh_tty{$recport},$udp_data,$dlength;
next if ($ma1==1 and $uuencode and $udp_data eq "\x0a");
#my $hexdata=unpack "H*",$udp_data;
#$hexdata=~ s/(..)/$1 /g;
#warn_r "+++++$hexdata+++++" ;
if ($ma1<$dlength) {
$ttyref->{"data"}.=$udp_data;
$ttyref->{"length"}=$dlength-$ma1;
next;
}
$udp_data=$ttyref->{"data"}.$udp_data if (defined $ttyref->{"data"});
# $udp_data=pack "Na*",$MAGIC,$udp_data;
$magic=$MAGIC;
$ttyref->{"data"}=$ttyref->{"length"}=undef;
if (defined $opt_layer) {
process_layers ($udp_data) or $magic=undef;
}
($client_id,$udp_data)=unpack "Na*",$udp_data if (defined $opt_multimode);
if (not defined $client{$client_id}) {
client_new $client_id,$recport;
warn_r "New tty connexion from: $recport" if $D;
}
}
($type,$idc,$udp_data)=unpack "CNa*",$udp_data or next;
$orig=$type & $FLAG_ORIG;
$frag=$type & $FLAG_FRAG;
$type=$type & $FLAG_TYPE;
$client_id=$own_id if (not $orig==$FLAG_ORIG);
#warn "++++".unpack ("H*",pack ("N",$client_id))."---";
if (!$magic || $magic!=$MAGIC) {
warn_r "packet decoding error!";
stats("badcrc");
} elsif ($type==$TYPE_DNS) {
if (defined $opt_dns_listen_port) {
my $dns_id=unpack("n",$udp_data);
if (defined $back_dns{$dns_id}) {
send $sock_dns,$udp_data,0,$back_dns{$dns_id};
delete $back_dns{$dns_id};
warn_r " Got DNS respond id=($dns_id) and send it (id=$idc)" if $D;
} else {
warn_r " Got DNS respond but id=($dns_id) is unknown" if $D;
}
} elsif (defined $opt_dns_server) {
# reset_sock if ($idc==0 and not defined $opt_multimode);
my $dns_id=unpack("n",$udp_data);
if (not defined $client{$client_id}{"c_id"}->{$idc}) {
$id=id_new();
$idns=$idc if (not defined $opt_multimode);
$client{$client_id}->{"c_id"}{$idc}=$id;
$client{$client_id}->{"id_c"}{$id}=$idc;
sock_new $id,0,0,$client_id;
} else {
$id=$client{$client_id}->{"c_id"}{$idc};
}
$back_dns{$dns_id}=$id;
send $sock_dns,$udp_data,0;
warn_r " Got DNS request and send it (id=$idc,local=$id)" if $D;
} else {
warn_r " Got DNS but don't know what to do with it" if $D;
}
} elsif ($type==$TYPE_LOG) {
my $udata;
foreach $udata (split (/\n/,$udp_data)) {
warn_r " remote: -> $udata";
}
next;
} elsif (rand() < $opt_recvloss) {
warn_r " Got type=$type (id=$idc) but it got lost" if $D;
} elsif ($type==$TYPE_OPEN) {
my($which,$tcp_fp,$tcp_fa);
warn_r " Got OPEN (id=$idc)" if $D;
if (defined $opt_remote_redir) {
($which,$tcp_fp,$tcp_fa)=unpack "Nna*",$udp_data;
$udp_data="";
$opt_tcp_forward_addr[$which]=$tcp_fa;
$opt_tcp_forward_port[$which]=$tcp_fp;
warn_r "Open remote redir to ".$opt_tcp_forward_addr[$which].":".$opt_tcp_forward_port[$which] if $D;
} else {
($which,$udp_data)=unpack "Na*",$udp_data;
}
next if $udp_data;
reset_sock if ($idc==0 and not defined $opt_multimode);
reset_sock if (defined $idns and $idc==1 and $idns==0 and not defined $opt_multimode);
if (not defined $client{$client_id}->{"c_id"}{$idc}) {
$id=id_new();
$client{$client_id}->{"c_id"}{$idc}=$id;
$client{$client_id}->{"id_c"}{$id}=$idc;
} else {
$id=$client{$client_id}->{"c_id"}{$idc};
}
if (!$sock{$id}) {
my $sock_tcp_new=IO::Socket::INET->new(
PeerAddr=>$opt_tcp_forward_addr[$which],
PeerPort=>$opt_tcp_forward_port[$which],
Proto=>"tcp",
);
if (!$sock_tcp_new) {
sendpkt pack("N",1),$TYPE_CLOSE,$id;
warn_r "Refused back OPEN by CLOSE (id=$idc,seq=1)" if $D;
next;
} else {
my $old=select $sock_tcp_new;
$|=1;
select $old;
sock_new $id,$which,$sock_tcp_new,$client_id;
stats("openok");
}
}
sendpkt pack("N",0),$TYPE_ACK,$id;
warn_r "Sent ACK open (id=$idc,local=$id)" if $D;
} elsif ($type==$TYPE_SEND) {
my($seq);
($seq,$udp_data)=unpack "Na*",$udp_data;
$id=$client{$client_id}->{"c_id"}{$idc};
my $hashref=$sock{$id} if (defined $id);
my $oldseq=$seq;
if (!$hashref) {
no_exist $client_id,$idc,"SEND";
next;
} else {
if ($frag) {
warn_r " Got SEND frag (id=$idc,seq=$seq,local=$id,got=".length($udp_data)." (acked_to_udp=".$hashref->{"acked_to_udp"}.")" if $D;
} else {
warn_r " Got SEND (id=$idc,seq=$seq,local=$id,got=".length($udp_data)." (acked_to_udp=".$hashref->{"acked_to_udp"}.")" if $D;
}
warn_r "data=".printable($udp_data) if $D && $D>2;
if ($hashref->{"acked_to_udp"}+1>$seq) {
stats("recvdup");
}
if (defined $hashref and scalar @{$hashref->{"sent_queue_tcp"}}>1) {
my $difftime=$now-$hashref->{"lasttime"};
$difftime=int ($difftime * scalar @{$hashref->{"sent_queue_tcp"}}*1.1 *100);
sendpkt pack("Nn",$oldseq,$difftime),$TYPE_ACK_CONG,$id;
warn_r "Sent ACK_CONG (id=$idc,seq=$oldseq,local=$id,diff=".$difftime."0ms,queue=".scalar @{$hashref->{"sent_queue_tcp"}}.")" if $D;
}
if (scalar @{$hashref->{"sent_queue_tcp"}}>$MAX_CONG_TCP) {
warn_r " Droping packet due to sendqueue full (id=$idc,seq=$seq,local=$id)" if $D;
next;
}
while ($hashref->{"acked_to_udp"}+1==$seq) {
if ($frag) {
$hashref->{"incoming"}{$seq}=$udp_data;
$hashref->{"frag"}{$seq}=$frag;
} elsif ($hashref->{"stream"}) {
my $seq_t=$seq-1;
while ($hashref->{"frag"}{$seq_t}) {
$udp_data=$hashref->{"incoming"}{$seq_t}.$udp_data;
$seq_t--;
}
if (defined $opt_layer) {
process_layers($udp_data,$hashref) or last;
}
push @{$hashref->{"sent_queue_tcp"}},$udp_data;
}
$hashref->{"acked_to_udp"}=$seq;
stats("recvok");
warn_r " In order - got SEND (id=$idc,seq=$seq,local=$id (acked_to_udp=".$hashref->{"acked_to_udp"}.")" if $D && $D>=2;
if (($hashref->{"incoming"}{$seq+1})) {
$udp_data=$hashref->{"incoming"}{$seq+1};
delete $hashref->{"incoming"}{$seq+1};
warn_r "Reinserted" if $D && $D>=2;
$frag=$hashref->{"frag"}{$seq+1};
$seq++;
}
}
if ($hashref->{"acked_to_udp"}+1<$seq) {
warn_r " Out of order- got SEND (id=$idc,seq=$seq,local=$id (acked_to_udp=".$hashref->{"acked_to_udp"}.")" if $D && $D>=2;
$hashref->{"incoming"}{$seq}=$udp_data;
$hashref->{"frag"}{$seq}=$frag;
}
}
if (!$hashref || $hashref->{"acked_to_udp"}) {
sendpkt pack("N",$oldseq),$TYPE_ACK,$id;
sendpkt pack("N",$oldseq),$TYPE_ACK,$id if (defined $opt_double_ack);
warn_r "Sent ACK (id=$idc,seq=$oldseq,local=$id)" if $D;
}
} elsif ($type==$TYPE_ACK_CONG) {
$id=$client{$client_id}->{"c_id"}{$idc};
my $hashref=$sock{$id} if (defined $id);
if (!$hashref) {
warn_r " Got ACK_CONG but for nonexisting sock $idc";
stats("ufosock");
next;
}
my($seq,$difftime);
($seq,$difftime,$udp_data)=unpack "Nna*",$udp_data;
$hashref->{"waittime"}=$now+($difftime/100);
warn_r " Got ACK_CONG (id=$idc,seq=$seq,local=$id,diff=".$difftime."0ms)" if $D;
} elsif ($type==$TYPE_ACK) {{
$id=$client{$client_id}->{"c_id"}{$idc};
my $hashref=$sock{$id} if (defined $id);
if (!$hashref) {
warn_r " Got ACK but for nonexisting sock $idc";
stats("ufosock");
next;
}
my($seq);
($seq,$udp_data)=unpack "Na*",$udp_data;
warn_r " Got ACK (id=$idc,seq=$seq,local=$id)" if $D;
$hashref->{"resent"}=0;
die if $udp_data;
if (exists $hashref->{"sent_queue"}{$seq}) {
$ack_balance--;
if ($ack_balance<-(100*$MAX_UNACKED)) {
$ack_balance=0;
$add_timeout-=0.4*($opt_timeout+$add_timeout);
$add_timeout=0 if ($add_timeout<0);
warn_r "decreased timeout to :".($opt_timeout+$add_timeout) if $D;
}
my $data=$hashref->{"sent_queue"}{$seq}{"data"};
die if !$seq && defined $data;
die if $seq && defined $data && $data eq "";
delete $hashref->{"sent_queue"}{$seq};
if ($seq && !defined $data) {
delete_sock $id;
# if (defined $hashref->{"stream"}) {
# close $hashref->{"stream"} or confess "Error closing local socket: $!";
# delete $hashref->{"stream"};
# }
# delete $active{$id};
warn_r "Deleted active id $id (processed ACK on close)" if $D;
}
warn_r "Processed ACK (id=$idc,seq=$seq,local=$id); remaining:".scalar(keys(%{$hashref->{"sent_queue"}})) if $D;
} elsif (not defined $opt_double_ack) {
$ack_balance=0 if ($ack_balance<0);
$ack_balance+=50;
if ($ack_balance>90*($MAX_UNACKED)) {
$ack_balance=0;
$add_timeout+=0.3*($opt_timeout+$add_timeout);
warn_r "increased timeout to :".($opt_timeout+$add_timeout) if $D;
}
}
}} elsif ($type==$TYPE_CLOSE) {
my($seq);
($seq,$udp_data)=unpack "Na*",$udp_data;
$id=$client{$client_id}->{"c_id"}{$idc};
my $hashref=$sock{$id} if (defined $id);
if (!$hashref) {
no_exist $client_id,$idc,"CLOSE";
stats("ufosock");
} else {
my $refseq=$hashref->{"acked_to_udp"}+1;
warn_r " Got CLOSE (id=$idc,seq=$seq,refseq=$refseq,local=$id)" if $D;
die if $udp_data;
if ($hashref->{"acked_to_udp"}+1>$seq) {
stats("recvdup");
}
if ($hashref->{"acked_to_udp"}+1<=$seq && $hashref->{"stream"}) {
$hashref->{"close_tcp_pending"}=$seq;
}
}
if (!$hashref || $hashref->{"acked_to_udp"}+1<=$seq) {
sendpkt pack("N",$seq),$TYPE_ACK,$id;
warn_r "Sent ACK of close (id=$idc,seq=$seq)" if $D;
}
} elsif ($type==$TYPE_FORCE_CLOSE) {
$id=$client{$client_id}->{"c_id"}{$idc};
my $hashref=$sock{$id} if (defined $id);
if (defined $hashref->{"sent_queue"}{0}) {
warn_r " Got FORCE_CLOSE (id=$idc) - ignoring it while waiting for ACK of open" if $D;
next;
}
reset_sock if ($idc==0 and not defined $opt_multimode and defined $opt_udp_listen_port);
my($seq);
($seq,$udp_data)=unpack "Na*",$udp_data;
if (!$hashref) {
no_exist $client_id,$idc,"FORCE_CLOSE";
stats("ufosock");
} else {
warn_r " Got FORCE_CLOSE (id=$idc)" if $D;
die if $udp_data;
next if (not defined $hashref->{"stream"});
delete_sock $id;
# close $hashref->{"stream"} or confess "Cannot close socket of $id";
# delete $hashref->{"stream"};
# confess if !$active{$id};
# delete $active{$id};
# warn_r "Closed the local stream, deleted it from active (id=$idc,seq=$seq,local=$id)" if $D;
}
# if (!$hashref || $hashref->{"acked_to_udp"}+1<=$seq) {
# sendpkt pack("N",$seq),$TYPE_ACK,$id;
# warn_r "Sent ACK of close (id=$idc,seq=$seq)" if $D;
# }
} else {
warn_r "Invalid packet type $type - ignoring packet" if $D;
}
}
for my $hashref (values(%active)) {
last if ($reudp);
my $id=$hashref->{"id"};
my $client_id=$hashref->{"client_id"};
if (defined $client{$client_id}->{"tty"}) {
next if (scalar @{$config_tty{$client{$client_id}->{"tty"}}->{"sent_queue_tty"}}>1);
} else {
next if (scalar @sent_queue_udp>1);
}
my $idc=$client{$client_id}->{"id_c"}{$id};
for my $seq (sort {$a <=> $b} keys(%{$hashref->{"sent_queue"}})) {
my $seqhashref=$hashref->{"sent_queue"}{$seq};
# $seqhashref->{"timeout"}=$now+$opt_timeout+$add_timeout if ($reudp or (defined $hashref->{"waittime"} and $hashref->{"waittime"}>$now));
my $when=$seqhashref->{"timeout"};
if ($now>=$when) {
if ($hashref->{"resent"}>=$opt_udp_retry) {
warn_r "Resent count expired (>$opt_udp_retry)" if $D;
my $seq=++$hashref->{"sent_to_udp"};
# $hashref->{"sent_queue"}{$seq}=seq_new(undef());
sendpkt pack("N",$seq),$TYPE_CLOSE,$id;
sendpkt pack("N",$seq),$TYPE_CLOSE,$id;
delete_sock $id;
# if ($hashref->{"stream"}) {
# close $hashref->{"stream"} or confess "Error closing local socket: $!";
# delete $hashref->{"stream"};
# }
# delete $active{$id};
# warn_r "Closed the local stream, deleted it from active (id=$id)" if $D;
warn_r "Sent CLOSE (id=$idc,seq=$seq,local=$id)" if $D;
last;
}
$hashref->{"resent"}++;
my $data=$seqhashref->{"data"};
if ($seq==0) {
die if defined $data;
if (defined $opt_tcp_forward_addr[$hashref->{"which"}]) {
sendpkt pack("Nna*",$hashref->{"which"},$opt_tcp_forward_port[$hashref->{"which"}],$opt_tcp_forward_addr[$hashref->{"which"}]),$TYPE_OPEN,$id,"sentdup";
} elsif (defined $opt_transparent_proxy) {
sendpkt pack("Nna*",$hashref->{"which"},$hashref->{"dport"},$hashref->{"daddr"}),$TYPE_OPEN,$id,"sentdup";
} else {
sendpkt pack("N",$hashref->{"which"}),$TYPE_OPEN,$id,"sentdup";
}
warn_r "Resent OPEN (id=$idc,local=$id)" if $D;
} elsif (defined $data) {
die if $data eq "";
my $type=$TYPE_SEND;
$type|=$FLAG_FRAG if $seqhashref->{"frag"};
warn_r "Resent SEND (id=$idc,seq=$seq,local=$id)" if $D;
sendpkt pack("Na*",$seq,$data),$type,$id,"sentdup";
} else { # pending CLOSE
warn_r "Resent CLOSE (id=$idc,seq=$seq,local=$id)" if $D;
sendpkt pack("N",$seq),$TYPE_CLOSE,$id,"sentdup";
}
$when=$seqhashref->{"timeout"}=$now+$opt_timeout+$add_timeout;
}
# warn "++id=$id idc=$idc seq=$seq++++add=$add_timeout opt:$opt_timeout++++++".int(($when-time)*1000);
$earliest=$when if (not $reudp and (!$earliest || $when<$earliest));
last if $now<$seqhashref->{"timeout"};
}
}
if ($now>$lastcheck+20 and $opt_client_timeout!=0 and defined $opt_multimode) {
$lastcheck=$now;
for my $client_id (keys(%client)) {
next if (not defined $client_id);
my $clientref=$client{$client_id};
next if (defined $clientref->{"tty"} or $client_id==$own_id);
next if ($clientref->{"lasttime"}+$opt_client_timeout>$now);
for my $id (sort {$a <=> $b} keys(%{$clientref->{"id_c"}})) {
delete_sock $id;
# my $hashref=$sock{$id};
# if ($hashref->{"stream"}) {
# close $hashref->{"stream"} or confess "Error closing local socket: $!";
# delete $hashref->{"stream"};
# }
# delete $active{$id};
}
delete $client{$client_id};
warn_r "client: ".unpack ("H*",pack ("N",$client_id))." timeout (not connected for more than $opt_client_timeout)" if $D;
}
}
}
__END__
=head1 NAME
duat - create a proxy/tunnel connection
=head1 SYNOPSIS
duat [--option{=<option1>,<option2>,...}] ...
=head1 OPTIONS
--udp-listen-port=<port> UDP port to listen for incomming connections
-r --remote-redir let the other side tell where to forward to
--udp-server=<server:port> UDP server to tunnel the TCP connection
--tcp-listen-ports=<port1,port2,...>
TCP ports to listen for connections to forward
(use the last port for transparent proxy)
--tcp-forwards=<server1:port1,server2:port2,...>
forward TCP <port1>,<port2>,... to these
server:port directions
--transparent-proxy trafic is transparently forwarded
(does not need --tcp-forwards option)
-a --iptables-autoconfig configure the system to forward all outgoing
internet trafic for the --transparent-proxy
--dns-server=<dnsserver> use <dnsserver> to forward dns request
--dns-listen-port=<port> install a DNS-proxy on <port> (normaly <53>)
-t --timeout=<sec> UDP package will be resendet after <sec>
--udp-retry=<intents> give up resending after this many <intents>
-s --size=<bytes> UDP packet size (minus header)
-d --debug [--debug] ... increase log-level
-l --logfile=<file> log to <file> instead of STDERR
--remote-log sent log to the other tunnel end
--detach detach and run in background
--client-timeout=<sec> disconnect after <sec> (default 600) 0->infinit
-m --multimode allow more that one client (on BOTH ends!)
-h --help this help
--double-ack send ACK two times for heavy loss connection
--tty=<tty-dev1,tty-dev2,...> use tty additional or alternative to UDP
--layers=<layer1,layer2,...> apply these layers to the tunnel
crypt:blowfish Blowfish-encryption
crypt:RSA RSA-encryption
crypt:DSA DSA-encryption
crypt:<...> any of perl-Crypt-<...> encryptions
deflate compression (zlib)
gzip compression (zlib)
uuencode uuencoding (no control chars -helpfull on ttys)
crc32 checksum (zlib) (last for better funtionality)
--recvloss=<0-1> for simulation of a bad connection (testing)
--tty-snow=<some text> for simulation of a bad tty line (only testing)
=head1 DESCRIPTION
Examples
Creates proxy tunnel connection trough UDP
1.) - very basic setup
remote:> duat --udp-listen-port=3333 --tcp-forward=localhost:22
local :> duat --tcp-listen-ports=2222 --udp-server=<remote-server>:3333
local :> ssh -p 2222
2.) - complex setup using many options to transparent forward all trafic
remote:> sudo duat --udp-listen-port=53 --remote-redir --remote-log \
--dns-server=<ns.local> --layer=crc32,crypt:blowfish \
--multimode -d --detach
local :> sudo duat --tcp-listen-ports=22,1010 --udp-server=<remote-server>:53 \
--tcp-forward=<ssh.local>:22 --dns-listen-port=53 \
--layer=crc32,crypt:blowfish --transparent-proxy \
--iptables-autoconfig --multimode -d
local :> sudo echo "nameserver 127.0.0.1" >/etc/resolv.conf
local :> firefox http:\\google.com (or any other TCP client program)
local :> ssh localhost (forwarded to <ssh.local>)
=head1 AUTHOR
Stephan Q <wesetnebu@gmail.com>
=cut