Update: UltraVNC 1.4.3.6 and UltraVNC SC 1.4.3.6: viewtopic.php?t=37885
Important: Please update to latest version before to create a reply, a topic or an issue: viewtopic.php?t=37864

Join us on social networks and share our announcements:
- Website: https://uvnc.com/
- GitHub: https://github.com/ultravnc
- Mastodon: https://mastodon.social/@ultravnc
- Facebook: https://www.facebook.com/ultravnc1
- X/Twitter: https://twitter.com/ultravnc1
- Reddit community: https://www.reddit.com/r/ultravnc
- OpenHub: https://openhub.net/p/ultravnc

Stable ChunkVNC Repeater - Perl Script

Simple, Free, Open Source UltraVNC Wrapper Supporting Windows and Mac OSX
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Stable ChunkVNC Repeater - Perl Script

Post by Rat »

New Release Available! (27 May 2011)
The script may be downloaded from here: http://www.vuware.com/chunkvnc/ultravnc_repeater.zip
More info available [post=87039]here[/post]




To run the perl repeater script in a shared hosting environment just upload it to the /public_html/cgi-bin folder, set the file permissions to 700 and then telnet/SSH2 to your web server and run the script like this:
/home/[YOUR USER NAME]/public_html/cgi-bin/ultravnc_repeater.pl -L BG -r -C -c 5901 -s 5501

Notes:
1. Your directory paths may differ from the above examples, but these should be correct for 90% of standard linux shared hosting environments.
2. If you can't Telnet/SSH2 to your web server, (you should be able to) then the script can also be invoked as a URL. This will require setting up some password protection on the folder and setting the permissions appropriately. Let me know if this is neccessary.
3. You can check if the script is running by issuing the following command:
netstat -anp --tcp | grep perl
4. You can kill all the running repeater processes by issung the following command
pkill ultravnc_repeat
5. Your ChunkVNC repeater address will be the web page address of your shared hosting account.



Supercoe has recently made me aware Karl Runge's excellent VNC Repeater Perl script.

The Perl script performs exactly the same function as the Repeater service/exe. In order to run it, your system should be configured to allow Perl scripts to be executed from the command line.

For those of you without the luxury of a VPS, it can be run on a shared hosting environment which permits the execution of Perl scripts, (many web hosts allow this). If yours doesn't then you are welcome to sign up with my own hosting company, (http://www.vuhosting.com).

The script version that I have released is a slightly modified version of the original script. It includes a bug fix and can have all of its parameters passed to it via the command line.
(Karl's original script required that you initially set some environment variables. This is often prohibited on shared hosting environments.)
There are command line examples available in the script itself in the documentation section near the top. (The $usage variable contains the help info.) The script appears to be bug-free and supports multiple concurrent sessions even ones sharing the same ChunkVNC ID code.

The script may be downloaded from here: http://www.vuware.com/chunkvnc/ultravnc_repeater.zip


Some Notes:
-----------
1. You need to modify the first line of the script to correctly reflect the path to Perl on your system.
2. You also need to call the script with its full path.
3. Ensure you have your permissions set correctly to allow execution of the script.
4. If you want to have the repeater running continuously, (ie. just like a service/daemon), then you need to run it in its "Background" mode.
5. If you don't specify the log file or PID file in the command line arguments, then they will by default be written to the same directory as the script's.

Here is the url of a helpful Perl primer I have found: http://www.lies.com/begperl/hello_command.html

I hope this is of some help.

Cheers,
Rat.

(ChunkVNC Developer)
Last edited by Rat on 2011-05-27 01:15, edited 13 times in total.
B
800
800
Posts: 2338
Joined: 2009-09-09 14:05

Re: Stable ChunkVNC Repeater - Perl Script

Post by B »

"sharing the same ChunkVNC ID code"? Is that different from the repeater ID? Something to do with the upcoming Chunk release?

I didn't realize at first that the Perl version made it possible for ordinary shared webhosting clients to run their own repeater. Cool.

By the way, Rat, as long as you're modifying the repeater code, perhaps you could take a look at some of my wishlisting at [post=69959][/post]

Here's a somewhat-new thought -- pairing repeater connection management (at the repeater) with the VNCProxy.com Java client and server (or even just with the built in VNC Javaviewer) would be a killer app. You could view current repeater connections through a basic web interface, and then seamlessly launch a Java viewer (or even server) to connect to the target you select.
Last edited by B on 2010-05-27 14:10, edited 1 time in total.
User avatar
supercoe
400
400
Posts: 1732
Joined: 2009-07-20 21:27
Location: Walker, MN
Contact:

Re: Stable ChunkVNC Repeater - Perl Script

Post by supercoe »

ChunkVNC ID code = Repeater ID

I'm interested in what the purpose would be in allowing 2 of the same ID's?

If 2 servers connected to the repeater with the same ID which one does the repeater join with a connecting viewer? If it connects the viewer to the server that connected first what happens when the servers are auto reconnecting?

I guess it's neat that it's a possibility but I'm not sure what the benefits would be?
http://www.chunkvnc.com - ChunkVNC - Free PC Remote control with the Open Source UltraVNC wrapper InstantSupport!
shoodabean
8
8
Posts: 15
Joined: 2010-02-28 23:55

Re: Stable ChunkVNC Repeater - Perl Script

Post by shoodabean »

supercoe wrote: I guess it's neat that it's a possibility but I'm not sure what the benefits would be?
I have wanted that option on exactly one occasion so I could train two people in two different locations on a particular software issue.

Of course that in itself turns the remote support 'workflow' upside down, but there you go ;)

