stun: yet another ssh tunneling tool

stun

#!/usr/bin/perl

# stun: ssh tunneling wrapper for convenient static port forwarding

# Author: Gerald Lai
# License: 0BSD

use warnings;
use strict;

use POSIX qw(strftime);
use Socket;
use IO::Socket::INET;

use Getopt::Long qw(GetOptions);
Getopt::Long::Configure(qw(posix_default no_ignore_case pass_through bundling));

sub help {
    print STDERR <<"EOT";
Usage: stun
         [ --usher HOSTPORT1:REMOTE1 -u HOSTPORT2:REMOTE2 ... ]
         [ --alias REMOTEHOSTNAME1[:HOSTIP1] ... ]
         [ [user@]proxyhost ]
         [ ssh options ... ]

Tunnels HOSTPORTs to REMOTEs via proxyhost using ssh static port forwarding.

Optionally, REMOTEHOSTNAME aliases may be defined for temporary entries in /etc/hosts.
This is useful to simulate VPN-like access for specific remote hosts.
HOSTIPs default to "127.0.0.1" (specify "0.0.0.0" for auto-detected IP address).

All other command options are passed to 'ssh' command as-is.

Example:

  # Allow https://remote.host.com seamless access on localhost
  stun -u https:12345 --alias remote.host.com myuser\@proxy.net

EOT
    exit 255;
}

sub portmap {
    my %port = (
        ftp => 21,
        ssh => 22,
        telnet => 23,
        http => 80,
        sftp => 115,
        https => 443,
    );

    local $_ = shift;
    s{:([^:]+)}{ ":" . ($port{$1} || $1) }e;
    return $_;
}

{
    my $auto_ip;
    sub auto_ip {
        # stolen from Net::Address::IP::Local::connected_to()
        # side-effect of making socket connection provides our IP address
        return $auto_ip ||= IO::Socket::INET->new(
            Proto => "udp",
            PeerAddr => "198.41.0.4", # a.root-servers.net
            PeerPort => 53, # DNS
        )->sockhost;
    }
}

my %OPT = (
    usher => [ ],
    alias => [ ],
);
GetOptions( \%OPT,
    "usher|u=s@",
    "alias=s@",
    "help|h|?" => \&help,
);

my $ssh = "/usr/bin/ssh";
my $hosts_file = "/etc/hosts";

my @ushers = map {
    my @parts = split /:/, $_;

    my ($src, $tgt);

    if (@parts == 1) {
        $src = $tgt = $_;
    } elsif (@parts == 2) {
        $src = $parts[0];
        $tgt = $parts[1];
    } else {
        if ($parts[0] =~ /\./) {
            $src = join(":" => @parts[0, 1]);
            $tgt = join(":" => @parts[2 .. $#parts]);
        } else {
            $src = $parts[0];
            $tgt = join(":" => @parts[1 .. $#parts]);
        }
    }

    $src = "127.0.0.1:$src" if $src !~ /[:.]/;
    $tgt = "127.0.0.1:$tgt" if $tgt !~ /[:.]/;

    ( "-L", portmap($src) . ":" . portmap($tgt) );
} @{ $OPT{usher} };

my %hosts_alias;
my @aliases = map {
    my ($alias, $to) = split /:/, $_;
    $to = "127.0.0.1" if !defined($to) || $to eq "localhost";
    $to = auto_ip()   if $to eq "0.0.0.0";

    my $ip_struct = (gethostbyname $to)[4];

    if ($ip_struct) {
        $to = inet_ntoa($ip_struct);

        push @{ $hosts_alias{$to} }, $alias;

        join(":" => $alias, $to);
    } else {
        print STDERR "Error: Invalid alias HOSTIP :$to\n";
        ();
    }
} @{ $OPT{alias} };

help() if !@ushers && !@aliases && !@ARGV;

my $only_aliases = (@aliases && !@ushers && !@ARGV);

if ($ENV{STUN_PROXY} && !@ARGV) {
    unshift @ARGV, $ENV{STUN_PROXY};
}

{
  my $alias_entry;
  sub clean_hosts {
      my $contents = do {
          open(my $HOSTS, "<", $hosts_file) or die <<"EOT";
Error: Cannot read from $hosts_file.
EOT
          local $/;
          <$HOSTS>;
      };
      $contents =~ s{\Q$alias_entry}{};

      open(my $HOSTS, ">", $hosts_file) or die <<"EOT";
Error: Cannot erase alias entry from $hosts_file.
Please run as a user with sufficient write privilege.
EOT
      print $HOSTS $contents;
      close $HOSTS;
  }

  sub write_hosts {
      open(my $HOSTS, ">>", $hosts_file) or die <<"EOT";
Error: Cannot write alias entry into $hosts_file.
Please run as a user with sufficient write privilege.
EOT

      if (print $HOSTS $alias_entry) {
          close $HOSTS;
          local $@;
          eval q{ END { clean_hosts() } };
      }
  }

  if (@aliases) {
      my $date = strftime "%FT%T%z", localtime;

      my $entry = join("\n" =>
        map "$_\t@{ $hosts_alias{$_} }",
        sort keys %hosts_alias
      );

      $alias_entry = "\n" . <<"EOT" . "\n";
# auto-generated entry by stun (PID: $$) on $date
$entry
EOT

      write_hosts();
  }
}

if (@aliases) {
    printf STDERR "# Host aliases: [ %s ]\n", join(", " => @aliases);
}

if ($only_aliases) {
    print STDERR "# ( Hit Ctrl-C to stop ) ...\n";
    system($^X, qw(-e sleep));
    exit 0;
} else {
    my @ssh_cmd = ($ssh, @ARGV, @ushers, "-N");
    print STDERR "# Tunneling: @ssh_cmd\n";
    exit system(@ssh_cmd) >> 8;
}