mync.pl

netcatライク習作 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use File::Basename qw/basename dirname/;
use Getopt::Std;

use IO::Socket;
use IO::Select;

{ $|=1; my $_old = select(STDERR); $|=1; select($_old);}

my $SCRIPT = basename $0;

sub usage {
  my $fh = shift;
  print $fh <<"EOT"
This is netcat-like program for study.
NOT for production use.
usage: $SCRIPT [-lh] [-w timeout] [destination] [port]
EOT
}

sub help {
  my $fh = shift;
  usage($fh);
  print $fh <<"EOT"
\tCommand Summary:
\t\t-h\tThis help text
\t\t-l\tListen mode
EOT
}

my %opt;
getopts("hlw:",\%opt);

my $BUFFER_SIZE = 16384;
my $LISTEN_MODE = $opt{l};
my $TIMEOUT     = $opt{w} // 0;
my $HELP        = $opt{h};

if ($HELP) {
  help(*STDOUT);
  exit(0);
}

my $ARGC = scalar @ARGV;

if ($LISTEN_MODE) {

  my ($host, $port) = eval {
    die if (0 == $ARGC);
    if (1 == $ARGC) {
      my ($port) = @ARGV;
      return ('127.0.0.1', $port);
    }
    return @ARGV;
  }; if ($@) {
    usage(*STDERR);
    exit(1);
  }

  start_server($host, $port);

  exit(0);

} else {

  my ($host, $port) = eval {
    die if ($ARGC < 2);
    return @ARGV;
  }; if ($@) {
    usage(*STDERR);
    exit(1);
  }

  start_client($host, $port);

  exit(0);

}

sub start_server {
  my ($server_host, $server_port) = @_;
  my $listen_sock = new IO::Socket::INET(
    LocalAddr => $server_host,
    LocalPort => $server_port,
    Proto     => 'tcp',
    Listen    => 1,
    Reuse     => 1,
  );
  die "$!\n" unless $listen_sock;
  my $sock = $listen_sock->accept();
  die "$!\n" unless $sock;
  readwrite($sock);
}

sub start_client {
  my ($peer_host, $peer_port) = @_;
  my $sock = new IO::Socket::INET(
    PeerAddr => $peer_host,
    PeerPort => $peer_port,
    Proto    => 'tcp',
  );
  die "$!\n" unless $sock;
  readwrite($sock);
}

sub readwrite {
  my $sock  = shift;
  my $stdin = *STDIN;
  my $sel   = IO::Select->new($stdin, $sock);

  my ($read, $wrote, $data);
  OUTER: while (my $handles = $sel->handles) {

    my @ready = $sel->can_read($TIMEOUT);
    for my $fh (@ready) {

      if ($fh eq $stdin) {

        $read = sysread($stdin, $data, $BUFFER_SIZE);
        die "$!\n" unless (defined $read);
        last OUTER if (0 == $read);

        $wrote = 0;
        do {
          my $w = syswrite($sock, $data, $BUFFER_SIZE, $wrote);
          die "$!\n" unless (defined $w);
          last OUTER if (0 == $w);
          $wrote += $w;
        } while ($wrote < $read);

      }

      if ($fh eq $sock) {

        $read = sysread($sock, $data, $BUFFER_SIZE);
        die "$!\n" unless (defined $read);
        last OUTER if (0 == $read);

        $wrote = 0;
        do {
          my $w = syswrite(STDOUT, $data, $BUFFER_SIZE);
          die "$!\n" unless (defined $w);
          last OUTER if (0 == $w);
          $wrote += $w;
        } while ($wrote < $read);

      }

    }
  }
  $sel->remove($stdin);
  $sel->remove($sock);
  close($sock);
}

TODO: ncatの -m --max-conns オプションに対応する