cheers
shoo
bigdessert
20
20
Posts: 35
Joined: 2006-08-03 20:25

Re: Stable ChunkVNC Repeater - Perl Script

Post by bigdessert »

supercoe wrote:ChunkVNC ID code = Repeater ID

I'm interested in what the purpose would be in allowing 2 of the same ID's?

If 2 servers connected to the repeater with the same ID which one does the repeater join with a connecting viewer? If it connects the viewer to the server that connected first what happens when the servers are auto reconnecting?

I guess it's neat that it's a possibility but I'm not sure what the benefits would be?
from testing if I start a session with code 123 and then another session comes in with 123 that session connects together. So I can have two sessions with code 123....This basically makes the checking for unique Id's within the ChunkVNC product itself not needed. Now if two servers are connected to the repeater with 123 and then a single viewer connects with 123, it seems rather random on what server it picks.
B
800
800
Posts: 2338
Joined: 2009-09-09 14:05

Re: Stable ChunkVNC Repeater - Perl Script

Post by B »

That runs completely counter to logic and to my expectations. Repeater IDs, in my view, <b>have</b> to be unique or else they cease to have meaning. I had thought all the repeaters would refuse multiple connections withe same repeater ID.

The only exception is if the repeater is willing to act as a "reflector" and multicast the same session to multiple viewers. But as far as I know, none of the current repeaters do that?

Still not sure what Rat meant....
User avatar
supercoe
400
400
Posts: 1732
Joined: 2009-07-20 21:27
Location: Walker, MN
Contact:

Re: Stable ChunkVNC Repeater - Perl Script

Post by supercoe »

Exactly what I was talking about, there is no way to tell which server the repeater will hook up with a connecting viewer.

It seems completely useless...

Now if it allowed to be a reflector like B stated that would be awesome!
http://www.chunkvnc.com - ChunkVNC - Free PC Remote control with the Open Source UltraVNC wrapper InstantSupport!
B
800
800
Posts: 2338
Joined: 2009-09-09 14:05

Re: Stable ChunkVNC Repeater - Perl Script

Post by B »

So again I wonder whether x11vnc, which DOES have "reflector/repeater" abilities, could itself be used as a general purpose repeater that included that multicasting feature....
User avatar
supercoe
400
400
Posts: 1732
Joined: 2009-07-20 21:27
Location: Walker, MN
Contact:

Re: Stable ChunkVNC Repeater - Perl Script

Post by supercoe »

Holy crap great idea B!

I'll look at it again but if I were to run x11vnc on the VPS and have it connect to a repeater ID it could reflect it to many viewers!! :D
http://www.chunkvnc.com - ChunkVNC - Free PC Remote control with the Open Source UltraVNC wrapper InstantSupport!
B
800
800
Posts: 2338
Joined: 2009-09-09 14:05

Re: Stable ChunkVNC Repeater - Perl Script

Post by B »

Thanks... Just for clarity, I was saying x11vnc <b>instead</b> of a repeater, not as an adjunct to one, if this is feasible. The repeater IDs, presumably, would be tracked by x11vnc itself...

Or not. There's a great description of the almost P2P or BitTorrent like cascading nature x11vnc allows at http://www.karlrunge.com/x11vnc/faq.html#faq-reflect

It's a very cool concept, but I don't think it supports traditional repeater IDs?


Edit: Holy moly, I just noticed that below that part of the FAQ, Karl offers a simple web based delivery system for "SC" style support helpdesk on Unix systems. Karl is just, like, amazing.

I don't see any reason why that setup couldn't be be expanded to include delivery of similar SC packages for Windows, ChunkVNC or otherwise.
Last edited by B on 2010-05-27 19:29, edited 1 time in total.
User avatar
supercoe
400
400
Posts: 1732
Joined: 2009-07-20 21:27
Location: Walker, MN
Contact:

Re: Stable ChunkVNC Repeater - Perl Script

Post by supercoe »

