Yeah I did port it to Windows... and ran it as an EXE using the PAR Packer.
It seemed to start up ok, but would die when a client connected without any obvious cause. I stopped at that point because I have other paid work to do, but do intend getting back to it in the next couple of weeks.
I also tried running it under Strawberry Perl, but it didn't work as well as with the PAR Packer... once again I'm not sure why and haven't had the time to investigate further.
I am also seriously considering converting the entire script to C, so that it can be made into a stand-alone portable app... I'm a bit pressed for time at the moment, so if anyone else wants to make a start on converting it to C please feel free... (Hint).
Here's my Windows version:
(Note: Karl told me to comment out the "setpgrp" calls)
[syntax="perl"]
#!/usr/bin/perl
#
# Copyright (c) 2009-2010 by Karl J. Runge <
runge@karlrunge.com>
#
# ultravnc_repeater.pl 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; either version 2 of the License, or (at
# your option) any later version.
#
# ultravnc_repeater.pl 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 ultravnc_repeater.pl; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
# or see <
http://www.gnu.org/licenses/>.
# 2010-05-18: Modified by Keith Willis <
ratchunk@gmail.com>
#
# Changes List:
# -------------
# 1. Accept command line arguments instead of using environment variables
# 2. Included a definition of the "fsleep" subroutine
# 3. Added subroutine "remove_looparg" to remove any Command-Line Looping Arguments from the $ARGV list. (Used in Looping.)
#
# To Do:
# ------
# 1. Add Daemon Process Kill functionality
# 2. Add Authentication
# 3. Add a way to query current connections
#
# Examples of some Useful Bash Commands: (for recovery and debugging)
# --------------------------------------
# /home/testuser/public_html/cgi-bin/ultravnc_repeater.pl -l /home/testuser/public_html/cgi-bin/repeater.log -p /home/testuser/public_html/cgi-bin/repeater.pid -r -c 5901 -s 5500 &
# pgrep -l perl
# ps -p 20748 -f
# netstat -anp --tcp
# pkill perl
# kill 20748 20754 20761 22750 22753 22754 22803 22806 22878 22879 23060 23062 23077 23080 23081 23097 23098
use strict;
use File::Basename;
use Cwd qw(abs_path);
# Default Parameters Values
my $usage = '
ultravnc_repeater.pl:
perl script implementing the ultravnc repeater
proxy protocol.
protocol: Listen on one port for vnc clients (default 5900.)
Listen on one port for vnc servers (default 5500.)
Read 250 bytes from connecting vnc client or server.
Accept ID:<string> from clients and servers, connect them
together once both are present.
The string "RFB 000.000\n" is sent to the client (the client
must understand this means send ID:... or host:port.)
Also accept <host>:<port> from clients and make the
connection to the vnc server immediately.
Note there is no authentication or security WRT ID names or
identities; it is up to the client and server to completely
manage that aspect and whether to encrypt the session, etc.
usage: ultravnc_repeater.pl [-h] [-r] [-c client_port] [-s server_port] [-l ULTRAVNC_REPEATER_LOGFILE] [-p ULTRAVNC_REPEATER_PIDFILE] [-L ULTRAVNC_REPEATER_LOOP] [-R ULTRAVNC_REPEATER_NO_RFB]
Set "-h" to view this help file.
Use "-r" to refuse new server/client connections when there is an existing server/client ID.
The default is to close the previous one.
To write to a log file set "-l /path/to/log.file".
Set "-p /path/to/pid.file" to store the master pid in a file.
To run in a loop restarting the server if it exits set "-L 1" or "-L BG",
the latter forks into the background.
Set "-R 1" to disable sending "RFB 000.000" to the client.
Then this program acts as general TCP rendezvous tool.
Set "-c 5500" to set the Client Port to 5500.
Set "-s 5900" to set the Server Port to 5900.
Examples:
---------
ultravnc_repeater.pl
ultravnc_repeater.pl -r
ultravnc_repeater.pl -c 5901
ultravnc_repeater.pl -s 5501
ultravnc_repeater.pl -c 5901 -s 5501
ultravnc_repeater.pl -l /home/user/public_html/log/repeater.log
ultravnc_repeater.pl -p /home/user/public_html/log/pid.log
ultravnc_repeater.pl -l /home/user/public_html/log/repeater.log -p /home/user/public_html/log/pid.log
ultravnc_repeater.pl -L 1
ultravnc_repeater.pl -L BG
ultravnc_repeater.pl -R 1
ultravnc_repeater.pl -l /home/user/public_html/log/repeater.log -p /home/user/public_html/log/pid.log -r -c 5901 -s 5500 -L BG -R 1
';
my $ULTRAVNC_REPEATER_LOOP = 'BG'; # Forked processes have this value cleared to avoid a "Fork Bomb" situation, where a new forkable background process is spawned every time the script is forked
my $ULTRAVNC_REPEATER_PIDFILE = dirname(abs_path($0)) . '/repeater.pid'; # abs_path($0) = /home/user/public_html/cgi-bin/ultravnc_repeater.pl
my $ULTRAVNC_REPEATER_LOGFILE = dirname(abs_path($0)) . '/repeater.log';
my $ULTRAVNC_REPEATER_NO_RFB = '';
my $refuse = 0;
my $client_port = 5901;
my $server_port = 5501;
if (@ARGV || $#ARGV >= 0) # Read command-line arguments
{
for (my $i=0; $i <= $#ARGV; $i++)
{
if ($ARGV[$i] eq '-h')
{
print $usage;
exit 0;
}
elsif ($ARGV[$i] eq '-r') {$refuse = 1;}
elsif ($ARGV[$i] eq '-p') {$ULTRAVNC_REPEATER_PIDFILE = $ARGV[++$i];}
elsif ($ARGV[$i] eq '-l') {$ULTRAVNC_REPEATER_LOGFILE = $ARGV[++$i];}
elsif ($ARGV[$i] eq '-L') {$ULTRAVNC_REPEATER_LOOP = $ARGV[++$i];}
elsif ($ARGV[$i] eq '-R') {$ULTRAVNC_REPEATER_NO_RFB = $ARGV[++$i];}
elsif ($ARGV[$i] eq '-c') {$client_port = $ARGV[++$i];}
elsif ($ARGV[$i] eq '-s') {$server_port = $ARGV[++$i];}
}
}
elsif (length ($ENV{'QUERY_STRING'}) > 0) # Read HTTP arguments
{
my $buffer = $ENV{'QUERY_STRING'};
my @pairs = split(/&/, $buffer);
my %query;
foreach my $pair (@pairs)
{
my ($name, $value) = split(/=/, $pair);
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$query{$name} = $value;
}
print "Content-type: text/html\n\n";
if (exists $query{'help'})
{
if ($query{'help'} eq 'true')
{
print $usage;
exit 0;
}
}
if (exists $query{'refuse'})
{
if ($query{'refuse'} eq 'true') {$refuse = 1;}
else {$refuse = 0;}
}
if (exists $query{'pidfile'}) {$ULTRAVNC_REPEATER_PIDFILE = $query{'pidfile'};}
if (exists $query{'logfile'}) {$ULTRAVNC_REPEATER_LOGFILE = $query{'logfile'};}
if (exists $query{'loop'}) {$ULTRAVNC_REPEATER_LOOP = $query{'loop'};}
if (exists $query{'norfb'})
{
if ($query{'norfb'} eq 'true') {$ULTRAVNC_REPEATER_NO_RFB = '1';}
else {$ULTRAVNC_REPEATER_NO_RFB = '';}
}
if (exists $query{'cport'}) {$client_port = $query{'cport'};}
if (exists $query{'sport'}) {$server_port = $query{'sport'};}
}
#else {die 'ultravnc_repeater.pl: No script arguments';}
# Set up logging:
#
#if (exists $ENV{ULTRAVNC_REPEATER_LOGFILE}) {
if ($ULTRAVNC_REPEATER_LOGFILE ne '') {
close STDOUT;
if (!open(STDOUT, ">>$ULTRAVNC_REPEATER_LOGFILE")) {
die "ultravnc_repeater.pl: $ULTRAVNC_REPEATER_LOGFILE $!\n";
}
close STDERR;
open(STDERR, ">&STDOUT");
}
select(STDERR); $| = 1;
select(STDOUT); $| = 1;
# interrupt handler:
#
my $looppid = '';
my $pidfile = '';
#
sub get_out {
lprint("$_[0]:\t$$ looppid=$looppid");
if ($looppid) {
kill 'TERM', $looppid;
fsleep(0.2);
}
unlink $pidfile if $pidfile;
cleanup();
exit 0;
}
sub lprint {
print STDERR scalar(localtime), ": ", @_, "\n";
}
# These are overridden in actual server thread:
#
$SIG{INT} = \&get_out;
$SIG{TERM} = \&get_out;
# pidfile:
#
sub open_pidfile {
# if (exists $ENV{ULTRAVNC_REPEATER_PIDFILE}) {
# my $pf = $ENV{ULTRAVNC_REPEATER_PIDFILE};
if ($ULTRAVNC_REPEATER_PIDFILE ne '') {
my $pf = $ULTRAVNC_REPEATER_PIDFILE;
if (open(PID, ">$pf")) {
print PID "$$\n";
close PID;
$pidfile = $pf;
} else {
lprint("could not open pidfile: $pf - $! - continuing...");
}
# delete $ENV{ULTRAVNC_REPEATER_PIDFILE};
$ULTRAVNC_REPEATER_PIDFILE = '';
}
}
####################################################################
# Set ULTRAVNC_REPEATER_LOOP=1 to have this script create an outer loop
# restarting itself if it ever exits. Set ULTRAVNC_REPEATER_LOOP=BG to
# do this in the background as a daemon.
#if (exists $ENV{ULTRAVNC_REPEATER_LOOP}) {
if ($ULTRAVNC_REPEATER_LOOP ne '')
{
my $csl = $ULTRAVNC_REPEATER_LOOP;
if ($csl ne 'BG' && $csl ne '1') {die "ultravnc_repeater.pl: invalid ULTRAVNC_REPEATER_LOOP.\n";}
if ($csl eq 'BG') # go into bg as "daemon":
{
# setpgrp(0, 0);
my $pid = fork();
if (! defined $pid) {die "ultravnc_repeater.pl: $!\n";} # Executed by both Parent and Child processes
elsif ($pid) # Executed by both Parent and Child processes, (Parent will see the Child process's PID, Child will see 0)
{
wait; # Parent process waits for Child process to terminate (Executed by Parent process only)
exit 0;
}
# Executed by Child process only
if (fork()) {exit 0;} # Child spawns another (orphan) child process and exits. The original Parent process will now also exit.
# Executed by orphaned Grandchild process only
# setpgrp(0, 0);
close STDIN;
# if (! $ENV{ULTRAVNC_REPEATER_LOGFILE}) {
if ($ULTRAVNC_REPEATER_LOGFILE eq '')
{
close STDOUT;
close STDERR;
}
}
#delete $ENV{ULTRAVNC_REPEATER_LOOP};
remove_looparg(); # Remove Command-Line Looping Argument, (This prevents the default 'BG' loop option being applied to the forked process and thus creating a "Fork Bomb")
#if (exists $ENV{ULTRAVNC_REPEATER_PIDFILE}) {
if ($ULTRAVNC_REPEATER_PIDFILE ne '') {open_pidfile();}
# ***NOTE*** This following code is executed by the orphaned Grandchild process of the original Parent Process if in Background Looping mode, or by the Parent process if in Foreground Looping mode
lprint("ultravnc_repeater.pl: starting service. master-pid=$$");
while (1)
{
$looppid = fork();
if (! defined $looppid) {sleep 10;}
elsif ($looppid) {wait;} # Parent process waits for Child process to terminate. This will normally occur once the "exec()" pass has completed, or if the "exec()" call fails.
else
{
exec $0, @ARGV; # Run a whole new instance of the repeater script passing in the original arguments except for the looping argument which has been replaced with an empty string in the earlier call to "remove_looparg()".
exit 1; # Child process should never execute this unless the previous call to "exec()" fails. (Normally "exec()" never returns).
}
# Executed by Parent process only
lprint("ultravnc_repeater.pl: re-starting service. master-pid=$$");
sleep 1;
}
exit 0;
}
#if (exists $ENV{ULTRAVNC_REPEATER_PIDFILE}) {
if ($ULTRAVNC_REPEATER_PIDFILE ne '') {open_pidfile();}
# End of background/daemon stuff.
####################################################################
use warnings;
use IO::Socket::INET;
use IO::Select;
# Test for INET6 support:
#
my $have_inet6 = 0;
eval "use IO::Socket::INET6;";
$have_inet6 = 1 if $@ eq "";
print "perl module IO::Socket::INET6 not available: no IPv6 support.\n" if ! $have_inet6;
my $prog = 'ultravnc_repeater';
my %ID;
#my $refuse = 0;
my $init_timeout = 5;
if ($refuse == 1) {lprint("enabling refuse mode (-r).");}
#if (@ARGV && $ARGV[0] =~ /-h/) {
# print $usage;
# exit 0;
#}
#if (@ARGV && $ARGV[0] eq '-r') {
# $refuse = 1;
# lprint("enabling refuse mode (-r).");
# shift;
#}
#my $client_port = shift;
#my $server_port = shift;
#$client_port = 5900 unless $client_port;
#$server_port = 5500 unless $server_port;
my $uname = `uname`;
my $repeater_bufsize = 250;
$repeater_bufsize = $ENV{BUFSIZE} if exists $ENV{BUFSIZE};
my ($RIN, $WIN, $EIN, $ROUT);
my $client_listen = IO::Socket::INET->new(
Listen => 10,
LocalPort => $client_port,
ReuseAddr => 1,
Proto => "tcp"
);
my $err1 = $!;
my $err2 = '';
$client_listen = '' if ! $client_listen;
my $client_listen6 = '';
if ($have_inet6) {
eval {$client_listen6 = IO::Socket::INET6->new(
Listen => 10,
LocalPort => $client_port,
ReuseAddr => 1,
Domain => AF_INET6,
LocalAddr => "::",
Proto => "tcp"
);};
$err2 = $!;
}
if (! $client_listen && ! $client_listen6) {
cleanup();
die "$prog: error: client listen on port $client_port: $err1 - $err2\n";
}
my $server_listen = IO::Socket::INET->new(
Listen => 10,
LocalPort => $server_port,
ReuseAddr => 1,
Proto => "tcp"
);
$err1 = $!;
$err2 = '';
$server_listen = '' if ! $server_listen;
my $server_listen6 = '';
if ($have_inet6) {
eval {$server_listen6 = IO::Socket::INET6->new(
Listen => 10,
LocalPort => $server_port,
ReuseAddr => 1,
Domain => AF_INET6,
LocalAddr => "::",
Proto => "tcp"
);};
$err2 = $!;
}
if (! $server_listen && ! $server_listen6) {
cleanup();
die "$prog: error: server listen on port $server_port: $err1 - $err2\n";
}
my $select = new IO::Select();
if (! $select) {
cleanup();
die "$prog: select $!\n";
}
$select->add($client_listen) if $client_listen;
$select->add($client_listen6) if $client_listen6;
$select->add($server_listen) if $server_listen;
$select->add($server_listen6) if $server_listen6;
$SIG{INT} = sub {cleanup(); exit 0;};
$SIG{TERM} = sub {cleanup(); exit 0;};
my $SOCK1 = '';
my $SOCK2 = '';
my $CURR = '';
lprint("$prog: starting up. pid: $$");
lprint("watching for IPv4 connections on $client_port/client.") if $client_listen;
lprint("watching for IPv4 connections on $server_port/server.") if $server_listen;
lprint("watching for IPv6 connections on $client_port/client.") if $client_listen6;
lprint("watching for IPv6 connections on $server_port/server.") if $server_listen6;
my $alarm_sock = '';
my $got_alarm = 0;
sub alarm_handler {
lprint("$prog: got sig alarm.");
if ($alarm_sock ne '') {
close $alarm_sock;
}
$alarm_sock = '';
$got_alarm = 1;
}
while (my @ready = $select->can_read()) {
foreach my $fh (@ready) {
if (($client_listen && $fh == $client_listen) || ($client_listen6 && $fh == $client_listen6)) {
lprint("new vnc client connecting.");
} elsif (($server_listen && $fh == $server_listen) || ($server_listen6 && $fh == $server_listen6)) {
lprint("new vnc server connecting.");
}
my $sock = $fh->accept();
if (! $sock) {
lprint("$prog: accept $!");
next;
}
if (($client_listen && $fh == $client_listen) || ($client_listen6 && $fh == $client_listen6)) {
# if (exists $ENV{ULTRAVNC_REPEATER_NO_RFB} && $ENV{ULTRAVNC_REPEATER_NO_RFB}) {
if ($ULTRAVNC_REPEATER_NO_RFB eq '1') {
lprint("ULTRAVNC_REPEATER_NO_RFB: not sending RFB 000.000");
} else {
my $str = "RFB 000.000\n";
my $len = length $str;
my $n = syswrite($sock, $str, $len, 0);
if ($n != $len) {
lprint("$prog: bad $str write: $n != $len $!");
close $sock;
}
}
}
my $buf = '';
my $size = $repeater_bufsize;
$size = 1024 unless $size;
$SIG{ALRM} = "alarm_handler";
$alarm_sock = $sock;
$got_alarm = 0;
alarm($init_timeout);
my $n = sysread($sock, $buf, $size);
alarm(0);
if ($got_alarm) {
lprint("$prog: read timed out: $!");
} elsif (! defined $n) {
lprint("$prog: read error: $!");
} elsif ($repeater_bufsize > 0 && $n != $size) {
lprint("$prog: short read $n != $size $!");
close $sock;
} elsif (($client_listen && $fh == $client_listen) || ($client_listen6 && $fh == $client_listen6)) {
do_new_client($sock, $buf);
} elsif (($server_listen && $fh == $server_listen) || ($server_listen6 && $fh == $server_listen6)) {
do_new_server($sock, $buf);
}
}
}
sub do_new_client {
my ($sock, $buf) = @_;
if ($buf =~ /^ID:(\w+)/) {
my $id = $1;
if (exists $ID{$id} && exists $ID{$id}{client} && $ID{$id}{client} eq "0") {
if (!established($ID{$id}{sock})) {
lprint("server socket for ID:$id is no longer established, closing it.");
close $ID{$id}{sock};
delete $ID{$id};
} else {
lprint("server socket for ID:$id is still established.");
}
}
if (exists $ID{$id}) {
if ($ID{$id}{client}) {
my $ref = $refuse;
if ($ref && !established($ID{$id}{sock})) {
lprint("socket for ID:$id is no longer established, closing it.");
$ref = 0;
}
if ($ref) {
lprint("refusing extra vnc client for ID:$id.");
close $sock;
return;
} else {
lprint("closing and deleting previous vnc client with ID:$id.");
close $ID{$id}{sock};
lprint("storing new vnc client with ID:$id.");
$ID{$id}{client} = 1;
$ID{$id}{sock} = $sock;
}
} else {
lprint("hooking up new vnc client with existing vnc server for ID:$id.");
my $sock2 = $ID{$id}{sock};
delete $ID{$id};
hookup($sock, $sock2, "ID:$id");
}
} else {
lprint("storing new vnc client with ID:$id.");
$ID{$id}{client} = 1;
$ID{$id}{sock} = $sock;
}
} else {
my $str = sprintf("%s", $buf);
$str =~ s/\s*$//g;
$str =~ s/\0*$//g;
my $host = '';
my $port = '';
if ($str =~ /^(.+):(\d+)$/) {
$host = $1;
$port = $2;
} else {
$host = $str;
$port = 5900;
}
if ($port < 0) {
my $pnew = -$port;
lprint("resetting port from $port to $pnew.");
$port = $pnew;
} elsif ($port < 200) {
my $pnew = $port + 5900;
lprint("resetting port from $port to $pnew.");
$port = $pnew;
}
lprint("making vnc client connection directly to vnc server host='$host' port='$port'.");
my $sock2 = IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => $port,
Proto => "tcp"
);
if (! $sock2 && $have_inet6) {
lprint("IPv4 connect error: $!, trying IPv6 ...");
eval{$sock2 = IO::Socket::INET6->new(
PeerAddr => $host,
PeerPort => $port,
Proto => "tcp"
);};
lprint("IPv6 connect error: $!") if !$sock2;
} else {
lprint("IPv4 connect error: $!") if !$sock2;
}
if (!$sock2) {
lprint("failed to connect to $host:$port.");
close $sock;
return;
}
hookup($sock, $sock2, "$host:$port");
}
}
sub do_new_server {
my ($sock, $buf) = @_;
if ($buf =~ /^ID:(\w+)/) {
my $id = $1;
my $store = 1;
if (exists $ID{$id} && exists $ID{$id}{client} && $ID{$id}{client} eq "1") {
if (!established($ID{$id}{sock})) {
lprint("client socket for ID:$id is no longer established, closing it.");
close $ID{$id}{sock};
delete $ID{$id};
} else {
lprint("client socket for ID:$id is still established.");
}
}
if (exists $ID{$id}) {
if (! $ID{$id}{client}) {
my $ref = $refuse;
if ($ref && !established($ID{$id}{sock})) {
lprint("socket for ID:$id is no longer established, closing it.");
$ref = 0;
}
if ($ref) {
lprint("refusing extra vnc server for ID:$id.");
close $sock;
return;
} else {
lprint("closing and deleting previous vnc server with ID:$id.");
close $ID{$id}{sock};
lprint("storing new vnc server with ID:$id.");
$ID{$id}{client} = 0;
$ID{$id}{sock} = $sock;
}
} else {
lprint("hooking up new vnc server with existing vnc client for ID:$id.");
my $sock2 = $ID{$id}{sock};
delete $ID{$id};
hookup($sock, $sock2, "ID:$id");
}
} else {
lprint("storing new vnc server with ID:$id.");
$ID{$id}{client} = 0;
$ID{$id}{sock} = $sock;
}
} else {
lprint("invalid ID:NNNNN string for vnc server: $buf");
close $sock;
return;
}
}
sub established {
my $fh = shift;
return established_linux_proc($fh);
# not working:
my $est = 1;
my $str = "Z";
my $res;
#$res = recv($fh, $str, 1, MSG_PEEK | MSG_DONTWAIT);
if (defined($res)) {
lprint("established OK: $! '$str'.");
$est = 1;
} else {
# would check for EAGAIN here to decide ...
lprint("established err: $! '$str'.");
$est = 1;
}
return $est;
}
sub established_linux_proc {
# hack for Linux to see if remote side has gone away:
my $fh = shift;
# if we can't figure things out, we must return true.
if ($uname !~ /Linux/) {
return 1;
}
my @proc_net_tcp = ();
if (-e "/proc/net/tcp") {
push @proc_net_tcp, "/proc/net/tcp";
}
if (-e "/proc/net/tcp6") {
push @proc_net_tcp, "/proc/net/tcp6";
}
if (! @proc_net_tcp) {
return 1;
}
my $n = fileno($fh);
if (!defined($n)) {
return 1;
}
my $proc_fd = "/proc/$$/fd/$n";
if (! -e $proc_fd) {
return 1;
}
my $val = readlink($proc_fd);
if (! defined $val || $val !~ /socket:\[(\d+)\]/) {
return 1;
}
my $num = $1;
my $st = '';
foreach my $tcp (@proc_net_tcp) {
if (! open(TCP, "<$tcp")) {
next;
}
while (<TCP>) {
next if /^\s*[A-z]/;
chomp;
# sl local_address rem_address st tx_queue rx_queue tr tm->when retrnsmt uid timeout inode
# 170: 0102000A:170C FE02000A:87FA 01 00000000:00000000 00:00000000 00000000 1001 0 423294766 1 f6fa4100 21 4 4 2 -1
# 172: 0102000A:170C FE02000A:87FA 08 00000000:00000001 00:00000000 00000000 1001 0 423294766 1 f6fa4100 21 4 4 2 -1
my @items = split(' ', $_);
my $state = $items[3];
my $inode = $items[9];
if (!defined $state || $state !~ /^\d+$/) {
next;
}
if (!defined $inode || $inode !~ /^\d+$/) {
next;
}
if ($inode == $num) {
$st = $state;
last;
}
}
close TCP;
last if $st ne '';
}
if ($st ne '' && $st != 1) {
return 0;
}
return 1;
}
sub handler {
lprint("\[$$/$CURR] got SIGTERM.");
close $SOCK1 if $SOCK1;
close $SOCK2 if $SOCK2;
exit 0;
}
sub hookup {
my ($sock1, $sock2, $tag) = @_;
my $worker = fork();
if (! defined $worker) {
lprint("failed to fork worker: $!");
close $sock1;
close $sock2;
return;
} elsif ($worker) {
close $sock1;
close $sock2;
wait;
} else {
cleanup();
if (fork) {
exit 0;
}
# setpgrp(0, 0);
$SOCK1 = $sock1;
$SOCK2 = $sock2;
$CURR = $tag;
$SIG{TERM} = "handler";
$SIG{INT} = "handler";
xfer_both($sock1, $sock2);
exit 0;
}
}
sub xfer {
my ($in, $out) = @_;
$RIN = $WIN = $EIN = "";
$ROUT = "";
vec($RIN, fileno($in), 1) = 1;
vec($WIN, fileno($in), 1) = 1;
$EIN = $RIN | $WIN;
my $buf;
while (1) {
my $nf = 0;
while (! $nf) {
$nf = select($ROUT=$RIN, undef, undef, undef);
}
my $len = sysread($in, $buf, 8192);
if (! defined($len)) {
next if $! =~ /^Interrupted/;
lprint("\[$$/$CURR] $!");
last;
} elsif ($len == 0) {
lprint("\[$$/$CURR] Input is EOF.");
last;
}
my $offset = 0;
my $quit = 0;
while ($len) {
my $written = syswrite($out, $buf, $len, $offset);
if (! defined $written) {
lprint("\[$$/$CURR] Output is EOF. $!");
$quit = 1;
last;
}
$len -= $written;
$offset += $written;
}
last if $quit;
}
close($out);
close($in);
lprint("\[$$/$CURR] finished xfer.");
}
sub xfer_both {
my ($sock1, $sock2) = @_;
my $parent = $$;
my $child = fork();
if (! defined $child) {
lprint("$prog\[$$/$CURR] failed to fork: $!");
return;
}
$SIG{TERM} = "handler";
$SIG{INT} = "handler";
if ($child) {
lprint("[$$/$CURR] parent 1 -> 2.");
xfer($sock1, $sock2);
select(undef, undef, undef, 0.25);
if (kill 0, $child) {
select(undef, undef, undef, 0.9);
if (kill 0, $child) {
lprint("\[$$/$CURR] kill TERM child $child");
kill "TERM", $child;
} else {
lprint("\[$$/$CURR] child $child gone.");
}
}
} else {
select(undef, undef, undef, 0.05);
lprint("[$$/$CURR] child 2 -> 1.");
xfer($sock2, $sock1);
select(undef, undef, undef, 0.25);
if (kill 0, $parent) {
select(undef, undef, undef, 0.
;
if (kill 0, $parent) {
lprint("\[$$/$CURR] kill TERM parent $parent.");
kill "TERM", $parent;
} else {
lprint("\[$$/$CURR] parent $parent gone.");
}
}
}
}
sub cleanup {
close $client_listen if $client_listen;
close $client_listen6 if $client_listen6;
close $server_listen if $server_listen;
close $server_listen6 if $server_listen6;
foreach my $id (keys %ID) {
close $ID{$id}{sock};
}
}
# sleep a fraction of a second:
#
sub fsleep {
my ($time) = @_;
select(undef, undef, undef, $time) if $time;
}
# Remove Command-Line Looping Argument
sub remove_looparg
{
$ULTRAVNC_REPEATER_LOOP = '';
my $i;
if ($#ARGV >= 0)
{
for ($i=0; $i<=$#ARGV; $i++)
{
if ($ARGV[$i] eq '-L')
{
# splice(@ARGV, $i, 2);
$ARGV[++$i] = ''; # Set a blank loop value. This prevents the default 'BG' loop option being applied to the forked process and thus creating a "Fork Bomb".
last;
}
}
if ($i > $#ARGV) # Add a blank loop value if one not already specified. This prevents the default 'BG' loop option being applied to the forked process and thus creating a "Fork Bomb".
{
$ARGV[$i++] = '-L';
$ARGV[$i] = '';
}
}
else
{
$ARGV[0] = '-L';
$ARGV[1] = '';
}
}
[/syntax]
[mod=494,1293913204]replaced code by syntax=perl[/mod]
)