#!/usr/bin/env perl
#
# ssh / scp wrapper for hosts that insist on a typed password.
#
# Some sites require a password on their login (bastion) host even when an
# SSH key is installed, and sometimes on the hosts behind it as well. Tools
# that run ssh without a terminal -- sshpyk starting a remote Jupyter
# kernel, scp in a script -- then fail or hang at a prompt nobody can
# answer. This wrapper logs in once per hop with the password from your
# keychain, and lets ssh's connection sharing (ControlMaster) carry every
# later command.
#
# Install
# -------
# python -m cubevis.setup installs it as ~/.config/cubevis/hosts/<id>/bin/ssh
# (one copy per computer: a shared home may hold several) and gives its path
# to sshpyk (--ssh), so only the kernels and setup use it. To use it for everything instead:
#   cp ssh ~/bin/ssh && chmod +x ~/bin/ssh && ln -s ssh ~/bin/scp
#   with ~/bin before /usr/bin in PATH.
# README.md beside this file is the guide for that use (setup, rules,
# the password, inside/outside routing, settings, troubleshooting).
# Needs perl, OpenSSH 8.0 or later, and a password store (below).
#
# Rules: which hosts need the password
# ------------------------------------
# Read from $SSH_WRAPPER_RULES if set; otherwise from every one of these
# that exists: ~/.config/ssh-wrapper/rules (your own), and ../ssh/rules
# next to this file (cubevis setup writes it: hosts/<id>/ssh/rules). No rules, or no matching rule: the wrapper does
# nothing at all and runs the real ssh/scp. One rule per line; '#' starts
# a comment:
#
#   <host pattern>[,<pattern>...]  [key=value ...]
#
#   login.example.org      service=example_ssh_pw
#   *.cluster.example.org  service=example_ssh_pw
#
# A pattern is an ssh-style glob (* and ?) matched, case-insensitively,
# against each hop's *effective HostName* (what `ssh -G <hop>` reports), so
# write the real host names, not your ~/.ssh/config aliases. List the hosts
# that ask for a password. A key-only host (a git server, say) should not
# be listed; if it is, the wrapper's login attempt fails harmlessly and the
# command still runs.
#
# Keys (all optional):
#   service=NAME   keychain service name           (default: ssh-wrapper)
#   account=NAME   keychain account name           (default: the hop's
#                  user, i.e. User in ~/.ssh/config, else your login name)
#   backend=B      security | secret-tool | pass | command
#                  (default: $SSH_WRAPPER_BACKEND, else 'security' on
#                  macOS; on Linux 'secret-tool' if installed, else 'pass')
#   pass_name=P    entry in the 'pass' store       (default: the service)
#   command=CMD    for backend=command: a shell command that prints the
#                  password (e.g. a password manager's CLI); the rest of
#                  the line
#   twofactor=yes  the host asks for a second factor (a code, a push): the
#                  wrapper never logs in to it with a stored password.
#                  With a terminal you log in once, and the connection is
#                  shared (ControlPersist); without one (sshpyk, scripts)
#                  the wrapper stops when that connection is not up and
#                  names the command to run in a terminal.
#
# Storing the password
# --------------------
#   macOS:   security add-generic-password -a <account> -s <service> -w
#   Linux:   secret-tool store --label='ssh password' service <service> account <account>
#   pass:    pass insert <pass_name>
#
# Your ~/.ssh/config must give those hosts a ControlPath (and ProxyJump for
# hosts behind the login host); the wrapper supplies ControlMaster and
# ControlPersist for its own login.
#
# How it works
# ------------
# For each hop that matches a rule -- the ProxyJump host(s) first, then the
# destination -- the wrapper checks for a live shared connection
# (`ssh -O check`). If there is none, it logs in once with `ssh <hop> true`
# as the ControlMaster, in a session of its own with no terminal, so ssh
# asks for the password through SSH_ASKPASS -- which is this same file,
# answering from the password store. It allows one password attempt, so a
# wrong stored password cannot lock the account. Then it exec's the real
# ssh/scp, unchanged, which rides on the shared connections.
#
# If that login fails and there is no terminal (sshpyk, git, scripts), the
# wrapper stops with a message instead of running a command that can only
# fail -- and whose ProxyJump helper would make failed attempts of its own.
# With a terminal it hands over and ssh asks you.
#
# Invocations that make no connection (ssh -V, -G, -Q, -O ...) pass
# straight through: git, for one, runs `ssh -G <host>` to identify ssh.
# Options that change where a command goes (-p, -l, -F, -o, -i, -J; scp's
# -P) are used for the checks and the login too.
#
# Checking: `ssh --explain HOST [ssh options]` prints the hops, the rule
# each one matches (or why none does), whether a password is stored, and
# whether a shared connection is up. It logs in nowhere.
#
# Inside or outside: `ssh --reachable HOST [PORT]`, for a `Match exec` line
# in ~/.ssh/config, exits 0 if HOST answers on PORT (default 22) directly
# from here, 1 if not -- so ssh can go straight to a node when this computer
# is on the site's network (or its VPN) and through the login host when it
# is not:
#
#   Match host *.cv.example.org,!login.cv.example.org !exec "~/bin/ssh --reachable %h %p"
#       ProxyJump login.cv.example.org
#
# ssh runs that test before every connection, so the answer is remembered:
# per host (and port) and per *local source address* -- the address this computer
# would send from to reach the host, which the system tells without sending
# anything.  It changes whenever the network does (office, home, VPN up or
# down, a hotel), so a move is never missed: a new network costs one
# connection attempt (at most SSH_WRAPPER_REACHABLE_TIMEOUT seconds,
# default 1) and a known one nothing.  A name that does not resolve is
# "not reachable" at once.  Kept in $XDG_CACHE_HOME/ssh-wrapper/reachable
# (default ~/.cache/...) for SSH_WRAPPER_REACHABLE_TTL seconds (default a
# day); `ssh --reachable --forget` clears it, `-v` says why.
# SSH_WRAPPER_ROUTE=direct or =jump decides without testing.
#
# Debugging: SSH_WRAPPER_DEBUG=1 logs to $SSH_WRAPPER_LOG
# (default ~/.ssh/ssh-wrapper.log).
#
# Stale shared connections (from Darrell's ~/bin copy, 2026-10-28): a
# shared connection can go on answering `ssh -O check` locally after its
# remote session has died -- a laptop put to sleep, a network drop, macOS
# Fast User Switching.  So one not confirmed for a while gets a real probe
# before it is trusted: a throwaway `true` ridden over the existing master,
# as any multiplexed client would (never a separate, unshared connection,
# which would need its own password and so always fail).  A probe that
# fails, or gets no answer within SSH_WRAPPER_PROBE_TIMEOUT seconds
# (default 10: on a dead link the master itself may take minutes to notice),
# retires the master and logs in again.  "Confirmed" is the ControlPath
# socket's own mtime, set on each login and good probe -- no state file of
# its own.  SSH_WRAPPER_STALE_AFTER: seconds a connection is trusted without
# a probe (default 300; 0 probes every time).
#
use strict;
use warnings;
use File::Basename qw(basename dirname);
use Cwd qw(abs_path);

