#!/usr/bin/perl
#
# $Id: scnc 17 2009-07-01 19:33:13Z gomor $
#
# This program is released under a BSD license
# See copyright notice from `perldoc scnc'
#

our $VERSION = '1.03';

our $SupportSsl    = 0;
our $SupportIpv6   = 0;

package Scnc;
use warnings; use strict;

use Carp;
use IO::Socket::INET;
use IO::Select;

eval("use IO::Socket::SSL;");
$@ ? warn("*** IO::Socket::SSL module not found, SSL support disabled\n")
   : $SupportSsl++;

eval("use IO::Socket::INET6;");
$@ ? warn("*** IO::Socket::INET6 module not found, IPv6 support disabled\n")
   : $SupportIpv6++;

sub new {
   my $self = shift;
   bless({
      _s => undef,
      @_,
   }, $self);
}

sub resolv {
   my ($self) = @_;
   if ($SupportIpv6 && $self->{6}) {
      my @res = Socket6::getaddrinfo($self->{s}, 'ftp', AF_INET6, SOCK_STREAM);
      if (@res >= 5) {
         my $saddr = $res[3];
         my ($ip) = Socket6::getnameinfo(
            $res[3], Socket6::NI_NUMERICHOST()|Socket6::NI_NUMERICSERV());
         return $ip;
      }
      die("resolv: unable to resolv host: ".$self->{s}." [$!]\n");
   }
   else {
      my $saddr = gethostbyname($self->{s})
         or die("resolv: unable to resolv host: ".$self->{s}." [$!]\n");
      return inet_ntoa($saddr);
   }
}

sub init {
   my ($self) = @_;

   $SIG{INT}  = sub { $self->exit };
   $SIG{CHLD} = 'IGNORE';

   STDOUT->blocking(0);
   STDOUT->autoflush(1);
   STDIN->blocking(0);
   STDIN->autoflush(1);

   # Set default values
   if (! defined($self->{e})) {
      $self->{e} = '';
   }
   if (! defined($self->{s})) {
      ($SupportIpv6 && $self->{6}) ? do { $self->{s} = '::'; }
                                   : do { $self->{s} = '0.0.0.0'; };
   }
   if (! defined($self->{p})) {
      $self->{p} = 0;
   }
   $self->{s} = $self->resolv;

   # Sanity checks
   if ($self->{l} && $self->{r}) {
      delete($self->{l});
   }
   if ($self->{u} && $self->{c}) {
      die("init: SSL does not work over UDP\n");
   }
}

sub client {
   my ($self) = @_;

   my $inet;
   my %args = (
      PeerHost => $self->{s},
      PeerPort => $self->{p},
      Proto    => $self->{u} ? 'udp' : 'tcp',
   );
   if ($SupportSsl && $self->{c}) {
      $inet = "IO::Socket::SSL";
      $args{Domain} = ($SupportIpv6 && $self->{6}) ? AF_INET6 : AF_INET;
      if ($self->{a} && $self->{f} && $self->{k}) {
         $args{SSL_server}    = 0;
         $args{SSL_use_cert}  = 1;
         $args{SSL_ca_file}   = $self->{a};
         $args{SSL_cert_file} = $self->{f};
         $args{SSL_key_file}  = $self->{k};
      }
   }
   elsif ($SupportIpv6 && $self->{6}) {
      $inet = "IO::Socket::INET6";
      $args{Domain} = AF_INET6;
   }
   else {
      $inet = "IO::Socket::INET";
      $args{Domain} = AF_INET;
   }

   my $s = $inet->new(%args);
   if (! defined($s)) {
      if ($SupportSsl && $self->{c}) {
         die("client: SSL error connecting to: ".$self->{s}.":".$self->{p}.
             " [".IO::Socket::SSL::errstr()."]");
      }
      else {
         die("client: error connecting to: ".$self->{s}.":".$self->{p}.
             " [$!]");
      }
      ($SupportIpv6 && $self->{6}) ? print " (IPv6)\n" : print " (IPv4)\n";
   }

   $s->blocking(0);
   $s->autoflush(1);
   $self->{_s} = $s;

   # We MUST use connected UDP, otherwise syswrite() and sysread() do not work
   if ($self->{u}) {
      if ($SupportIpv6 && $self->{6}) {
         connect($s, Socket6::sockaddr_in6($self->{p},
                 Socket6::inet_pton(AF_INET6, $self->{s})))
            or die("client: error doing connect() [$!]\n");
      }
      else {
         connect($s, sockaddr_in($self->{p}, inet_aton($self->{s})))
            or die("client: error doing connect() [$!]\n");
      }
      $s->syswrite("\0");  # So the server will know we are here,
                           # and will connect() the socket on its side.
   }

   if ($self->{v}) {
      print "client: connected to: ".$self->{s}.":".$self->{p};
      ($SupportIpv6 && $self->{6}) ? print " (IPv6)\n" : print " (IPv4)\n";
      if ($self->{c}) {
         print "client: using cipher: ".$s->get_cipher."\n";
      }
   }
}