I don't see how it would be possible to replace the repeater?

I was looking at it as: "Now we have the GoToMeeting part figured out."
http://www.chunkvnc.com - ChunkVNC - Free PC Remote control with the Open Source UltraVNC wrapper InstantSupport!
B
800
800
Posts: 2338
Joined: 2009-09-09 14:05

Re: Stable ChunkVNC Repeater - Perl Script

Post by B »

Yep. I was just wrong, I think, because I thought the "repeater" built in to x11vnc would accept repeater IDs (SCII style I guess it's called). But it's more of a daisy chaining thing.

So you'll likely need to hook x11vnc up to the separate repeater as you indicate. (Not coincidentally, Karl's. :) )

(That's not to say x11vnc couldn't be modified to accept repeater IDs too. Not sure whether that would be better or worse than chaining it to a dedicated repeater.)

I wonder about performance -- his FAQ implies that a dedicated reflector project would perform better, but based on the age of the stale VNCReflector project and the high quality of Karl's code in general, I'm betting his is at least as good.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

I'm not sure exactly what use having two sessions sharing the same ChunkVNC ID code would be, but I mentioned it because I had noticed it during my testing of the script.

Without looking a bit more closely at the code all I can say is that presumably, the session state is maintained via the connection port. Its kinda useful if you don't want to bother with multiple ID codes for concurrent sessions, so that users don't have to tell you their code before you can connect, (since you can use a pre-defined one you already know).

I think it would be a useful exercise if some other people could confirm this behaviour of the script.

Cheers,
Rat.

ps. I had also started thinking about modifying the script to act as a reflector. I suspect that it won't be all that difficult to do.
Last edited by Rat on 2010-05-28 02:28, edited 1 time in total.
bigdessert
20
20
Posts: 35
Joined: 2006-08-03 20:25

Re: Stable ChunkVNC Repeater - Perl Script

Post by bigdessert »

Rat wrote:ps. I had also started thinking about modifying the script to act as a reflector. I suspect that it won't be all that difficult to do.
This would be absolutely amazing....wish I knew how to program in perl.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

Well actually my Perl skills are limited at best... I've been reading the manual! ;)

Rat.

ps. I did however document how the foreground/background looping code works in the script itself, (and checked with Karl that I had it right).
Last edited by Rat on 2010-05-28 05:58, edited 1 time in total.
B
800
800
Posts: 2338
Joined: 2009-09-09 14:05

Re: Stable ChunkVNC Repeater - Perl Script

Post by B »

Rat wrote: Without looking a bit more closely at the code all I can say is that presumably, the session state is maintained via the connection port. Its kinda useful if you don't want to bother with multiple ID codes for concurrent sessions, so that users don't have to tell you their code before you can connect, (since you can use a pre-defined one you already know).
If the repeater and the sessions can handle it without breaking, I <b>guess</b> that could be useful for help desk scenarios, where the next in a series of "111111" user just gets automatically linked to an available attendant. Still seems sketchy though...
krash_control
8
8
Posts: 24
Joined: 2010-01-27 21:20

Re: Stable ChunkVNC Repeater - Perl Script

Post by krash_control »

Hi

Has anyone managed to port this script to Windows? I am currently getting the error below:

Code: Select all

The setpgrp() function is unimplemented at E:\WWW\MyWebSite\ultravnc_repeater.pl line 245.
I have tried googling but as my knowledge of perl is next to nothing, I am having a bit of trouble with it.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

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.8);
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]
Last edited by Rat on 2011-01-01 20:20, edited 1 time in total.
krash_control
8
8
Posts: 24
Joined: 2010-01-27 21:20

Re: Stable ChunkVNC Repeater - Perl Script

Post by krash_control »

Thanks for the quick response Rat. I did comment out the setpgrp lines as my first step and the script did run but it kept looping in the log file about an error with the PID coupled with the fact that I could not use it to connect (which I now realise is probably because my viewer is set to use port 5901 instead of 5900.

I'll give it a try later, but I've just spent all morning playing around with 3.1g and have to get on with other stuff now. Will post if I try it out again.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

I've posted an update to this script:

The script may be downloaded from here: http://www.vuware.com/chunkvnc/ultravnc_repeater.zip
redge
1000
1000
Posts: 6797
Joined: 2004-07-03 17:05
Location: Switzerland - Geneva

Re: Stable ChunkVNC Repeater - Perl Script

Post by redge »

could possible to have posted here changelog of uvncrepeater.pl ?
UltraVNC 1.0.9.6.1 (built 20110518)
OS Win: xp home + vista business + 7 home
only experienced user, not developer
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

The changes log is in the script itself. The changes made in this recent release were all minor bug fixes
redge
1000
1000
Posts: 6797
Joined: 2004-07-03 17:05
Location: Switzerland - Geneva

Re: Stable ChunkVNC Repeater - Perl Script

Post by redge »

i see only single file inside zip, no changelog
would be good the know the list fix and feature before download is'nt ?
UltraVNC 1.0.9.6.1 (built 20110518)
OS Win: xp home + vista business + 7 home
only experienced user, not developer
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

"The changes log is in the script itself"...

Open the file "ultravnc_repeater.pl" and read the comments at the top of the file.
RUS
8
8
Posts: 10
Joined: 2010-12-16 19:52

Re: Stable ChunkVNC Repeater - Perl Script

Post by RUS »

happy new year!
tossed chunkrepeater.pl in Russian hosting, still does not work. incidentally hosting inexpensive and fast, supports the php, cgi
http://www.valuehost.ru/en/hosting/abou ... ?thread=26
rat, be a man, help ....
Last edited by RUS on 2011-01-04 20:06, edited 1 time in total.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

Please learn to program in Perl and then explain it all to me... ;)
RUS
8
8
Posts: 10
Joined: 2010-12-16 19:52