my $DEBUG    = $ENV{SSH_WRAPPER_DEBUG} ? 1 : 0;
my $LOG_FILE = $ENV{SSH_WRAPPER_LOG} || ( ( $ENV{HOME} || '/tmp' ) . '/.ssh/ssh-wrapper.log' );
my $CONFIG_DIR = $ENV{XDG_CONFIG_HOME} || ( ( $ENV{HOME} || '' ) . '/.config' );
my $DEFAULT_SERVICE = 'ssh-wrapper';
my $PERSIST_DEFAULT = $ENV{SSH_WRAPPER_PERSIST} || '8h';

# A new ControlMaster forks into the background; how long to keep checking
# that it is there before giving up.
my $VERIFY_ATTEMPTS = $ENV{SSH_WRAPPER_VERIFY_ATTEMPTS} || 8;
my $VERIFY_DELAY    = $ENV{SSH_WRAPPER_VERIFY_DELAY} || 0.25;    # seconds

# Stale shared connections (header, "Stale shared connections").
my $STALE_AFTER   = exists $ENV{SSH_WRAPPER_STALE_AFTER} ? $ENV{SSH_WRAPPER_STALE_AFTER} : 300;
my $PROBE_TIMEOUT = $ENV{SSH_WRAPPER_PROBE_TIMEOUT} || 10;

# --reachable (header, "Inside or outside").
my $REACH_TIMEOUT = $ENV{SSH_WRAPPER_REACHABLE_TIMEOUT} || 1;
my $REACH_TTL     = $ENV{SSH_WRAPPER_REACHABLE_TTL} || 86400;
my $REACH_CACHE   = ( $ENV{XDG_CACHE_HOME} || ( ( $ENV{HOME} || '/tmp' ) . '/.cache' ) )
  . '/ssh-wrapper/reachable';

sub logmsg {
    return unless $DEBUG;
    if ( open( my $fh, '>>', $LOG_FILE ) ) {
        my @t = localtime;
        printf $fh "[%04d-%02d-%02d %02d:%02d:%02d] (%d) %s\n",
            $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0], $$, "@_";
        close $fh;
    }
}

sub note { print STDERR "[ssh-wrapper] @_\n"; }

# Run a list-form command (no shell), optionally silencing stdout/stderr
# and/or reading stdin from /dev/null. Returns the exit status ($?).
sub run_redirected {
    my ( $cmd, %opts ) = @_;
    my ( $save_out, $save_err, $save_in );
    if ( $opts{quiet} ) {
        open( $save_out, '>&', \*STDOUT ) or die "dup STDOUT: $!";
        open( $save_err, '>&', \*STDERR ) or die "dup STDERR: $!";
        open( STDOUT, '>', '/dev/null' )  or die "redirect STDOUT: $!";
        open( STDERR, '>', '/dev/null' )  or die "redirect STDERR: $!";
    }
    if ( $opts{null_stdin} ) {
        open( $save_in, '<&', \*STDIN ) or die "dup STDIN: $!";
        open( STDIN, '<', '/dev/null' ) or die "redirect STDIN: $!";
    }
    logmsg( "running: " . join( ' ', @$cmd ) );
    system(@$cmd);
    my $rc = $?;
    if ( $opts{quiet} ) {
        open( STDOUT, '>&', $save_out ) or die "restore STDOUT: $!";
        open( STDERR, '>&', $save_err ) or die "restore STDERR: $!";
    }
    if ( $opts{null_stdin} ) {
        open( STDIN, '<&', $save_in ) or die "restore STDIN: $!";
    }
    return $rc;
}

# Run a list-form command and return its stdout (stderr silenced).
sub capture_list {
    my (@cmd) = @_;
    logmsg( "capturing: " . join( ' ', @cmd ) );
    my $pid = open( my $ph, '-|' );
    die "fork: $!" unless defined $pid;
    if ( $pid == 0 ) {
        open( STDERR, '>', '/dev/null' );
        open( STDIN,  '<', '/dev/null' );
        exec @cmd or exit 127;
    }
    local $/;
    my $out = <$ph>;
    close $ph;
    return defined($out) ? $out : '';
}

################################################################################
# 1. ssh or scp (busybox style), and the real binaries -- skipping our own
#    directory, and any other copy of this wrapper (2026-10-19: an older
#    copy on PATH, e.g. from the bash setup, was taken for the real ssh, so
#    one wrapper ran inside the other and its own messages came out).
################################################################################
my $self_path = abs_path($0) // $0;
my $self_dir  = dirname($self_path);
my $self_name = basename($0);
$self_name = 'ssh' unless $self_name eq 'ssh' || $self_name eq 'scp';