sub _doTelnetNegociation {
   my ($self, $buf) = @_;
   if ($buf =~ /\xfb|\xfd/) {
      (my $new = $buf) =~ s/^((\xff..)+).*$/$1/s;  # Keep only telnet stuff
      $new =~ s/\xfb/\xfe/g;  # WILL => WONT
      $new =~ s/\xfd/\xfc/g;  # DO   => DONT
      $self->{_s}->syswrite($new);
   }
}

sub _rwLoop {
   my ($self, $in, $out, $err) = @_;

   my $s = IO::Select->new;
   $s->add($self->{_s});
   $s->add($in);

   while (my @read = $s->can_read) {
      my $toRead = 1024;  # We read by chunk of 1024 bytes
      for my $this (@read) {
         if ($this == $self->{_s}) {
            my $r;
            while (defined($r = $self->{_s}->sysread(my $buf, $toRead))
                   && $r != 0) {
               if ($r > 0) {
                  print $out $buf;
                  if ($self->{t}) { $self->_doTelnetNegociation($buf); }
                  last if $r <= $toRead;
               }
               else { return; }
            }
         }
         elsif ($this == $in) {
            my $toWrite = '';
            my $r;
            while (defined($r = $in->sysread(my $buf, $toRead)) && $r != 0) {
               if ($r > 0) { $toWrite .= $buf; }
            }
            if (length($toWrite)) { $self->{_s}->syswrite($toWrite); }
         }
      }
   }
}

sub clientLoop {
   my ($self, $in, $out, $err) = @_;

   if (length($self->{e})) {
      socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
         or die("clientLoop: socketpair [$!]\n");
      CHILD->blocking(0);
      CHILD->autoflush(1);
      PARENT->blocking(0);
      PARENT->autoflush(1);

      defined(my $pid = fork()) or die("clientLoop: fork [$!]\n");
      if ($pid == 0) {
         my $parent = fileno(PARENT);
         open(STDIN,  "<&=$parent");
         open(STDOUT, ">&=$parent");
         open(STDERR, ">&=$parent");
         system($self->{e});
         exit(0);
      }
      else {
         my $child = fileno(CHILD);
         open(STDIN,  "<&=$child");
         open(STDOUT, ">&=$child");
         open(STDERR, ">&=$child");
         $self->_rwLoop(\*STDIN, \*STDOUT, \*STDERR);
      }
   }
   else {
      $self->_rwLoop($in, $out, $err);
   }
}