Re: Stable ChunkVNC Repeater - Perl Script

Post by RUS »

Rat! Thank you very much for the help ....! where the error?

repeater.log

perl module IO::Socket::INET6 not available: no IPv6 support.
ultravnc_repeater: error: client listen on port 5901: Address already in use -
perl module IO::Socket::INET6 not available: no IPv6 support.
ultravnc_repeater: error: client listen on port 5901: Address already in use -
Last edited by RUS on 2011-01-03 19:21, edited 1 time in total.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

I've posted a modification to the UltraVNC Perl repeater script to prevent the "Another user is already listening on this ID - Bad Connection" error appearing when the viewer session has been manually cancelled previously by the user.

Basically, I modified the "established_linux_proc()" function to assume that if the Socket number is not found in the TCP dump then it is no longer connected.

The updated script may be downloaded from here: http://www.vuware.com/chunkvnc/ultravnc_repeater.zip
Last edited by Rat on 2011-01-19 06:52, edited 1 time in total.
Rat
80
80
Posts: 182
Joined: 2004-11-01 02:11

Re: Stable ChunkVNC Repeater - Perl Script

Post by Rat »

The script's original author, (Karl Runge) has generously donated his time and effort to release an updated version of this script with new features and bug fixes.

I have also made some minor modifications. I recommend to everyone that they upgrade to this version. Please read the documentation included in the script header, (this has also been included for your convenience below).

The script may be downloaded from here: http://www.vuware.com/chunkvnc/ultravnc_repeater.zip
# 2011-04-06: Modified by Karl Runge and Keith Willis <ratchunk@gmail.com>
#
# Notes:
# ------
# 1. This is a new release which has been significantly modified by Karl Runge.
# 2. In Refuse Mode the "Another user is already listening on this ID - Bad Connection" error will be displayed
# if a new connection is being established on the same ID when the socket is still open.
# 3. Karl re-wrote this version using the environment variable array "$ENV" to store any command-line and CGI arguments whilst still retaining the original support for environment variables.
# I have retained this more flexible approach and have also included initialisation for some environment variable default values.
#
# Changes List:
# -------------
# 1. Accept command line arguments instead of using environment variables
# 2. Added CGI support so that the script can be started from a HTTP request.
# (Karl has noted some security issues with this approach and I also suggest only using this if you wish to write a web interface to the script)
# 3. Removed command-line looping argument from forked child processes to prevent them re-forking indefinitely and thus creating a "Fork Bomb"
# 4. Modified "established_linux_proc()" function to assume that if the Socket number is not found in the TCP dump then it is no longer connected.
# This prevents the "Another user is already listening on this ID - Bad Connection" error appearing when the viewer session has been manually cancelled previously by the user.
# 5. Added "clean_connections()" function provided by Karl Runge to prevent orphaned child processes being spawned in a CLOSE_WAIT state if a VNC server disconnects without first having had a client connect.
#
# To Do:
# ------
# 1. Add Daemon Process Kill functionality
# 2. Add Authentication
# 3. Add a way to query current connections
# 4. Provide a better technique for the "established()" function.
# 5. Add support for multiple clients to connect concurrently to the same server.
Last edited by Rat on 2011-04-06 13:42, edited 1 time in total.
User avatar
supercoe
400
400
Posts: 1732
Joined: 2009-07-20 21:27
Location: Walker, MN
Contact:

Re: Stable ChunkVNC Repeater - Perl Script

Post by supercoe »

Thanks for the update Rat, waiting for Karl to do some more of his genius coding is something I've been looking forward to. :D
http://www.chunkvnc.com - ChunkVNC - Free PC Remote control with the Open Source UltraVNC wrapper InstantSupport!
Post Reply