bessangel/vncxfer.pl

## vncxfer.pl
#!/usr/bin/perl
#!/usr/local/bin/perl
#
# vncxfer: A CGI script to set up TCP redirection between a VNC Viewer
# and VNC Server using the Web Server as a relay point.
#
# Copy this to a place on a website where CGI scripts will be run.
# e.g. http://somesite.com/cgi-bin/vncxfer
#
# One user goes to the the above URL and chooses a session name and then
# clicks "Submit".  That starts up a helper program on the web server to
# act as a relay.
#
# The other user does the same, using the SAME session name.
#
# The page that is returned to them tells them the port number and VNC
# Host:Display to use in their viewer or VNC server.
#
# The VNC Server makes a reverse VNC connection to the relay point.
# e.g.  somesite:com:5950
#
# The VNC Viewer makes a normal VNC connection to the relay point.
# e.g.  vncviewer somesite:com:50
#
# Unfortunately most Web servers will not allow this sort of thing:
#
#   1) They forbid running CGI programs that run as daemons that listen
#      on TCP ports for incoming connections.
#
#   2) The firewall configuration of the webserver disallows connections
#      to the "session" ports, e.g. 5950, etc.
#

# Put here a list of ports to use for transfer sessions.  The Web server's
# firewall configuration MUST NOT block this port(s).
#
my @allowed_ports = qw(
	5955
	5956
	5957
	5958
	5959
	5960
);

# Maximum time in seconds to wait for both the VNC Viewer
# and VNC Server to connect:
#
my $max_wait = 300;

# The form action="..." program, it may need to be "/cgi-bin/vncxfer", etc.
#
my $program = "vncxfer";


##########################################################################
# no config needed below here.

use POSIX qw(setsid);

my $oldsockets = 0;
if (! $oldsockets) {
	use IO::Socket::INET;
}
my $oldfh = 'LISTEN000';

if (@ARGV && $ARGV[0] =~ /^vncxfer:/) {
	# Started in session helper mode:
	helper($ARGV[0]);
	exit 0;
}

# Parse CGI request:
#
my $request;

if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
} elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
	$request = $ENV{'QUERY_STRING'};
} else {
	$request = $ARGV[0];
}

my %request = &url_decode(split(/[&=]/, $request));

# html for top and bottom:
#
my $htop = "<html><body BGCOLOR=#FFFFFF>\n";
my $hbot = "</body></html>\n";

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

# content-type:
#
print STDOUT "Content-Type: text/html\r\n";

# see if session is set:
#
my $session = '';
if (exists $request{session}) {
	$session = $request{session};
}
$session =~ s/\W//g;	# word characters only.

if ($session eq '') {
	# No session, show the create-a-session form:
	print STDOUT "\r\n";
	print_form();
	exit 0;
}

# determine hostnames and IP addresses:
#
my $server = $ENV{HTTP_HOST};
$server =~ s/:\d+//g;

my ($nm, $aliases, $type, $len, @addrs) = gethostbyname($server);

my $server_ip = join('.', unpack('C4', $addrs[0]));

my $sport = $ENV{SERVER_PORT};

# find an existing session, or start one up:
#
my $port = find_or_start_session($session);

if ($port ne '') {
	# print some http header lines indicating the port:
	#
	my $disp = $port - 5900;
	print STDOUT "VNC-Host-Display: $server:$disp\r\n";
	print STDOUT "VNC-IP-Display: $server_ip:$disp\r\n";
	print STDOUT "VNC-Host-Port: $server:$port\r\n";
	print STDOUT "VNC-IP-Port: $server_ip:$port\r\n";
	print STDOUT "\r\n";

	# print connection info to the browser:
	#
	print STDOUT <<END;
$htop
<b>VNC Transfer (vncxfer)</b>
<p>
Your VNC session name is: $session<br>
Your VNC session port is: $port<br>
Both VNC Viewer and Server must connect within $max_wait seconds.<br>
<p>
For the VNC Viewer, use either of these as VNC Host displays:
<p>
&nbsp;&nbsp;&nbsp;$server:$disp
<p>
&nbsp;&nbsp;&nbsp;$server_ip:$disp
<p>
E.g.:
<pre>
        vncviewer $server_ip:$disp
</pre>
&nbsp;<br>
<p>
For the VNC Server, it needs to do a reverse connection to either of these:
<p>
&nbsp;&nbsp;&nbsp;$server:$port
<p>
&nbsp;&nbsp;&nbsp;$server_ip:$port
<p>
E.g.:
<pre>
        x11vnc -connect $server_ip:$port
</pre>

$hbot
END
} else {
	print STDOUT "\r\n";
	# whoops:
	#
	print STDOUT <<END;
	$htop
	<b>VNC Transfer (vncxfer)</b>
	<p>
	<font color="red">A Free VNC Port could not be found or the helper could not be started!</font>
	$hbot
END

}