sub server {
   my ($self) = @_;

   my $inet;
   my %args = (
      LocalAddr => $self->{s},
      LocalPort => $self->{p},
      Proto     => $self->{u} ? 'udp' : 'tcp',
      Type      => $self->{u} ? SOCK_DGRAM : SOCK_STREAM,
      ReuseAddr => 1,
   );
   $args{Listen} = 10 if ! $self->{u};
   if ($SupportSsl && $self->{c}) {
      $inet = "IO::Socket::SSL";
      $args{Domain} = ($SupportIpv6 && $self->{6}) ? AF_INET6 : AF_INET;
      if ($self->{a} && $self->{f} && $self->{k}) {
         $args{SSL_server}    = 1;
         $args{SSL_use_cert}  = 1;
         $args{SSL_ca_file}   = $self->{a};
         $args{SSL_cert_file} = $self->{f};
         $args{SSL_key_file}  = $self->{k};
      }
   }
   elsif ($SupportIpv6 && $self->{6}) {
      $inet = "IO::Socket::INET6";
      $args{Domain} = AF_INET6;
   }
   else {
      $inet = "IO::Socket::INET";
      $args{Domain} = AF_INET;
   }

   my $s = $inet->new(%args);
   if (! defined($s)) {
      if ($SupportSsl && $self->{c}) {
         die("server: SSL error listening on: ".$self->{s}.":".$self->{p}.
             " [".IO::Socket::SSL::errstr()."]");
      }
      else {
         die("server: error listening on: ".$self->{s}.":".$self->{p}.
             " [$!]");
      }
      ($SupportIpv6 && $self->{6}) ? print " (IPv6)\n" : print " (IPv4)\n";
   }

   $s->blocking(0);
   $s->autoflush(1);
   $self->{_s} = $s;

   if ($self->{v}) {
      if ($SupportSsl && $self->{c}) {
         print("server: SSL listening on: ".$self->{s}.":".$self->{p});
      }
      else {
         print("server: listening on: ".$self->{s}.":".$self->{p});
      }
      ($SupportIpv6 && $self->{6}) ? print " (IPv6)\n" : print " (IPv4)\n";
   }
}

sub serverLoop {
   my ($self, $in, $out, $err) = @_;

   my $s = IO::Select->new;
   $s->add($self->{_s});

   open(my $oldout, ">&STDOUT");

   while (my @ready = $s->can_read) {
      if ($self->{u}) {
         if (my $new = $self->{_s}->recv(my $tmp, 0)) {
            my ($port, $saddr, $ipaddr);
            if ($SupportIpv6 && $self->{6}) {
               ($port, $saddr) = Socket6::sockaddr_in6($new);
               $ipaddr = Socket6::inet_ntop(AF_INET6, $saddr);
            }
            else {
               ($port, $saddr) = sockaddr_in($new);
               $ipaddr = inet_ntoa($saddr);
            }

            if ($self->{v}) {
               print $oldout "serverLoop: connection from: $ipaddr:$port\n";
               if ($self->{c}) {
                  print "serverLoop: using cipher: ".$new->get_cipher."\n";
               }
            }

            # We MUST use connected UDP, otherwise syswrite() and sysread()
            # do not work
            if ($SupportIpv6 && $self->{6}) {
               connect($self->{_s}, Socket6::sockaddr_in6($port, $saddr))
                  or die("serverLoop: error doing connect() [$!]\n");
            }
            else {
               connect($self->{_s}, sockaddr_in($port, $saddr))
                  or die("serverLoop: error doing connect() [$!]\n");
            }
            $self->clientLoop($in, $out, $err);
         }
      }
      elsif (my $new = $self->{_s}->accept) {
         use Data::Dumper;
         if ($self->{v}) {
            print $oldout "serverLoop: connection from: ".$new->peerhost.":".
                          $new->peerport."\n";
            if ($self->{c}) {
               print "serverLoop: using cipher: ".$new->get_cipher."\n";
            }
         }

         $new->blocking(0);
         $new->autoflush(1);

         defined(my $pid = fork()) or die("serverLoop: fork [$!]\n");
         if ($pid == 0) {  # Son process
            $self->{_s} = $new;
            $self->clientLoop($in, $out, $err);
            if ($self->{v}) {
               print $oldout "serverLoop: client ".$new->peerhost.":".
                             $new->peerport." disconnected\n";
            }
            exit(0);
         }
      }
   }
}

sub proxy {
   my ($self) = @_;
   $self->server;
}