# A script (not a binary) that mentions SSH_WRAPPER_RULES near its top.
sub is_wrapper_copy {
    my ($path) = @_;
    open( my $fh, '<', $path ) or return 0;
    my $n = read( $fh, my $head, 4096 );
    close $fh;
    return 0 unless $n && substr( $head, 0, 2 ) eq '#!';
    return $head =~ /SSH_WRAPPER_RULES/ ? 1 : 0;
}

sub find_exe {
    my ($prog) = @_;
    for my $dir ( split /:/, ( $ENV{PATH} || '' ) ) {
        next unless length $dir && -d $dir;
        my $cand = "$dir/$prog";
        next unless -x $cand && !-d $cand;
        my $real = abs_path($cand) // $cand;
        next if dirname($real) eq $self_dir;
        next if is_wrapper_copy($real);
        return $real;
    }
    return undef;
}

my $SSH = find_exe('ssh') or die "$self_name: no real 'ssh' in PATH (outside $self_dir)\n";
my $REAL = $self_name eq 'scp'
    ? ( find_exe('scp') or die "$self_name: no real 'scp' in PATH (outside $self_dir)\n" )
    : $SSH;

# Scratch directory of section 6, if one was made: exec skips END blocks,
# so it is removed here and in END.
our $SCRATCH;
sub drop_scratch {
    if ( defined $SCRATCH && -d $SCRATCH ) { require File::Path; File::Path::remove_tree($SCRATCH); }
    $SCRATCH = undef;
}
END { drop_scratch(); }

sub hand_off {
    drop_scratch();
    logmsg( "exec: $REAL " . join( ' ', @ARGV ) );
    exec $REAL, @ARGV;
    die "$self_name: exec $REAL failed: $!\n";
}

logmsg( "invoked as $self_name: " . join( ' ', @ARGV ) );

################################################################################
# 1b. ssh --reachable [-v] HOST [PORT] | --reachable --forget: for `Match
#     exec` (header, "Inside or outside").  Runs before every ssh connection
#     that the Match line covers, so it stays light: no rules, no ssh.
################################################################################
use Socket qw(getaddrinfo getnameinfo SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_ERROR
  NI_NUMERICHOST NIx_NOSERV AI_NUMERICHOST);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use POSIX ();

