ultravnc_repeater.pl scripts, find_display try FD_XDM on failure, -quiet and -storepasswd changes, better port 113 testing.pull/1/head
runge
15 years ago
parent
8f5c9ef01e
commit
d6c012e968
@ -1,3 +1,3 @@
|
|||||||
SUBDIRS = turbovnc
|
SUBDIRS = turbovnc
|
||||||
DIST_SUBDIRS = turbovnc
|
DIST_SUBDIRS = turbovnc
|
||||||
EXTRA_DIST=README blockdpy.c dtVncPopup rx11vnc rx11vnc.pl shm_clear ranfb.pl slide.pl vcinject.pl x11vnc_loop Xdummy
|
EXTRA_DIST=README blockdpy.c dtVncPopup rx11vnc rx11vnc.pl shm_clear ranfb.pl slide.pl vcinject.pl x11vnc_loop Xdummy ultravnc_repeater.pl connect_switch
|
||||||
|
|||||||
@ -0,0 +1,422 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
#
|
||||||
|
# Copyright (c) 2006-2009 by Karl J. Runge <runge@karlrunge.com>
|
||||||
|
#
|
||||||
|
# connect_switch 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.
|
||||||
|
#
|
||||||
|
# connect_switch 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 connect_switch; if not, write to the Free Software
|
||||||
|
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
|
||||||
|
# or see <http://www.gnu.org/licenses/>.
|
||||||
|
#
|
||||||
|
#
|
||||||
|
# connect_switch:
|
||||||
|
#
|
||||||
|
# A kludge script that sits between web clients and a mod_ssl (https)
|
||||||
|
# enabled apache webserver.
|
||||||
|
#
|
||||||
|
# If an incoming web client connection makes a proxy CONNECT request
|
||||||
|
# it is handled directly by this script (apache is not involved).
|
||||||
|
# Otherwise, all other connections are forwarded to the apache webserver.
|
||||||
|
#
|
||||||
|
# This can be useful for VNC redirection using an existing https (port
|
||||||
|
# 443) webserver, thereby not requiring a 2nd (non-https) port open on
|
||||||
|
# the firewall for the CONNECT requests.
|
||||||
|
#
|
||||||
|
# It does not seem possible (to me) to achieve this entirely within apache
|
||||||
|
# because the CONNECT request appears to be forwarded encrypted to
|
||||||
|
# the remote host and so the SSL dies immediately.
|
||||||
|
#
|
||||||
|
# Note: There is no need to use this script for a non-ssl apache webserver
|
||||||
|
# port because mod_proxy works fine for doing the switching all inside
|
||||||
|
# apache (see ProxyRequests and AllowCONNECT parameters).
|
||||||
|
#
|
||||||
|
# Apache configuration:
|
||||||
|
#
|
||||||
|
# The mod_ssl configuration is often in a file named ssl.conf. In the
|
||||||
|
# simplest case you change something like this:
|
||||||
|
#
|
||||||
|
# From:
|
||||||
|
#
|
||||||
|
# Listen 443
|
||||||
|
#
|
||||||
|
# <VirtualHost _default_:443>
|
||||||
|
# ...
|
||||||
|
# </VirtualHost>
|
||||||
|
#
|
||||||
|
# To:
|
||||||
|
#
|
||||||
|
# Listen 127.0.0.1:443
|
||||||
|
#
|
||||||
|
# <VirtualHost _default_:443>
|
||||||
|
# ...
|
||||||
|
# </VirtualHost>
|
||||||
|
#
|
||||||
|
# (i.e. just change the Listen directive).
|
||||||
|
#
|
||||||
|
# If you have mod_ssl listening on a different internal port, you do
|
||||||
|
# not need to specify the localhost Listen address.
|
||||||
|
#
|
||||||
|
# It is probably a good idea to set $listen_host below to the known
|
||||||
|
# IP address you want the service to listen on (to avoid localhost where
|
||||||
|
# apache is listening).
|
||||||
|
|
||||||
|
|
||||||
|
############################################################################
|
||||||
|
# The defaults for hosts and ports (you can override them below if needed):
|
||||||
|
#
|
||||||
|
# Look below for these environment variables that let you set the various
|
||||||
|
# parameters without needing to edit this script:
|
||||||
|
#
|
||||||
|
# CONNECT_SWITCH_LISTEN
|
||||||
|
# CONNECT_SWITCH_HTTPD
|
||||||
|
# CONNECT_SWITCH_ALLOWED
|
||||||
|
# CONNECT_SWITCH_ALLOW_FILE
|
||||||
|
# CONNECT_SWITCH_VERBOSE
|
||||||
|
# CONNECT_SWITCH_APPLY_VNC_OFFSET
|
||||||
|
# CONNECT_SWITCH_VNC_OFFSET
|
||||||
|
|
||||||
|
my $hostname = `hostname`;
|
||||||
|
chomp $hostname;
|
||||||
|
|
||||||
|
my $listen_host = $hostname;
|
||||||
|
my $listen_port = 443;
|
||||||
|
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_LISTEN}) {
|
||||||
|
# E.g. CONNECT_SWITCH_LISTEN=192.168.0.32:443
|
||||||
|
($listen_host, $listen_port) = split(/:/, $ENV{CONNECT_SWITCH_LISTEN});
|
||||||
|
}
|
||||||
|
|
||||||
|
my $httpd_host = 'localhost';
|
||||||
|
my $httpd_port = 443;
|
||||||
|
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_HTTPD}) {
|
||||||
|
# E.g. CONNECT_SWITCH_HTTPD=127.0.0.1:443
|
||||||
|
($httpd_host, $httpd_port) = split(/:/, $ENV{CONNECT_SWITCH_HTTPD});
|
||||||
|
}
|
||||||
|
|
||||||
|
############################################################################
|
||||||
|
# You can/should override the host/port settings here:
|
||||||
|
#
|
||||||
|
#$listen_host = '23.45.67.89'; # set to your interface IP number.
|
||||||
|
#$listen_port = 555; # and/or nonstandard port.
|
||||||
|
#$httpd_host = 'somehost'; # maybe you redir https to another machine.
|
||||||
|
#$httpd_port = 666; # and/or nonstandard port.
|
||||||
|
|
||||||
|
# You must set the allowed host:port CONNECT redirection list.
|
||||||
|
# Only these host:port pairs will be redirected to.
|
||||||
|
#
|
||||||
|
my @allowed = qw(
|
||||||
|
machine1:5915
|
||||||
|
machine2:5900
|
||||||
|
);
|
||||||
|
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_ALLOWED}) {
|
||||||
|
#
|
||||||
|
# E.g. CONNECT_SWITCH_ALLOWED=machine1:5915,machine2:5900
|
||||||
|
#
|
||||||
|
@allowed = split(/,/, $ENV{CONNECT_SWITCH_ALLOWED});
|
||||||
|
}
|
||||||
|
|
||||||
|
# Or you could also use an external "allow file".
|
||||||
|
# They get added to the @allowed list.
|
||||||
|
# The file is re-read for each new connection.
|
||||||
|
#
|
||||||
|
# Format of $allow_file:
|
||||||
|
#
|
||||||
|
# host1 vncdisp
|
||||||
|
# host2 vncdisp
|
||||||
|
#
|
||||||
|
# where, e.g. vncdisp = 15 => port 5915, say
|
||||||
|
#
|
||||||
|
# joesbox 15
|
||||||
|
# fredsbox 15
|
||||||
|
# rupert 1
|
||||||
|
|
||||||
|
my $allow_file = '/dist/apache/2.0/conf/vnc.hosts';
|
||||||
|
$allow_file = '';
|
||||||
|
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_ALLOW_FILE}) {
|
||||||
|
# E.g. CONNECT_SWITCH_ALLOW_FILE=/usr/local/etc/allow.txt
|
||||||
|
$allow_file = $ENV{CONNECT_SWITCH_ALLOW_FILE};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Set to 1 to re-map to vnc port, e.g. 'hostname 15' to 'hostname 5915'
|
||||||
|
# i.e. assume a port 0 <= port < 200 is actually a VNC display
|
||||||
|
# and add 5900 to it. Set to 0 to not do the mapping.
|
||||||
|
# Note that negative ports, e.g. 'joesbox -22' go directly to -port.
|
||||||
|
#
|
||||||
|
my $apply_vnc_offset = 1;
|
||||||
|
my $vnc_offset = 5900;
|
||||||
|
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_APPLY_VNC_OFFSET}) {
|
||||||
|
# E.g. CONNECT_SWITCH_APPLY_VNC_OFFSET=0
|
||||||
|
$apply_vnc_offset = $ENV{CONNECT_SWITCH_APPLY_VNC_OFFSET};
|
||||||
|
}
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_VNC_OFFSET}) {
|
||||||
|
# E.g. CONNECT_SWITCH_VNC_OFFSET=6000
|
||||||
|
$vnc_offset = $ENV{CONNECT_SWITCH_VNC_OFFSET};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Set to 1 for more debugging output:
|
||||||
|
#
|
||||||
|
my $verbose = 0;
|
||||||
|
|
||||||
|
if (exists $ENV{CONNECT_SWITCH_VERBOSE}) {
|
||||||
|
# E.g. CONNECT_SWITCH_VERBOSE=1
|
||||||
|
$verbose = $ENV{CONNECT_SWITCH_VERBOSE};
|
||||||
|
}
|
||||||
|
|
||||||
|
############################################################################
|
||||||
|
# No need for any changes below here.
|
||||||
|
|
||||||
|
use IO::Socket::INET;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
my $killpid = 1;
|
||||||
|
|
||||||
|
setpgrp(0, 0);
|
||||||
|
|
||||||
|
my $listen_sock = IO::Socket::INET->new(
|
||||||
|
Listen => 10,
|
||||||
|
LocalAddr => $listen_host,
|
||||||
|
LocalPort => $listen_port,
|
||||||
|
Proto => "tcp"
|
||||||
|
);
|
||||||
|
|
||||||
|
if (! $listen_sock) {
|
||||||
|
die "connect_switch: $!\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
my $current_fh1 = '';
|
||||||
|
my $current_fh2 = '';
|
||||||
|
|
||||||
|
my $conn = 0;
|
||||||
|
|
||||||
|
while (1) {
|
||||||
|
$conn++;
|
||||||
|
print STDERR "listening for connection: $conn\n" if $verbose;
|
||||||
|
my ($client, $ip) = $listen_sock->accept();
|
||||||
|
if (! $client) {
|
||||||
|
fsleep(0.5);
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
print STDERR "conn: $conn -- ", $client->peerhost(), "\n" if $verbose;
|
||||||
|
|
||||||
|
my $pid = fork();
|
||||||
|
if (! defined $pid) {
|
||||||
|
die "connect_switch: $!\n";
|
||||||
|
} elsif ($pid) {
|
||||||
|
wait;
|
||||||
|
next;
|
||||||
|
} else {
|
||||||
|
close $listen_sock;
|
||||||
|
if (fork) {
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
setpgrp(0, 0);
|
||||||
|
handle_conn($client);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub handle_conn {
|
||||||
|
my $client = shift;
|
||||||
|
|
||||||
|
my $start = time();
|
||||||
|
|
||||||
|
my @allow = @allowed;
|
||||||
|
|
||||||
|
if ($allow_file && -f $allow_file) {
|
||||||
|
if (open(ALLOW, "<$allow_file")) {
|
||||||
|
while (<ALLOW>) {
|
||||||
|
next if /^\s*#/;
|
||||||
|
next if /^\s*$/;
|
||||||
|
chomp;
|
||||||
|
my ($host, $dpy) = split(' ', $_);
|
||||||
|
next if ! defined $host;
|
||||||
|
next if ! defined $dpy;
|
||||||
|
if ($dpy < 0) {
|
||||||
|
$dpy = -$dpy;
|
||||||
|
} elsif ($apply_vnc_offset) {
|
||||||
|
$dpy += $vnc_offset if $dpy < 200;
|
||||||
|
}
|
||||||
|
push @allow, "$host:$dpy";
|
||||||
|
}
|
||||||
|
close(ALLOW);
|
||||||
|
} else {
|
||||||
|
warn "$allow_file: $!\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $str = '';
|
||||||
|
my $N = 0;
|
||||||
|
my $isconn = 1;
|
||||||
|
for (my $i = 0; $i < 7; $i++) {
|
||||||
|
my $b;
|
||||||
|
sysread($client, $b, 1);
|
||||||
|
$str .= $b;
|
||||||
|
$N++;
|
||||||
|
print STDERR "read: '$str'\n" if $verbose;
|
||||||
|
my $cstr = substr('CONNECT', 0, $i+1);
|
||||||
|
if ($str ne $cstr) {
|
||||||
|
$isconn = 0;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $sock = '';
|
||||||
|
if ($isconn) {
|
||||||
|
while ($str !~ /\r\n\r\n/) {
|
||||||
|
my $b;
|
||||||
|
sysread($client, $b, 1);
|
||||||
|
$str .= $b;
|
||||||
|
}
|
||||||
|
print STDERR "read: $str\n" if $verbose;
|
||||||
|
|
||||||
|
my $ok = 0;
|
||||||
|
my $hostport = '';
|
||||||
|
my $http_vers = '1.0';
|
||||||
|
if ($str =~ /^CONNECT\s+(\S+)\s+HTTP\/(\S+)/) {
|
||||||
|
$hostport = $1;
|
||||||
|
$http_vers = $2;
|
||||||
|
foreach my $hp (@allow) {
|
||||||
|
if ($hp eq $hostport) {
|
||||||
|
$ok = 1;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (! $ok) {
|
||||||
|
close $client;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
my ($host, $port) = split(/:/, $hostport);
|
||||||
|
|
||||||
|
print STDERR "connecting to: $host:$port\n" if $verbose;
|
||||||
|
|
||||||
|
$sock = IO::Socket::INET->new(
|
||||||
|
PeerAddr => $host,
|
||||||
|
PeerPort => $port,
|
||||||
|
Proto => "tcp"
|
||||||
|
);
|
||||||
|
my $msg;
|
||||||
|
if ($sock) {
|
||||||
|
$msg = "HTTP/$http_vers 200 Connection Established\r\n"
|
||||||
|
. "Proxy-agent: connect_switch v0.2\r\n\r\n";
|
||||||
|
} else {
|
||||||
|
$msg = "HTTP/$http_vers 502 Bad Gateway\r\n"
|
||||||
|
. "Connection: close\r\n\r\n";
|
||||||
|
}
|
||||||
|
syswrite($client, $msg, length($msg));
|
||||||
|
$str = '';
|
||||||
|
} else {
|
||||||
|
print STDERR "connecting to: $httpd_host:$httpd_port\n"
|
||||||
|
if $verbose;
|
||||||
|
$sock = IO::Socket::INET->new(
|
||||||
|
PeerAddr => $httpd_host,
|
||||||
|
PeerPort => $httpd_port,
|
||||||
|
Proto => "tcp"
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (! $sock) {
|
||||||
|
close $client;
|
||||||
|
die "connect_switch: $!\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
$current_fh1 = $client;
|
||||||
|
$current_fh2 = $sock;
|
||||||
|
|
||||||
|
$SIG{TERM} = sub {print STDERR "got sigterm\[$$]\n" if $verbose; close $current_fh1; close $current_fh2; exit 0};
|
||||||
|
|
||||||
|
my $parent = $$;
|
||||||
|
if (my $child = fork()) {
|
||||||
|
xfer($sock, $client, 'S->C');
|
||||||
|
if ($killpid) {
|
||||||
|
fsleep(0.5);
|
||||||
|
kill 'TERM', $child;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if ($str ne '' && $N > 0) {
|
||||||
|
syswrite($sock, $str, $N);
|
||||||
|
}
|
||||||
|
xfer($client, $sock, 'C->S');
|
||||||
|
if ($killpid) {
|
||||||
|
fsleep(0.75);
|
||||||
|
kill 'TERM', $parent;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if ($verbose) {
|
||||||
|
my $dt = time() - $start;
|
||||||
|
print STDERR "dt\[$$]: $dt\n";
|
||||||
|
}
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub xfer {
|
||||||
|
my($in, $out, $lab) = @_;
|
||||||
|
my ($RIN, $WIN, $EIN, $ROUT);
|
||||||
|
$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/;
|
||||||
|
print STDERR "connect_switch\[$lab/$conn/$$]: $!\n";
|
||||||
|
last;
|
||||||
|
} elsif ($len == 0) {
|
||||||
|
print STDERR "connect_switch\[$lab/$conn/$$]: "
|
||||||
|
. "Input is EOF.\n";
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (0) {
|
||||||
|
# verbose debugging of data:
|
||||||
|
syswrite(STDERR , "\n$lab: ", 6);
|
||||||
|
syswrite(STDERR , $buf, $len);
|
||||||
|
}
|
||||||
|
|
||||||
|
my $offset = 0;
|
||||||
|
my $quit = 0;
|
||||||
|
while ($len) {
|
||||||
|
my $written = syswrite($out, $buf, $len, $offset);
|
||||||
|
if (! defined $written) {
|
||||||
|
print STDERR "connect_switch\[$lab/$conn/$$]: "
|
||||||
|
. "Output is EOF. $!\n";
|
||||||
|
$quit = 1;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
$len -= $written;
|
||||||
|
$offset += $written;
|
||||||
|
}
|
||||||
|
last if $quit;
|
||||||
|
}
|
||||||
|
close($in);
|
||||||
|
close($out);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub fsleep {
|
||||||
|
my ($time) = @_;
|
||||||
|
select(undef, undef, undef, $time) if $time;
|
||||||
|
}
|
||||||
@ -0,0 +1,424 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
#
|
||||||
|
# Copyright (c) 2009 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/>.
|
||||||
|
#
|
||||||
|
|
||||||
|
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 us up to the client and server to manage that
|
||||||
|
and whether to encrypt the session, etc.
|
||||||
|
|
||||||
|
usage: ultravnc_repeater.pl [-r] [client_port [server_port]]
|
||||||
|
|
||||||
|
Use -r to refuse new server/client connections with an existing
|
||||||
|
server/client ID. The default is to close the previous one.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
ultravnc_repeater.pl -r
|
||||||
|
ultravnc_repeater.pl 5901
|
||||||
|
ultravnc_repeater.pl 5901 5501
|
||||||
|
|
||||||
|
';
|
||||||
|
|
||||||
|
use warnings;
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use IO::Socket::INET;
|
||||||
|
use IO::Select;
|
||||||
|
|
||||||
|
my $prog = 'ultravnc_repeater.pl';
|
||||||
|
my %ID;
|
||||||
|
|
||||||
|
my $refuse = 0;
|
||||||
|
my $init_timeout = 3;
|
||||||
|
|
||||||
|
if (@ARGV && $ARGV[0] =~ /-h/) {
|
||||||
|
print $usage;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
if (@ARGV && $ARGV[0] eq '-r') {
|
||||||
|
$refuse = 1;
|
||||||
|
shift;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $client_port = shift;
|
||||||
|
my $server_port = shift;
|
||||||
|
|
||||||
|
$client_port = 5900 unless $client_port;
|
||||||
|
$server_port = 5500 unless $server_port;
|
||||||
|
|
||||||
|
|
||||||
|
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,
|
||||||
|
Proto => "tcp"
|
||||||
|
);
|
||||||
|
if (! $client_listen) {
|
||||||
|
cleanup();
|
||||||
|
die "$prog: error: client listen on port $client_port: $!\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
my $server_listen = IO::Socket::INET->new(
|
||||||
|
Listen => 10,
|
||||||
|
LocalPort => $server_port,
|
||||||
|
Proto => "tcp"
|
||||||
|
);
|
||||||
|
if (! $server_listen) {
|
||||||
|
cleanup();
|
||||||
|
die "$prog: error: server listen on port $server_port: $!\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
my $select = new IO::Select();
|
||||||
|
if (! select) {
|
||||||
|
cleanup();
|
||||||
|
die "$prog: select $!\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
$select->add($client_listen);
|
||||||
|
$select->add($server_listen);
|
||||||
|
|
||||||
|
$SIG{INT} = sub {cleanup(); exit;};
|
||||||
|
$SIG{TERM} = sub {cleanup(); exit;};
|
||||||
|
|
||||||
|
my $SOCK1 = '';
|
||||||
|
my $SOCK2 = '';
|
||||||
|
my $CURR = '';
|
||||||
|
|
||||||
|
print "watching for connections on ports $server_port/server and $client_port/client\n";
|
||||||
|
|
||||||
|
select(STDERR); $| = 1;
|
||||||
|
select(STDOUT); $| = 1;
|
||||||
|
|
||||||
|
my $alarm_sock = '';
|
||||||
|
my $got_alarm = 0;
|
||||||
|
sub alarm_handler {
|
||||||
|
print "$prog: got sig alarm.\n";
|
||||||
|
if ($alarm_sock ne '') {
|
||||||
|
close $alarm_sock;
|
||||||
|
}
|
||||||
|
$alarm_sock = '';
|
||||||
|
$got_alarm = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
while (my @ready = $select->can_read()) {
|
||||||
|
foreach my $fh (@ready) {
|
||||||
|
if ($fh == $client_listen) {
|
||||||
|
print "new vnc client connecting at ", scalar(localtime), "\n";
|
||||||
|
} elsif ($fh == $server_listen) {
|
||||||
|
print "new vnc server connecting at ", scalar(localtime), "\n";
|
||||||
|
}
|
||||||
|
my $sock = $fh->accept();
|
||||||
|
if (! $sock) {
|
||||||
|
print "$prog: accept $!\n";
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($fh == $client_listen) {
|
||||||
|
my $str = "RFB 000.000\n";
|
||||||
|
my $len = length $str;
|
||||||
|
my $n = syswrite($sock, $str, $len, 0);
|
||||||
|
if ($n != $len) {
|
||||||
|
print "$prog: bad $str write: $n != $len $!\n";
|
||||||
|
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) {
|
||||||
|
print "$prog: read timed out: $!\n";
|
||||||
|
} elsif (! defined $n) {
|
||||||
|
print "$prog: read error: $!\n";
|
||||||
|
} elsif ($repeater_bufsize > 0 && $n != $size) {
|
||||||
|
print "$prog: short read $n != $size $!\n";
|
||||||
|
close $sock;
|
||||||
|
} elsif ($fh == $client_listen) {
|
||||||
|
do_new_client($sock, $buf);
|
||||||
|
} elsif ($fh == $server_listen) {
|
||||||
|
do_new_server($sock, $buf);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub do_new_client {
|
||||||
|
my ($sock, $buf) = @_;
|
||||||
|
|
||||||
|
if ($buf =~ /^ID:(\w+)/) {
|
||||||
|
my $id = $1;
|
||||||
|
if (exists $ID{$id}) {
|
||||||
|
if ($ID{$id}{client}) {
|
||||||
|
print "refusing extra vnc client for ID:$id\n";
|
||||||
|
close $sock;
|
||||||
|
return;
|
||||||
|
if ($refuse) {
|
||||||
|
print "refusing extra vnc client for ID:$id\n";
|
||||||
|
close $sock;
|
||||||
|
return;
|
||||||
|
} else {
|
||||||
|
print "closing and deleting previous vnc client with ID:$id\n";
|
||||||
|
close $ID{$id}{sock};
|
||||||
|
|
||||||
|
print "storing new vnc client with ID:$id\n";
|
||||||
|
$ID{$id}{client} = 1;
|
||||||
|
$ID{$id}{sock} = $sock;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
print "hooking up new vnc client with existing vnc server for ID:$id\n";
|
||||||
|
my $sock2 = $ID{$id}{sock};
|
||||||
|
delete $ID{$id};
|
||||||
|
hookup($sock, $sock2, "ID:$id");
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
print "storing new vnc client with ID:$id\n";
|
||||||
|
$ID{$id}{client} = 1;
|
||||||
|
$ID{$id}{sock} = $sock;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
my $str = sprintf("%s", $buf);
|
||||||
|
my $host = '';
|
||||||
|
my $port = '';
|
||||||
|
if ($str =~ /^(.+):(\d+)/) {
|
||||||
|
$host = $1;
|
||||||
|
$port = $2;
|
||||||
|
} else {
|
||||||
|
$host = $str;
|
||||||
|
$port = 5900;
|
||||||
|
}
|
||||||
|
if ($port < 0) {
|
||||||
|
my $pnew = -$port;
|
||||||
|
print "resetting port from $port to $pnew\n";
|
||||||
|
$port = $pnew;
|
||||||
|
} elsif ($port < 200) {
|
||||||
|
my $pnew = $port + 5900;
|
||||||
|
print "resetting port from $port to $pnew\n";
|
||||||
|
$port = $pnew;
|
||||||
|
}
|
||||||
|
print "making vnc client connection directly to vnc server $host:$port\n";
|
||||||
|
my $sock2 = IO::Socket::INET->new(
|
||||||
|
PeerAddr => $host,
|
||||||
|
PeerPort => $port,
|
||||||
|
Proto => "tcp"
|
||||||
|
);
|
||||||
|
if (!$sock2) {
|
||||||
|
print "failed to connect to $host:$port\n";
|
||||||
|
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}) {
|
||||||
|
if (! $ID{$id}{client}) {
|
||||||
|
if ($refuse) {
|
||||||
|
print "refusing extra vnc server for ID:$id\n";
|
||||||
|
close $sock;
|
||||||
|
return;
|
||||||
|
} else {
|
||||||
|
print "closing and deleting previous vnc server with ID:$id\n";
|
||||||
|
close $ID{$id}{sock};
|
||||||
|
|
||||||
|
print "storing new vnc server with ID:$id\n";
|
||||||
|
$ID{$id}{client} = 0;
|
||||||
|
$ID{$id}{sock} = $sock;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
print "hooking up new vnc server with existing vnc client for ID:$id\n";
|
||||||
|
my $sock2 = $ID{$id}{sock};
|
||||||
|
delete $ID{$id};
|
||||||
|
hookup($sock, $sock2, "ID:$id");
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
print "storing new vnc server with ID:$id\n";
|
||||||
|
$ID{$id}{client} = 0;
|
||||||
|
$ID{$id}{sock} = $sock;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
print "invalid ID:NNNNN string for vnc server: $buf\n";
|
||||||
|
close $sock;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub handler {
|
||||||
|
print STDERR "$prog\[$$/$CURR]: got SIGTERM.\n";
|
||||||
|
close $SOCK1 if $SOCK1;
|
||||||
|
close $SOCK2 if $SOCK2;
|
||||||
|
exit;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub hookup {
|
||||||
|
my ($sock1, $sock2, $tag) = @_;
|
||||||
|
|
||||||
|
my $worker = fork();
|
||||||
|
|
||||||
|
if (! defined $worker) {
|
||||||
|
print "failed to fork worker: $!\n";
|
||||||
|
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/;
|
||||||
|
print STDERR "$prog\[$$/$CURR]: $!\n";
|
||||||
|
last;
|
||||||
|
} elsif ($len == 0) {
|
||||||
|
print STDERR "$prog\[$$/$CURR]: 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 "$prog\[$$/$CURR]: Output is EOF. $!\n";
|
||||||
|
$quit = 1;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
$len -= $written;
|
||||||
|
$offset += $written;
|
||||||
|
}
|
||||||
|
last if $quit;
|
||||||
|
}
|
||||||
|
close($out);
|
||||||
|
close($in);
|
||||||
|
print STDERR "$prog\[$$/$CURR]: finished xfer.\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub xfer_both {
|
||||||
|
my ($sock1, $sock2) = @_;
|
||||||
|
|
||||||
|
my $parent = $$;
|
||||||
|
|
||||||
|
my $child = fork();
|
||||||
|
|
||||||
|
if (! defined $child) {
|
||||||
|
print STDERR "$prog\[$$/$CURR] failed to fork: $!\n";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
$SIG{TERM} = "handler";
|
||||||
|
$SIG{INT} = "handler";
|
||||||
|
|
||||||
|
if ($child) {
|
||||||
|
print STDERR "$prog parent[$$/$CURR] 1 -> 2\n";
|
||||||
|
xfer($sock1, $sock2);
|
||||||
|
select(undef, undef, undef, 0.25);
|
||||||
|
if (kill 0, $child) {
|
||||||
|
select(undef, undef, undef, 0.9);
|
||||||
|
if (kill 0, $child) {
|
||||||
|
print STDERR "$prog\[$$/$CURR]: kill TERM child $child\n";
|
||||||
|
kill "TERM", $child;
|
||||||
|
} else {
|
||||||
|
print STDERR "$prog\[$$/$CURR]: child $child gone.\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
select(undef, undef, undef, 0.05);
|
||||||
|
print STDERR "$prog child [$$/$CURR] 2 -> 1\n";
|
||||||
|
xfer($sock2, $sock1);
|
||||||
|
select(undef, undef, undef, 0.25);
|
||||||
|
if (kill 0, $parent) {
|
||||||
|
select(undef, undef, undef, 0.8);
|
||||||
|
if (kill 0, $parent) {
|
||||||
|
print STDERR "$prog\[$$/$CURR]: kill TERM parent $parent\n";
|
||||||
|
kill "TERM", $parent;
|
||||||
|
} else {
|
||||||
|
print STDERR "$prog\[$$/$CURR]: parent $parent gone.\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cleanup {
|
||||||
|
close $client_listen if defined $client_listen;
|
||||||
|
close $server_listen if defined $server_listen;
|
||||||
|
foreach my $id (keys %ID) {
|
||||||
|
close $ID{$id}{sock};
|
||||||
|
}
|
||||||
|
}
|
||||||
Loading…
Reference in new issue