sub proxyLoop {
   my ($self, $in, $out, $err) = @_;

   my $s = IO::Select->new;
   $s->add($self->{_s});

   open(my $oldout, ">&STDOUT");

   while (my @ready = $s->can_read) {
      if ($self->{u}) {
         if (my $new = $self->{_s}->recv(my $tmp, 0)) {
            my ($port, $saddr, $ipaddr);
            if ($SupportIpv6 && $self->{6}) {
               ($port, $saddr) = Socket6::sockaddr_in6($new);
               $ipaddr = Socket6::inet_ntop(AF_INET6, $saddr);
            }
            else {
               ($port, $saddr) = sockaddr_in($new);
               $ipaddr = inet_ntoa($saddr);
            }

            if ($self->{v}) {
               print $oldout "proxyLoop: connection from: $ipaddr:$port\n";
               if ($self->{c}) {
                  print "proxyLoop: using cipher: ".$new->get_cipher."\n";
               }
            }

            # We MUST use connected UDP, otherwise syswrite() and sysread()
            # do not work
            if ($SupportIpv6 && $self->{6}) {
               connect($self->{_s}, Socket6::sockaddr_in6($port, $saddr))
                  or die("proxyLoop: error doing connect() [$!]\n");
            }
            else {
               connect($self->{_s}, sockaddr_in($port, $saddr))
                  or die("proxyLoop: error doing connect() [$!]\n");
            }
            my $new = $self->{_s};

            my ($host, $dport, $v6, $ssl) = split(':', $self->{r});
            $self->{6} = (defined($v6) && $v6 =~ /ipv6/i) ? 1 : 0;
            $self->{c} = (defined($ssl)) ? 1 : 0;
            $self->{s} = $host; $self->resolv;
            $self->{p} = $dport;
            $self->client;
            $self->clientLoop($new, $new, $new);
         }
      }
      elsif (my $new = $self->{_s}->accept) {
         print $oldout "proxyLoop: connection from: ".$new->peerhost.":".
                       $new->peerport."\n"
            if $self->{v};

         $new->blocking(0);
         $new->autoflush(1);

         defined(my $pid = fork()) or die("proxyLoop: fork [$!]\n");
         if ($pid == 0) {  # Son process
            my ($host, $port, $v6, $ssl) = split(':', $self->{r});
            $self->{6} = (defined($v6) && $v6 =~ /ipv6/i) ? 1 : 0;
            $self->{c} = (defined($ssl)) ? 1 : 0;
            $self->{s} = $host; $self->resolv;
            $self->{p} = $port;
            $self->client;
            $self->clientLoop($new, $new, $new);
            print $oldout "proxyLoop: client ".$new->peerhost.":".
                          $new->peerport." disconnected\n"
               if $self->{v};
            exit(0);
         }
      }
   }
}

sub run {
   my ($self) = @_;

   $self->init;
   if ($self->{l}) {
      $self->server;
      $self->serverLoop(\*STDIN, \*STDOUT, \*STDERR);
   }
   elsif ($self->{r}) {
      $self->proxy;
      $self->proxyLoop(\*STDIN, \*STDOUT, \*STDERR);
   }
   elsif ($self->{z}) {
      $self->client;
   }
   else {
      $self->client;
      $self->clientLoop(\*STDIN, \*STDOUT, \*STDERR);
   }
   $self->exit;
}

sub exit {
   my ($self) = @_;
   $self->{_s}->close if defined($self->{_s});
   exit;
}

1;

package main;
use warnings; use strict;

my $prog     = "scnc";
my $progname = "SSL Capable NetCat $VERSION";

use Getopt::Std;

my $opts = '';
my $usage = "$progname\n\nUsage: $prog [-options] target port\n\n";