exit 0;

#######################################################################

sub url_decode {
	foreach (@_) {
		tr/+/ /;
		s/%(..)/pack("c",hex($1))/ge;
	}
	@_;
}

# starting form:
#
sub print_form {
	print STDOUT <<END;
<html>
<body BGCOLOR=#FFFFFF>
<b>VNC Transfer (vncxfer)</b>
<p>
To start a VNC Transfer agent for you, enter a name for your session:
<p>
<form name="start" action="$program" method="get">
<b>Your Session Name:</b> <input type="text" name="session" value="" size=12>
<b><input type="submit" value="Submit"></b>
<form>
<p>
This name will be used by the other VNC party to identify the session and connect with you.

</body>
</html>
END

}

sub do_listen {
	my $port = shift;
	if (! $oldsockets) {
		my $sock = IO::Socket::INET->new(
			Listen    => 2,
			LocalPort => $port,
			Proto     => "tcp"
		);
		return $sock;
	} else {
		my $AF_INET = 2;
		my $SOCK_STREAM = 1;
		my $SockAddr = 'S n a4 x8';
		my ($n1, $a1, $proto) = getprotobyname('tcp');

		my $us = pack($SockAddr, $AF_INET, $port, "\0\0\0\0");
		my $listen = ++$oldfh;
		my $package = caller;
		$listen =~ s/^[^']+$/$package'$&/;
		if (! socket($listen, $AF_INET, $SOCK_STREAM, $proto)) {
			return '';
		}
		if (! bind($listen, $us)) {
			return '';
		}
		if (! listen($listen, 2)) {
			return '';
		}
		return $listen;
	}
}

sub find_or_start_session {
	my $session = shift;

	chdir("/tmp");

	# we scrape ps(1) output to find an existing session:
	#
	my $ps = "ps";
	if (-f "/usr/ucb/ps") {
		$ps = "/usr/ucb/ps";
	}

	open(PS, "env COLUMNS=256 $ps wwwwwwwwaux |");
	while (<PS>) {
		if (/\bvncxfer:(\w+):(\d+)/) {
			my $s = $1;
			my $p = $2;
			if ($s eq $session) {
				return $p;
			}
		}
	}
	close PS;

	# no session, so we will start it.

	# look for a free port:
	#
	my $use_port = '';
	foreach my $p (@allowed_ports) {
		my $sock = do_listen($p);

		if ($sock) {
			$use_port = $p;
			close $sock;
			last;
		}
        }

	if ($use_port eq '') {
		# all in use.
		return '';
	}

	# start the helper in the background:
	#
	my $pf = fork();
	if (! defined $pf) {
		return '';
	} elsif ($pf) {
		sleep 2;
		wait;
	} else {
		close STDIN;
		close STDOUT;
		close STDERR;
		POSIX::setsid();
		sleep 1;
		system("$0 'vncxfer:$session:$use_port' &");
		exit 0;
	}
	sleep 2;
	return $use_port;
}

# SIGALRM timeout handler:
#
sub timeout {
	close LOG;
	exit 0;
}

sub helper {
	my $tag = shift;

	# set this to somefile for logging:
	#open(LOG, ">>/tmp/vncxfer.log");
	open(LOG, ">/dev/null");
	select(LOG); $| = 1;
	close(STDERR);
	open(STDERR, ">&LOG");


	# split the vncxfer:session:port string:
	#
	my ($name, $session, $port) = split(/:/, $tag, 3);

	# check port:
	#
	if ($port !~ /^\d+$/) {
		print LOG "bad port $tag\n";
		close LOG;
		exit 1;
	}

	# try to listen on port:
	#
	my $sock = do_listen($port);
	if (! $sock) {
		print LOG "bad sock $tag\n";
		close LOG;
		exit 1;
	}

	# set timeout handler:
	#
	$SIG{ARLM} = \&timeout;
	alarm($max_wait);

	# wait for first connection:
	#
	my ($client1, $ip1, $client2, $ip2);
	if (! $oldsockets) {
		($client1, $ip1) = $sock->accept();
	} else {
		$client1 = ++$oldfh;
		my $package = caller;
		$client1 =~ s/^[^']+$/$package'$&/;
		$ip1 = accept($client1, $sock);
	}
	print LOG "1st connection $tag $ip1\n";

	# wait for second connection:
	#
	if (! $oldsockets) {
		($client2, $ip2) = $sock->accept();
	} else {
		$client2 = ++$oldfh;
		my $package = caller;
		$client2 =~ s/^[^']+$/$package'$&/;
		$ip2 = accept($client2, $sock);
	}
	print LOG "2nd connection $tag $ip2\n";

	alarm(0);
	$SIG{ALRM} = 'DEFAULT';

	# no need to listen anymore:
	#
	close($sock);

	# fork a child to handle I/O one direction, and
	# we do the other direction:
	#
	my $parent = $$;
	my $child = fork;
	if (! defined $child) {
		exit 1;
	}

	if ($child) {
		print LOG "pproxy parent\[$$]  STDIN -> socket\n";
		xfer($client1, $client2);
		select(undef, undef, undef, 0.25);
		if (kill 0, $child) {
			select(undef, undef, undef, 1.5);
			kill "TERM", $child;
		}
	} else {
		print LOG "pproxy child \[$$]  socket -> STDOUT\n";
		xfer($client2, $client1);
		select(undef, undef, undef, 0.25);
		if (kill 0, $parent) {
			select(undef, undef, undef, 1.5);
			kill "TERM", $parent;
		}
	}
	exit;
}

# utlity to transfer bytes from one socket to another:
# taken from PPROXY in ss_vncviewer.
#
sub xfer {
	my($in, $out) = @_;
	$RIN = $WIN = $EIN = "";
	$ROUT = "";
	vec($RIN, fileno($in), 1) = 1;
	vec($WIN, fileno($in), 1) = 1;
	$EIN = $RIN | $WIN;

	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/;
			print STDERR "pproxy\[$$]: $!\n";
			last;
		} elsif ($len == 0) {
			print STDERR "pproxy\[$$]: Input is EOF.\n";
			last;
		}
		my $offset = 0;
		my $quit = 0;
		while ($len) {
			my $written = syswrite($out, $buf, $len, $offset);
			if (! defined $written) {
				print STDERR "pproxy\[$$]: Output is EOF. $!\n";
				$quit = 1;
				last;
			}
			$len -= $written;
			$offset += $written;
		}
		last if $quit;
	}
	close($in);
	close($out);
}
	#!/usr/bin/perl
	#!/usr/local/bin/perl
	#
	# vncxfer: A CGI script to set up TCP redirection between a VNC Viewer
	# and VNC Server using the Web Server as a relay point.
	#
	# Copy this to a place on a website where CGI scripts will be run.
	# e.g. http://somesite.com/cgi-bin/vncxfer
	#
	# One user goes to the the above URL and chooses a session name and then
	# clicks "Submit". That starts up a helper program on the web server to
	# act as a relay.
	#
	# The other user does the same, using the SAME session name.
	#
	# The page that is returned to them tells them the port number and VNC
	# Host:Display to use in their viewer or VNC server.
	#
	# The VNC Server makes a reverse VNC connection to the relay point.
	# e.g. somesite:com:5950
	#
	# The VNC Viewer makes a normal VNC connection to the relay point.
	# e.g. vncviewer somesite:com:50
	#
	# Unfortunately most Web servers will not allow this sort of thing:
	#
	# 1) They forbid running CGI programs that run as daemons that listen
	# on TCP ports for incoming connections.
	#
	# 2) The firewall configuration of the webserver disallows connections
	# to the "session" ports, e.g. 5950, etc.
	#

	# Put here a list of ports to use for transfer sessions. The Web server's
	# firewall configuration MUST NOT block this port(s).
	#
	my @allowed_ports = qw(
	5955
	5956
	5957
	5958
	5959
	5960
	);

	# Maximum time in seconds to wait for both the VNC Viewer
	# and VNC Server to connect:
	#
	my $max_wait = 300;

	# The form action="..." program, it may need to be "/cgi-bin/vncxfer", etc.
	#
	my $program = "vncxfer";


	##########################################################################
	# no config needed below here.

	use POSIX qw(setsid);

	my $oldsockets = 0;
	if (! $oldsockets) {
	use IO::Socket::INET;
	}
	my $oldfh = 'LISTEN000';

	if (@ARGV && $ARGV[0] =~ /^vncxfer:/) {
	# Started in session helper mode:
	helper($ARGV[0]);
	exit 0;
	}

	# Parse CGI request:
	#
	my $request;

	if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
	} elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
	$request = $ENV{'QUERY_STRING'};
	} else {
	$request = $ARGV[0];
	}

	my %request = &url_decode(split(/[&=]/, $request));

	# html for top and bottom:
	#
	my $htop = "<html><body BGCOLOR=#FFFFFF>\n";
	my $hbot = "</body></html>\n";

	select(STDERR); $\| = 1;
	select(STDOUT); $\| = 1;

	# content-type:
	#
	print STDOUT "Content-Type: text/html\r\n";

	# see if session is set:
	#
	my $session = '';
	if (exists $request{session}) {
	$session = $request{session};
	}
	$session =~ s/\W//g; # word characters only.

	if ($session eq '') {
	# No session, show the create-a-session form:
	print STDOUT "\r\n";
	print_form();
	exit 0;
	}

	# determine hostnames and IP addresses:
	#
	my $server = $ENV{HTTP_HOST};
	$server =~ s/:\d+//g;

	my ($nm, $aliases, $type, $len, @addrs) = gethostbyname($server);

	my $server_ip = join('.', unpack('C4', $addrs[0]));

	my $sport = $ENV{SERVER_PORT};

	# find an existing session, or start one up:
	#
	my $port = find_or_start_session($session);

	if ($port ne '') {
	# print some http header lines indicating the port:
	#
	my $disp = $port - 5900;
	print STDOUT "VNC-Host-Display: $server:$disp\r\n";
	print STDOUT "VNC-IP-Display: $server_ip:$disp\r\n";
	print STDOUT "VNC-Host-Port: $server:$port\r\n";
	print STDOUT "VNC-IP-Port: $server_ip:$port\r\n";
	print STDOUT "\r\n";

	# print connection info to the browser:
	#
	print STDOUT <<END;
	$htop
	<b>VNC Transfer (vncxfer)</b>
	<p>
	Your VNC session name is: $session<br>
	Your VNC session port is: $port<br>
	Both VNC Viewer and Server must connect within $max_wait seconds.<br>
	<p>
	For the VNC Viewer, use either of these as VNC Host displays:
	<p>
	$server:$disp
	<p>
	$server_ip:$disp
	<p>
	E.g.:
	<pre>
	vncviewer $server_ip:$disp
	</pre>
	<br>
	<p>
	For the VNC Server, it needs to do a reverse connection to either of these:
	<p>
	$server:$port
	<p>
	$server_ip:$port
	<p>
	E.g.:
	<pre>
	x11vnc -connect $server_ip:$port
	</pre>

	$hbot
	END
	} else {
	print STDOUT "\r\n";
	# whoops:
	#
	print STDOUT <<END;
	$htop
	<b>VNC Transfer (vncxfer)</b>
	<p>
	<font color="red">A Free VNC Port could not be found or the helper could not be started!</font>
	$hbot
	END

	}

	exit 0;

	#######################################################################

	sub url_decode {
	foreach (@_) {
	tr/+/ /;
	s/%(..)/pack("c",hex($1))/ge;
	}
	@_;
	}

	# starting form:
	#
	sub print_form {
	print STDOUT <<END;
	<html>
	<body BGCOLOR=#FFFFFF>
	<b>VNC Transfer (vncxfer)</b>
	<p>
	To start a VNC Transfer agent for you, enter a name for your session:
	<p>
	<form name="start" action="$program" method="get">
	<b>Your Session Name:</b> <input type="text" name="session" value="" size=12>
	<b><input type="submit" value="Submit"></b>
	<form>
	<p>
	This name will be used by the other VNC party to identify the session and connect with you.

	</body>
	</html>
	END

	}

	sub do_listen {
	my $port = shift;
	if (! $oldsockets) {
	my $sock = IO::Socket::INET->new(
	Listen => 2,
	LocalPort => $port,
	Proto => "tcp"
	);
	return $sock;
	} else {
	my $AF_INET = 2;
	my $SOCK_STREAM = 1;
	my $SockAddr = 'S n a4 x8';
	my ($n1, $a1, $proto) = getprotobyname('tcp');

	my $us = pack($SockAddr, $AF_INET, $port, "\0\0\0\0");
	my $listen = ++$oldfh;
	my $package = caller;
	$listen =~ s/^[^']+$/$package'$&/;
	if (! socket($listen, $AF_INET, $SOCK_STREAM, $proto)) {
	return '';
	}
	if (! bind($listen, $us)) {
	return '';
	}
	if (! listen($listen, 2)) {
	return '';
	}
	return $listen;
	}
	}

	sub find_or_start_session {
	my $session = shift;

	chdir("/tmp");

	# we scrape ps(1) output to find an existing session:
	#
	my $ps = "ps";
	if (-f "/usr/ucb/ps") {
	$ps = "/usr/ucb/ps";
	}

	open(PS, "env COLUMNS=256 $ps wwwwwwwwaux \|");
	while (<PS>) {
	if (/\bvncxfer:(\w+):(\d+)/) {
	my $s = $1;
	my $p = $2;
	if ($s eq $session) {
	return $p;
	}
	}
	}
	close PS;

	# no session, so we will start it.

	# look for a free port:
	#
	my $use_port = '';
	foreach my $p (@allowed_ports) {
	my $sock = do_listen($p);

	if ($sock) {
	$use_port = $p;
	close $sock;
	last;
	}
	}

	if ($use_port eq '') {
	# all in use.
	return '';
	}

	# start the helper in the background:
	#
	my $pf = fork();
	if (! defined $pf) {
	return '';
	} elsif ($pf) {
	sleep 2;
	wait;
	} else {
	close STDIN;
	close STDOUT;
	close STDERR;
	POSIX::setsid();
	sleep 1;
	system("$0 'vncxfer:$session:$use_port' &");
	exit 0;
	}
	sleep 2;
	return $use_port;
	}

	# SIGALRM timeout handler:
	#
	sub timeout {
	close LOG;
	exit 0;
	}

	sub helper {
	my $tag = shift;

	# set this to somefile for logging:
	#open(LOG, ">>/tmp/vncxfer.log");
	open(LOG, ">/dev/null");
	select(LOG); $\| = 1;
	close(STDERR);
	open(STDERR, ">&LOG");


	# split the vncxfer:session:port string:
	#
	my ($name, $session, $port) = split(/:/, $tag, 3);

	# check port:
	#
	if ($port !~ /^\d+$/) {
	print LOG "bad port $tag\n";
	close LOG;
	exit 1;
	}

	# try to listen on port:
	#
	my $sock = do_listen($port);
	if (! $sock) {
	print LOG "bad sock $tag\n";
	close LOG;
	exit 1;
	}

	# set timeout handler:
	#
	$SIG{ARLM} = \&timeout;
	alarm($max_wait);

	# wait for first connection:
	#
	my ($client1, $ip1, $client2, $ip2);
	if (! $oldsockets) {
	($client1, $ip1) = $sock->accept();
	} else {
	$client1 = ++$oldfh;
	my $package = caller;
	$client1 =~ s/^[^']+$/$package'$&/;
	$ip1 = accept($client1, $sock);
	}
	print LOG "1st connection $tag $ip1\n";

	# wait for second connection:
	#
	if (! $oldsockets) {
	($client2, $ip2) = $sock->accept();
	} else {
	$client2 = ++$oldfh;
	my $package = caller;
	$client2 =~ s/^[^']+$/$package'$&/;
	$ip2 = accept($client2, $sock);
	}
	print LOG "2nd connection $tag $ip2\n";

	alarm(0);
	$SIG{ALRM} = 'DEFAULT';

	# no need to listen anymore:
	#
	close($sock);

	# fork a child to handle I/O one direction, and
	# we do the other direction:
	#
	my $parent = $$;
	my $child = fork;
	if (! defined $child) {
	exit 1;
	}

	if ($child) {
	print LOG "pproxy parent\[$$] STDIN -> socket\n";
	xfer($client1, $client2);
	select(undef, undef, undef, 0.25);
	if (kill 0, $child) {
	select(undef, undef, undef, 1.5);
	kill "TERM", $child;
	}
	} else {
	print LOG "pproxy child \[$$] socket -> STDOUT\n";
	xfer($client2, $client1);
	select(undef, undef, undef, 0.25);
	if (kill 0, $parent) {
	select(undef, undef, undef, 1.5);
	kill "TERM", $parent;
	}
	}
	exit;
	}

	# utlity to transfer bytes from one socket to another:
	# taken from PPROXY in ss_vncviewer.
	#
	sub xfer {
	my($in, $out) = @_;
	$RIN = $WIN = $EIN = "";
	$ROUT = "";
	vec($RIN, fileno($in), 1) = 1;
	vec($WIN, fileno($in), 1) = 1;
	$EIN = $RIN \| $WIN;

	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/;
	print STDERR "pproxy\[$$]: $!\n";
	last;
	} elsif ($len == 0) {
	print STDERR "pproxy\[$$]: Input is EOF.\n";
	last;
	}
	my $offset = 0;
	my $quit = 0;
	while ($len) {
	my $written = syswrite($out, $buf, $len, $offset);
	if (! defined $written) {
	print STDERR "pproxy\[$$]: Output is EOF. $!\n";
	$quit = 1;
	last;
	}
	$len -= $written;
	$offset += $written;
	}
	last if $quit;
	}
	close($in);
	close($out);
	}