# The host's numeric address and the local address the system would send
# from to reach it: a UDP connect, which sends nothing.  In a child process,
# so a resolver that hangs (an internal name, off-site) costs at most
# $REACH_TIMEOUT -- a signal would not interrupt getaddrinfo.  () if the
# name does not resolve or there is no route.
sub route_of {
    my ( $host, $port ) = @_;
    pipe( my $r, my $w ) or return ();
    my $pid = fork();
    return () unless defined $pid;
    if ( $pid == 0 ) {
        close $r;
        my ( $err, @ai ) = getaddrinfo( $host, $port, { socktype => SOCK_STREAM } );
        for my $ai ( $err ? () : @ai ) {
            socket( my $u, $ai->{family}, SOCK_DGRAM, 0 ) or next;
            connect( $u, $ai->{addr} ) or next;
            my ( $e1, $dst ) = getnameinfo( $ai->{addr}, NI_NUMERICHOST, NIx_NOSERV );
            my ( $e2, $src ) = getnameinfo( getsockname($u), NI_NUMERICHOST, NIx_NOSERV );
            next if $e1 || $e2;
            print $w "$dst $src\n";
            last;
        }
        close $w;
        POSIX::_exit(0);
    }
    close $w;
    my $rin = '';
    vec( $rin, fileno($r), 1 ) = 1;
    my $line = '';
    if ( select( my $rout = $rin, undef, undef, $REACH_TIMEOUT ) > 0 ) { $line = <$r> // ''; }
    close $r;
    kill 'KILL', $pid;
    waitpid( $pid, 0 );
    return split ' ', $line;
}

# Does ADDR answer on PORT within $REACH_TIMEOUT?  A non-blocking connect.
sub answers {
    my ( $addr, $port ) = @_;
    my ( $err, $ai ) = getaddrinfo( $addr, $port, { socktype => SOCK_STREAM, flags => AI_NUMERICHOST } );
    return 0 if $err || !$ai;
    socket( my $s, $ai->{family}, SOCK_STREAM, 0 ) or return 0;
    fcntl( $s, F_SETFL, fcntl( $s, F_GETFL, 0 ) | O_NONBLOCK );
    return 1 if connect( $s, $ai->{addr} );
    return 0 unless $!{EINPROGRESS};
    my $win = '';
    vec( $win, fileno($s), 1 ) = 1;
    return 0 unless select( undef, my $wout = $win, undef, $REACH_TIMEOUT ) > 0;
    my $so = getsockopt( $s, SOL_SOCKET, SO_ERROR );
    return defined $so && unpack( 'i', $so ) == 0 ? 1 : 0;
}

# The cache: "host:port source direct|jump time" per line.
sub reach_cache_read {
    my %c;
    open( my $fh, '<', $REACH_CACHE ) or return \%c;
    my $now = time();
    while (<$fh>) {
        my ( $h, $src, $ans, $t ) = split;
        next unless defined $t && $now - $t < $REACH_TTL;
        $c{"$h $src"} = [ $ans, $t ];
    }
    close $fh;
    return \%c;
}

sub reach_cache_write {
    my ($c) = @_;
    my $dir = dirname($REACH_CACHE);
    unless ( -d $dir ) {
        mkdir( dirname($dir), 0700 );
        mkdir( $dir, 0700 ) or return;
    }
    my $tmp = "$REACH_CACHE.$$";
    open( my $fh, '>', $tmp ) or return;
    print $fh "$_ $c->{$_}[0] $c->{$_}[1]\n" for sort keys %$c;
    close $fh;
    rename( $tmp, $REACH_CACHE ) or unlink $tmp;
}

sub reachable_main {
    my @a = @_;
    my ( $verbose, $forget ) = ( 0, 0 );
    while ( @a && $a[0] =~ /^-/ ) {
        my $o = shift @a;
        if    ( $o eq '-v' )       { $verbose = 1; }
        elsif ( $o eq '--forget' ) { $forget  = 1; }
        else { @a = (); last; }
    }
    my $say = sub { print STDERR "[ssh-wrapper] @_\n" if $verbose; logmsg("reachable: @_"); };
    if ($forget) {
        unlink $REACH_CACHE;
        print STDERR "[ssh-wrapper] forgot what was learned ($REACH_CACHE)\n";
        return 0;
    }
    my ( $host, $port ) = @a;
    unless ( defined $host && length $host ) {
        print STDERR "usage: ssh --reachable [-v] HOST [PORT]  |  ssh --reachable --forget\n";
        return 2;
    }
    $port = 22 unless defined $port && $port =~ /^\d+$/;
    $host = lc $host;
    my $route = lc( $ENV{SSH_WRAPPER_ROUTE} // '' );
    if ( $route eq 'direct' || $route eq 'jump' ) {
        $say->("$host: $route (SSH_WRAPPER_ROUTE)");
        return $route eq 'direct' ? 0 : 1;
    }
    my ( $dst, $src ) = route_of( $host, $port );
    unless ( defined $src ) {
        $say->("$host: not reachable (the name does not resolve here, or no route to it)");
        return 1;
    }
    my $c = reach_cache_read();
    if ( my $hit = $c->{"$host:$port $src"} ) {
        $say->( "$host: $hit->[0] (remembered for this network, local address $src, from "
              . ( time() - $hit->[1] ) . "s ago)" );
        return $hit->[0] eq 'direct' ? 0 : 1;
    }
    my $ok = answers( $dst, $port );
    $c->{"$host:$port $src"} = [ $ok ? 'direct' : 'jump', time() ];
    reach_cache_write($c);
    $say->( "$host: " . ( $ok ? "direct ($dst port $port answered" : "jump (no answer from $dst port $port within ${REACH_TIMEOUT}s" )
          . "; local address $src, now remembered)" );
    return $ok ? 0 : 1;
}

if ( @ARGV && $ARGV[0] eq '--reachable' ) {
    shift @ARGV;
    exit reachable_main(@ARGV);
}

################################################################################
# 2. Rules. None -> nothing to do.
################################################################################
sub glob_to_re {
    my ($g) = @_;
    my $re = quotemeta( lc $g );
    $re =~ s/\\\*/.*/g;
    $re =~ s/\\\?/./g;
    return qr/^$re$/;
}

# The rules files, in order (see "Rules" above).
my @RULES_FILES;
if ( $ENV{SSH_WRAPPER_RULES} ) { @RULES_FILES = ( $ENV{SSH_WRAPPER_RULES} ); }
else {
    my %seen;
    # Not ~/.config/cubevis/ssh/rules: the earlier layout's, perhaps another
    # computer's (a shared home); this copy's own are next to it.
    for my $f ( "$CONFIG_DIR/ssh-wrapper/rules", dirname($self_dir) . '/ssh/rules' ) {
        my $real = abs_path($f) // next;
        next if $seen{$real}++ || !-r $real;
        push @RULES_FILES, $f;
    }
}
my $RULES_FILE = join( ', ', @RULES_FILES ) || "$CONFIG_DIR/ssh-wrapper/rules";

sub read_rules {
    my @rules;
    for my $file (@RULES_FILES) { push @rules, read_rules_file($file); }
    logmsg( "rules from $RULES_FILE: " . join( ' ', map { $_->{text} } @rules ) );
    return @rules;
}

sub read_rules_file {
    my ($file) = @_;
    open( my $fh, '<', $file ) or return ();
    my @rules;
    while ( my $line = <$fh> ) {
        $line =~ s/#.*//;
        $line =~ s/^\s+|\s+$//g;
        next unless length $line;
        my ( $pats, @kv ) = split /\s+/, $line;
        my %r = ( patterns => [ map { glob_to_re($_) } split /,/, $pats ], text => $pats,
            globs => [ split /,/, $pats ], file => $file, line => $. );
        for my $kv (@kv) {
            my ( $k, $v ) = split /=/, $kv, 2;
            $r{$k} = $v if defined $v;
        }
        # command= may contain spaces: take the rest of the line after it.
        if ( $line =~ /\bcommand=(.*)$/ ) { $r{command} = $1; }
        push @rules, \%r;
    }
    close $fh;
    return @rules;
}

my @RULES = read_rules();

# Askpass mode: ssh runs this same file as its SSH_ASKPASS program while
# the wrapper opens a shared connection (section 6). Answer a password
# prompt from the password store; refuse anything else (a host-key
# question, a key passphrase, a one-time code), which ssh treats as "no".
if ( defined $ENV{SSH_WRAPPER_ASKPASS_RULE} ) {
    my $prompt = $ARGV[0] // '';
    logmsg("askpass prompt: $prompt");
    exit 1 if $prompt !~ /password/i || $prompt =~ /passphrase/i;
    my $rule = $RULES[ $ENV{SSH_WRAPPER_ASKPASS_RULE} ] or exit 1;
    # Tell the wrapper whether the lookup worked (section 6): a failed
    # login is then explained by its real cause, not guessed at.
    my $status = $ENV{SSH_WRAPPER_ASKPASS_STATUS};
    my ( $pw, $be, $sv, $ac ) = eval {
        fetch_password( { rule => $rule, cfg => { user => $ENV{SSH_WRAPPER_ASKPASS_ACCOUNT} } } );
    };
    my $err = $@;
    if ( defined $status && open( my $sfh, '>>', $status ) ) {
        if ($err) { chomp $err; print $sfh "error $err\n"; }
        elsif ( length( $pw // '' ) ) { print $sfh "found\n"; }
        else { print $sfh "notfound backend=$be service=$sv account=$ac\n"; }
        close $sfh;
    }
    exit 1 unless defined $pw && length $pw;
    print "$pw\n";
    exit 0;
}
# ssh --explain HOST ...: report, log in nowhere (section 4).
my $EXPLAIN = 0;
if ( @ARGV && $ARGV[0] eq '--explain' ) { shift @ARGV; $EXPLAIN = 1; }
hand_off() unless @RULES || $EXPLAIN;

################################################################################
# 3. Read the command line: does it connect at all, to where, and with which
#    options that change *where* (port, user, config, identity, jump)?
################################################################################
# ssh options that take a value (OpenSSH 9.x).
my %SSH_VAL = map { $_ => 1 } qw(B b c D E e F I i J L l m O o P p Q R S W w);
# scp options that take a value.
my %SCP_VAL = map { $_ => 1 } qw(c D F i J l o P S X);

my ( $dest, @pt, $no_connect );
{
    my %val  = $self_name eq 'scp' ? %SCP_VAL : %SSH_VAL;
    my @args = @ARGV;
    while (@args) {
        my $a = shift @args;
        if ( $a eq '--' ) {
            if ( $self_name eq 'ssh' ) { $dest = shift @args; }
            else {
                for (@args) { if ( /^(?:[^\/]*\@)?([^:\/]+):/ ) { $dest = $_; last; } }
            }
            last;
        }
        if ( $a =~ /^-(.+)$/s && $a ne '-' ) {
            # A cluster of flags (-vvT), possibly ending in one that takes a
            # value, glued (-p7999) or as the next argument (-p 7999).
            my @ch = split //, $1;
            while (@ch) {
                my $f = shift @ch;
                if ( $self_name eq 'ssh' && $f =~ /^[GVQO]$/ ) { $no_connect = 1; }
                if ( $val{$f} ) {
                    my $v = @ch ? join( '', @ch ) : shift @args;
                    @ch = ();
                    next unless defined $v;
                    # Options that change which host/port/config is used.
                    if ( $self_name eq 'ssh' ) {
                        push @pt, "-$f", $v if $f =~ /^[FoiJlp]$/;
                    } else {
                        push @pt, "-$f", $v if $f =~ /^[FoiJ]$/;
                        push @pt, '-p', $v   if $f eq 'P';    # scp -P port
                    }
                }
            }
            next;
        }
        if ( $self_name eq 'ssh' ) { $dest //= $a; last; }
        # scp: the first remote operand, [user@]host:path or scp://...
        if ( $a =~ m{^scp://(?:([^@/]+)\@)?([^:/]+)(?::(\d+))?} ) {
            push @pt, '-p', $3 if defined $3;
            $dest = defined $1 ? "$1\@$2" : $2;
            last;
        }
        if ( $a =~ /^(?:[^\/]*\@)?[^:\/]+:/ ) {
            ( $dest = $a ) =~ s/:.*$//s;
            last;
        }
    }
}

die "usage: $self_name --explain HOST [ssh options]\n" if $EXPLAIN && !defined $dest;
hand_off() if $no_connect || !defined $dest;
logmsg( "destination: $dest  options: @pt" );

################################################################################
# 4. Each hop's effective configuration, and which hops need the password.
################################################################################
sub effective {
    my (@args) = @_;
    my %c;
    for ( split /\n/, capture_list( $SSH, '-G', @args ) ) {
        my ( $k, $v ) = split /\s+/, $_, 2;
        next unless defined $v;
        $k = lc $k;
        push @{ $c{$k} }, $v;
    }
    return { map { $_ => $c{$_}[0] } keys %c };
}

sub rule_for {
    my ($host) = @_;
    return undef unless defined $host;
    for my $r (@RULES) {
        for my $re ( @{ $r->{patterns} } ) { return $r if lc($host) =~ $re; }
    }
    return undef;
}

# Options that only choose a config file apply to every hop; the rest
# (port, user, identity, -o) belong to the destination.
my @cfg_only = ();
for ( my $i = 0 ; $i < @pt ; $i += 2 ) { push @cfg_only, @pt[ $i, $i + 1 ] if $pt[$i] eq '-F'; }

my $dest_cfg = effective( @pt, $dest );
my @hops;
if ( my $pj = $dest_cfg->{proxyjump} ) {
    if ( lc $pj ne 'none' ) {
        for my $j ( split /,/, $pj ) {
            my @jargs = @cfg_only;
            $j =~ s{^ssh://}{};
            if ( $j =~ /^(.*):(\d+)$/ ) { push @jargs, '-p', $2; $j = $1; }
            push @hops, { target => $j, args => \@jargs, cfg => effective( @jargs, $j ) };
        }
    }
}
push @hops, { target => $dest, args => \@pt, cfg => $dest_cfg };

my @need = grep { $_->{rule} = rule_for( $_->{cfg}{hostname} ) } @hops;
logmsg( "hops: " . join( ' -> ', map { "$_->{target}($_->{cfg}{hostname})" } @hops )
      . "; need password: " . join( ' ', map { $_->{target} } @need ) );

# Rules that look meant for a host but do not match it: a short name for a
# full one, or the old "user,host" form. Said out loud, because otherwise
# the wrapper silently does nothing and ssh asks for the password.
sub near_misses {
    my ($hop) = @_;
    my $host = lc( $hop->{cfg}{hostname} // '' );
    my $user = $hop->{cfg}{user} // '';
    my @why;
    for my $r (@RULES) {
        my @g = @{ $r->{globs} || [] };
        my $where = "$r->{file} line $r->{line}";
        if ( @g >= 2 && $g[0] eq $user && $g[0] !~ /[.*?]/ ) {
            push @why, "rule '$r->{text}' ($where) starts with your user name: rules"
              . " list host names only (an older wrapper's 'user,host' form)";
            next;
        }
        for my $g (@g) {
            next if $g =~ /[*?]/ || $g =~ /\./;
            push @why, "rule '$g' ($where) is not the whole host name '$host'; write"
              . " '$host' or '$g.*'" if index( $host, lc("$g.") ) == 0;
        }
    }
    return @why;
}
unless ($EXPLAIN) {
    for my $hop ( grep { !$_->{rule} } @hops ) { note($_) for near_misses($hop); }
}

if ($EXPLAIN) {
    print "rules: " . ( @RULES_FILES ? join( ', ', @RULES_FILES ) : "none (looked for $RULES_FILE)" ) . "\n";
    my $n = 0;
    for my $hop (@hops) {
        my $c = $hop->{cfg};
        printf "hop %d: %s -> %s (user %s, port %s)\n", ++$n, $hop->{target},
            $c->{hostname} // '?', $c->{user} // '?', $c->{port} // 22;
        my $r = $hop->{rule};
        if ( $r && $r->{twofactor} ) {
            print "  rule: $r->{text} ($r->{file} line $r->{line}), second factor: you log in"
              . " (in a terminal); no stored password\n";
            print "  ControlPath: " . ( $c->{controlpath} // 'none' )
              . ( lc( $c->{controlpath} // 'none' ) eq 'none' ? '  <- needed to share the login' : '' ) . "\n";
        } elsif ($r) {
            my $be = eval { resolve_backend($r) } // "? ($@)";
            chomp $be;
            print "  rule: $r->{text} ($r->{file} line $r->{line}), backend $be\n";
            my ($pw) = eval { fetch_password($hop) };
            print "  password: " . ( defined $pw && length $pw ? "stored" : "NOT FOUND" ) . "\n";
            print "  ControlPath: " . ( $c->{controlpath} // 'none' )
              . ( lc( $c->{controlpath} // 'none' ) eq 'none' ? '  <- needed to share the login' : '' ) . "\n";
        } else {
            print "  rule: none -- left to ssh (an ssh key, or ssh asks you)\n";
            print "  note: $_\n" for near_misses($hop);
        }
        my $up = run_redirected( [ $SSH, @{ $hop->{args} }, '-O', 'check', $hop->{target} ],
            quiet => 1, null_stdin => 1 ) == 0;
        my $cpx = $c->{controlpath} // 'none';
        my $mt  = ( $up && lc $cpx ne 'none' ) ? ( stat($cpx) )[9] : undef;
        print "  shared connection: " . ( $up ? "up" : "not up" )
          . ( defined $mt ? sprintf( " (confirmed %ds ago; probed after %ds)", time() - $mt, $STALE_AFTER ) : '' )
          . "\n";
    }
    exit 0;
}
hand_off() unless @need;

################################################################################
# 5. Password lookup.
################################################################################
sub resolve_backend {
    my ($rule) = @_;
    return $rule->{backend} if $rule->{backend};
    return 'command' if $rule->{command};
    return $ENV{SSH_WRAPPER_BACKEND} if $ENV{SSH_WRAPPER_BACKEND};
    return 'security' if $^O eq 'darwin';
    return 'secret-tool' if find_exe('secret-tool');
    return 'pass'        if find_exe('pass');
    die "$self_name: no password store found -- install secret-tool (libsecret) or pass,"
      . " or set backend= in $RULES_FILE\n";
}

sub fetch_password {
    my ( $hop ) = @_;
    my $rule    = $hop->{rule};
    my $backend = resolve_backend($rule);
    my $service = $rule->{service} || $DEFAULT_SERVICE;
    my $account = $rule->{account} || $hop->{cfg}{user} || $ENV{USER} || '';
    my $pw;
    if ( $backend eq 'security' ) {
        my $bin = find_exe('security') or die "$self_name: 'security' not found\n";
        $pw = capture_list( $bin, 'find-generic-password', '-a', $account, '-s', $service, '-w' );
    } elsif ( $backend eq 'secret-tool' ) {
        my $bin = find_exe('secret-tool') or die "$self_name: 'secret-tool' not found\n";
        $pw = capture_list( $bin, 'lookup', 'service', $service, 'account', $account );
    } elsif ( $backend eq 'pass' ) {
        my $bin = find_exe('pass') or die "$self_name: 'pass' not found\n";
        ($pw) = split /\n/, capture_list( $bin, 'show', $rule->{pass_name} || $service ), 2;
    } elsif ( $backend eq 'command' ) {
        die "$self_name: backend=command needs command=... in $RULES_FILE\n" unless $rule->{command};
        $pw = capture_list( '/bin/sh', '-c', $rule->{command} );
        ($pw) = split /\n/, ( $pw // '' ), 2;
    } else {
        die "$self_name: unknown backend '$backend' in $RULES_FILE\n";
    }
    $pw = '' unless defined $pw;
    $pw =~ s/\s+\z//;
    logmsg("password lookup: backend=$backend service=$service account=$account -> "
        . ( length $pw ? 'found' : 'NOT FOUND' ) );
    return ( $pw, $backend, $service, $account );
}

################################################################################
# 6. One shared connection per password hop.
#
# The throwaway login runs in a session of its own (setsid), with no
# terminal: ssh then asks this file, as SSH_ASKPASS, for the password. Two
# reasons, both found in testing: under sshpass, the helper process that
# carries a ProxyJump hop stayed on sshpass's pseudo-terminal and was
# killed by the hangup when sshpass exited, taking the new shared
# connection with it; and askpass reads the password store only when ssh
# actually asks. One password attempt only, so a wrong stored password
# cannot lock the account.
################################################################################
use File::Temp ();

# The login's stderr and the askpass call's report on the password lookup
# go to two scratch files, so a failure can be explained (2026-10-18: it
# used to print the gpg hint whatever the cause, e.g. a name that did not
# resolve).
$SCRATCH = File::Temp::tempdir( 'ssh-wrapper-XXXXXX', TMPDIR => 1, CLEANUP => 0 );

sub open_shared {
    my ( $hop, $rule_index, $persist ) = @_;
    my ( $target, $args, $cfg ) = ( $hop->{target}, $hop->{args}, $hop->{cfg} );
    my $err_file    = "$SCRATCH/login-$rule_index.err";
    my $status_file = "$SCRATCH/login-$rule_index.askpass";
    unlink $err_file, $status_file;
    my $pid = fork();
    die "$self_name: fork: $!\n" unless defined $pid;
    if ( $pid == 0 ) {
        POSIX::setsid();
        open( STDIN,  '<', '/dev/null' );
        open( STDOUT, '>', '/dev/null' );
        open( STDERR, '>', $err_file ) or open( STDERR, '>', '/dev/null' );
        $ENV{SSH_WRAPPER_ASKPASS_STATUS}  = $status_file;
        $ENV{SSH_ASKPASS}                 = $self_path;
        $ENV{SSH_ASKPASS_REQUIRE}         = 'force';     # OpenSSH 8.4+
        # Before 8.4 ssh uses askpass only with no terminal (setsid, above)
        # and DISPLAY set; nothing is drawn, the askpass is this file.
        $ENV{DISPLAY}                   //= ':0';
        $ENV{SSH_WRAPPER_ASKPASS_RULE}    = $rule_index;
        $ENV{SSH_WRAPPER_ASKPASS_ACCOUNT} = $hop->{rule}{account} || $cfg->{user} || $ENV{USER} || '';
        # These come first: ssh keeps the first value it is given, and they
        # must hold for this one login whatever the command line or config
        # says (BatchMode yes, which sshpyk recommends and setup's checks
        # use, would turn off askpass).
        my @cmd = ( $SSH, '-T', '-x',
            '-o', 'BatchMode=no', '-o', 'NumberOfPasswordPrompts=1',
            '-o', 'ControlMaster=auto', '-o', "ControlPersist=$persist",
            '-o', 'ConnectTimeout=30',
            @$args, $target, 'true' );
        logmsg( "opening: " . join( ' ', @cmd ) );
        exec @cmd or POSIX::_exit(127);
    }
    waitpid( $pid, 0 );
    my $rc = $? >> 8;
    # The last line ssh wrote that is not a routine notice.
    my $last = '';
    if ( open( my $fh, '<', $err_file ) ) {
        while ( my $l = <$fh> ) {
            $l =~ s/\s+\z//;
            next if $l eq '' || $l =~ /^Warning: Permanently added/;
            $last = $l;
        }
        close $fh;
        if ( $DEBUG && open( my $in, '<', $err_file ) ) { logmsg("login stderr: $_") while <$in>; close $in; }
    }
    my $asked = '';
    if ( open( my $fh, '<', $status_file ) ) { local $/; $asked = <$fh> // ''; close $fh; }
    return ( $rc, $last, $asked );
}

# A no-op command riding the shared connection as an ordinary multiplexed
# client would -- ControlMaster/ControlPath as configured, so a live master
# answers it with no new authentication.  BatchMode: should the master be
# gone, never a password prompt.  Killed after $PROBE_TIMEOUT seconds: on a
# dead link the request may otherwise wait until the master's keep-alives
# give up.  (A probe forcing ControlMaster=no would open a separate,
# unshared connection, which needs its own password -- it would always
# fail and condemn a live master.  Don't.)
sub probe_alive {
    my ( $args, $target ) = @_;
    my $pid = fork();
    return 0 unless defined $pid;
    if ( $pid == 0 ) {
        open( STDIN,  '<', '/dev/null' );
        open( STDOUT, '>', '/dev/null' );
        open( STDERR, '>', '/dev/null' );
        exec( $SSH, @$args, '-o', 'BatchMode=yes', '-o', 'ConnectTimeout=5', $target, 'true' )
          or POSIX::_exit(127);
    }
    my $deadline = time() + $PROBE_TIMEOUT;
    while ( time() <= $deadline ) {
        my $w = waitpid( $pid, POSIX::WNOHANG() );
        return ( $? == 0 ) ? 1 : 0 if $w == $pid;
        select( undef, undef, undef, 0.1 );
    }
    kill 'KILL', $pid;
    waitpid( $pid, 0 );
    logmsg("$target: probe got no answer within ${PROBE_TIMEOUT}s");
    return 0;
}

# "Confirmed healthy just now", as the ControlPath socket's own mtime.
sub mark_verified {
    my ($cp) = @_;
    my $now = time();
    utime( $now, $now, $cp ) or logmsg("couldn't touch $cp: $!");
}

for my $hop (@need) {
    my ( $target, $args, $cfg ) = ( $hop->{target}, $hop->{args}, $hop->{cfg} );
    my $cp = $cfg->{controlpath} // 'none';
    if ( run_redirected( [ $SSH, @$args, '-O', 'check', $target ], quiet => 1, null_stdin => 1 ) == 0 ) {
        my $mtime = lc $cp ne 'none' ? ( stat($cp) )[9] : undef;
        my $age   = defined $mtime ? time() - $mtime : $STALE_AFTER;
        if ( $age < $STALE_AFTER ) {
            logmsg("$target: shared connection already up (confirmed ${age}s ago)");
            next;
        }
        if ( probe_alive( $args, $target ) ) {
            mark_verified($cp) if lc $cp ne 'none';
            logmsg("$target: shared connection up (probed; last confirmed ${age}s before)");
            next;
        }
        note("the shared connection to '$target' is stale (it answers here, but its remote"
           . " session is gone: sleep, a network drop, a user switch); logging in again");
        run_redirected( [ $SSH, @$args, '-O', 'exit', $target ], quiet => 1, null_stdin => 1 );
        # On to a fresh login, as for a connection that was not up.
    }
    if ( $hop->{rule}{twofactor} ) {
        # A second factor: only the user can log in (header, "Keys").
        my $persist = $cfg->{controlpersist};
        $persist = $PERSIST_DEFAULT if !defined $persist || $persist =~ /^(no|false|0)$/i;
        my $cmd = join( ' ', $self_path, @cfg_only, $target, 'true' );
        if ( lc $cp eq 'none' ) {
            note("'$target' ($cfg->{hostname}) asks for a second factor but has no ControlPath"
               . " in your ssh config, so a login cannot be shared -- add one for it");
            next;
        }
        unless ( -t STDIN ) {
            note("'$target' ($cfg->{hostname}) asks for a second factor, and there is no shared"
               . " connection to it now (it closes after $persist, or when the computer sleeps"
               . " or changes networks). Log in once in a terminal -- it is then shared:");
            note("    $cmd");
            exit 255;
        }
        {
            my $dir = dirname($cp);
            if ( !-d $dir ) {
                my $parent = dirname($dir);
                mkdir( $parent, 0700 ) if !-d $parent;
                mkdir( $dir, 0700 ) or logmsg("cannot create $dir: $!");
            }
        }
        note("'$target' ($cfg->{hostname}) asks for a second factor: log in (it is then shared"
           . " for $persist)");
        my $rc = system( $SSH, '-T', '-x', '-o', 'BatchMode=no', '-o', 'ControlMaster=auto',
            '-o', "ControlPersist=$persist", '-o', 'ConnectTimeout=30', @$args, '-fN', $target ) >> 8;
        if ( $rc != 0 || run_redirected( [ $SSH, @$args, '-O', 'check', $target ],
                quiet => 1, null_stdin => 1 ) != 0 ) {
            note("login to '$target' ($cfg->{hostname}) failed (ssh exit $rc)");
            exit 255;
        }
        mark_verified($cp);
        note("shared connection to '$target' is up");
        next;
    }
    if ( lc $cp eq 'none' ) {
        note("'$target' ($cfg->{hostname}) needs a password but has no ControlPath in your"
           . " ssh config, so the login cannot be shared -- add one for it");
        next;
    }
    # The sockets live on local disk (/tmp/cubevis-<uid>), which a reboot
    # or a tmp cleaner may empty: make the directory again, closed to others.
    {
        my $dir = dirname($cp);
        if ( !-d $dir ) {
            my $parent = dirname($dir);
            mkdir( $parent, 0700 ) if !-d $parent;
            mkdir( $dir, 0700 ) or logmsg("cannot create $dir: $!");
        }
    }
    my ($idx) = grep { $RULES[$_] == $hop->{rule} } 0 .. $#RULES;
    my $persist = $cfg->{controlpersist};
    $persist = $PERSIST_DEFAULT if !defined $persist || $persist =~ /^(no|false|0)$/i;
    note("logging in to '$target' ($cfg->{hostname}) for a shared connection");
    my ( $rc, $last, $asked ) = open_shared( $hop, $idx, $persist );
    # 255 is ssh's own failure (could not connect or log in). Anything else
    # is the remote command's status: logged in, but the host refused to run
    # `true` -- a git-only server does that -- which is not a login problem.
    if ( $rc != 0 && $rc != 255 ) {
        logmsg("$target: logged in; the host refused the command (exit $rc)");
        $rc = 0;
    }
    if ( $rc != 0 ) {
        note("login to '$target' ($cfg->{hostname}) failed"
           . ( length $last ? ": $last" : " (ssh exit $rc)" ));
        # Why, from what the askpass call reported (none: ssh failed before
        # it asked for a password -- name, network, host key).
        if ( $asked =~ /^error (.*)/m ) {
            note("reading the stored password failed: $1");
        } elsif ( $asked =~ /^notfound (.*)/m ) {
            my $where = $1;
            my $be = eval { resolve_backend( $hop->{rule} ) } // '';
            if ( $be eq 'pass' || ( $be eq 'command' && ( $hop->{rule}{command} // '' ) =~ /\bgpg\b/ ) ) {
                note("no password came back from the store ($where). It is gpg-encrypted:"
                   . " gpg-agent must have the key's passphrase -- run `pass show <entry>`"
                   . " (or your gpg command) in a terminal once, then try again");
            } else {
                note("no stored password was found ($where)");
            }
        } elsif ( $asked =~ /^found/m ) {
            note("the stored password was refused (one attempt only, so a wrong one"
               . " cannot lock the account): store it again if it changed");
        } else {
            note("ssh failed before asking for a password: check the host name, the"
               . " network (VPN), and that you can ssh to it by hand");
        }
        note("SSH_WRAPPER_DEBUG=1 logs every step to $LOG_FILE") unless $DEBUG;
        # The hops behind this one go through it: no point trying them,
        # and each failed attempt counts towards a lockout.  Without a
        # terminal the real command cannot ask you either -- ssh's own
        # ProxyJump helper then makes failed attempts of its own, seen in
        # testing -- so stop here.  With one, hand over and let ssh ask.
        unless ( -t STDIN ) {
            note("not running the command: no terminal to type the password in");
            exit 255;
        }
        last;
    }
    my $ok = 0;
    for my $i ( 1 .. $VERIFY_ATTEMPTS ) {
        if ( run_redirected( [ $SSH, @$args, '-O', 'check', $target ], quiet => 1, null_stdin => 1 ) == 0 ) {
            $ok = 1;
            last;
        }
        select( undef, undef, undef, $VERIFY_DELAY );
    }
    mark_verified($cp) if $ok;
    note( $ok ? "shared connection to '$target' is up"
              : "logged in to '$target' but no shared connection stayed up"
              . " (normal for a host that only runs fixed commands, such as a git"
              . " server; otherwise check ControlPath for it)" );
}

hand_off();