if ($SupportSsl) {
   $usage .= "   -c            use SSL (default to not)\n";
   $usage .= "   -a            use SSL certificate authority file\n";
   $usage .= "   -f            use SSL certificate file (PEM format)\n";
   $usage .= "   -k            use SSL private key file (PEM format)\n";
   $opts  .= "ca:f:k:";
}
if ($SupportIpv6) {
   $usage .= "   -6            use IPv6 (default to not)\n";
   $opts  .= "6";
}
$usage .= "   -t            do telnet negociation (default to not)\n";
$usage .= "   -e cmd        command to execute\n";
$usage .= "   -l            listen for connections (default to not)\n";
$usage .= "   -p port       use local port number (default to random high)\n";
$usage .= "   -s address    use address for bindings (default to all addresses)\n";
$usage .= "   -u            use UDP socket (default to TCP)\n";
$usage .= "   -v            be verbose (default to not)\n";
$usage .= "   -z            test port for openness\n";
$usage .= "   -r host:port           proxy connection to host:port\n";
if ($SupportIpv6) {
   $usage .= "   -r host:port:ipv6".
             "      proxy connection to host:port using IPv6\n";
}
if ($SupportSsl) {
   $usage .= "   -r host:port::ssl".
             "      proxy connection to host:port using SSL\n";
}
if ($SupportSsl && $SupportIpv6) {
   $usage .= "   -r host:port:ipv6:ssl".
             "  proxy connection to host:port using IPv6 and SSL\n";
}
$opts  .= "te:lp:s:uvr:z";

my %opts;
getopts($opts, \%opts);

$opts{p} = pop unless defined($opts{p});
$opts{s} = pop unless defined($opts{s});

if ((! $opts{l})
&&  (! $opts{r})
&&  (! defined($opts{s}) || ! defined($opts{p}))) {
   print $usage and exit(0);
}

Scnc->new(%opts)->run;

__END__

=head1 NAME

scnc - SSL Capable NetCat (and more)

=head1 SYNOPSIS

SSL Capable NetCat 1.03

Usage: scnc [-options] target port

   -c            use SSL (default to not)
   -a            use SSL certificate authority file
   -f            use SSL certificate file (PEM format)
   -k            use SSL private key file (PEM format)
   -6            use IPv6 (default to not)
   -t            do telnet negociation (default to not)
   -e cmd        command to execute
   -l            listen for connections (default to not)
   -p port       use local port number (default to random high)
   -s address    use address for bindings (default to all addresses)
   -u            use UDP socket (default to TCP)
   -v            be verbose (default to not)
   -z            test port for openness
   -r host:port           proxy connection to host:port
   -r host:port:ipv6      proxy connection to host:port using IPv6
   -r host:port::ssl      proxy connection to host:port using SSL
   -r host:port:ipv6:ssl  proxy connection to host:port using IPv6 and SSL

=head1 DESCRIPTION

You all know what is netcat (written by Hobbit in 1996), how to use it and that it should have been integrated in all UNIX systems a long time ago. netcat lacked some features, and I tried to add them in this Perl version. For example, SSL support, TCP and UDP proxying and IPv4/IPv6 proxying features. This is now done, unless I missed a bug. Now, enjoy. 

=head1 EXAMPLES

See http://www.gomor.org/bin/view/GomorOrg/SslNetcat#Example_applications .

=head1 CHANGES

Version 1.03 (2009/07/01)

   * bugfix: telnet support is now implemented :)
   * update: no more dependence upon Net::Telnet module
             BTW, telnet negociation in original netcat is not perfectly 
             implemented, but perfectly works.

Version 1.02 (2009/06/30)

   * bugfix: SSL+IPv6 now works even in verbose mode
   * bugfix: reading from STDIN on command line
   * new: perldoc
   * new: copyright notice (BSD license)

Version 1.01 (2008/05/10)

   * bugfix: usage string when some modules are not available
   * new: added -z support (port scan a port), contributed by DaJoker

Version 1.00 (2008/04/27)

   * fully-featured release

Version 0.5 (2006/05/09)

   * first public release

=head1 AUTHOR

Patrice E<lt>GomoRE<gt> Auffret

=head1 COPYRIGHT AND LICENSE

This program is released under a BSD license

Copyright (c) 2006-2009, GomoR
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

   * Redistributions of source code must retain the above copyright notice,
     this list of conditions and the following disclaimer.
   * Redistributions in binary form must reproduce the above copyright
     notice, this list of conditions and the following disclaimer in the
     documentation and/or other materials provided with the distribution.
   * Neither the name of the www.GomoR.org nor the names of its
     contributors may be used to endorse or promote products derived from
     this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

=cut