Simple socks5 implementation using perl Mojo

1.pl

#!/usr/bin/perl
use Mojo::Base -strict;

use Mojo::IOLoop;
use Devel::Peek;
use Data::Dumper;

my $DEBUG = 1;

my $users = {
  # user1 => 'pass1'
};

sub _debug {
  my ($type, @params) = @_;
  say '-----------';
  say $type;

  my (@columns, @values);
  while (@params) {
    my ($c, $v) = splice @params, 0, 2;
    push @columns, sprintf('%15s|', $c);
    push @values, sprintf('%15s|', $v);
  }
  say join '', @columns if @columns;
  say join '', @values if @values;
  say '';
}

sub init_handshake {
  my ($stream, $bytes) = @_;

  my ($ver, $nmethods, @methods) = unpack 'C*', $bytes;

  _debug('Receive', ver => $ver, nmethods => $nmethods, methods => join('', @methods)) if $DEBUG;

  if ($ver != 5) {
    _debug('Close connection') if $DEBUG;
    return $stream->close;
  }

  my %methods = map { $_ => 1 } @methods;
  if (%$users and ! $methods{2}) {
    $stream->write(pack'C*', 5, 0xff);
    if ($DEBUG) {
      _debug('Send', ver => 5, method => 0xff);
      _debug('Close connection');
    }
    return $stream->close;
  }

  if (! %$users and ! $methods{0}) {
    $stream->write(pack'C*', 5, 0xff);
    if ($DEBUG) {
      _debug('Send', ver => 5, method => 0xff);
      _debug('Close connection');
    }
    return $stream->close;
  }

  $stream->unsubscribe(read => $stream->subscribers('read')->[-1]);
  %$users
    ? $stream->on(read => \&auth_handshake)
    : $stream->on(read => \&command_handshake);

  $stream->write(pack'C*', 5, %$users ? 2 : 0);
  _debug('Send', ver => 5, method => %$users ? 2 : 0) if $DEBUG;
}

sub auth_handshake {
  my ($stream, $bytes) = @_;

  my ($ver, $ulen) = unpack 'C*', substr($bytes, 0, 2);
  $bytes = substr($bytes, 2);

  my $uname = substr($bytes, 0, $ulen);
  $bytes = substr($bytes, $ulen);

  my $plen = unpack 'C', substr($bytes, 0, 1);
  $bytes = substr($bytes, 1);

  my $passwd = substr($bytes, 0, $plen);

  my $status = 1;
  $status = 0 if $users->{$uname} && $users->{$uname} eq $passwd;

  _debug('Receive', ver => $ver, ulen => $ulen, uname => $uname, plen => $plen, passwd => $passwd) if $DEBUG;

  if ($ver != 1 || $status != 0) {
    $stream->write(pack'C*', 1, 1);
    if ($DEBUG) {
      _debug('Send', ver => 1, status => 1);
      _debug('Close connection');
    }
    return $stream->close;
  }

  $stream->unsubscribe(read => $stream->subscribers('read')->[-1]);
  $stream->on(read => \&command_handshake);

  $stream->write(pack'C*', 1, $status);
  _debug('Send', ver => 1, status => $status) if $DEBUG;
}

sub command_handshake {
  my ($stream, $bytes) = @_;

  my ($ver, $cmd, $rsv, $atyp) = unpack 'C*', substr($bytes, 0, 4);
  $bytes = substr($bytes, 4);

  my $addr;
  if ($atyp == 1) {
    $addr = join '.', unpack('C4', $bytes);
    $bytes = substr($bytes, 4);
  } elsif ($atyp == 3) {
    my $addr_len = unpack 'C', substr($bytes, 0, 1);
    $bytes = substr($bytes, 1);
    $addr = substr($bytes, 0, $addr_len);
    $bytes = substr($bytes, $addr_len);
  } elsif ($atyp == 4) {
    $addr = join ':', unpack('(H4)8', $bytes);
    $bytes = substr($bytes, 16);
  }

  my $port = unpack 'n', $bytes;

  _debug('Receive', ver => $ver, cmd => $cmd, rsv => $rsv, atyp => $atyp, addr => $addr, port => $port) if $DEBUG;

  my $rep = 0;
  $rep = 1 if $ver != 5;
  $rep = 7 if $cmd != 1;
  $rep = 8 if $atyp != 1 && $atyp != 3 && $atyp != 4;

  if ($rep != 0) {
    $stream->write(pack'C*', 5, $rep, 0, 1, 0, 0, 0, 0, 0, 0);
    if ($DEBUG) {
      _debug('Send', ver => 5, rep => $rep, rsv => 0, atyp => 1, addr => '0.0.0.0', port => 0);
      _debug('Close connection');
    }
    return $stream->close;
  }

  Mojo::IOLoop->client({address => $addr, port => $port, timeout => 5} => sub {
    my ($loop, $err, $foriegn_stream) = @_;

    if ($err) {
      my $rep = 0xff;
      $rep = 3 if $err =~ m/Transport endpoint is not connected/;
      $rep = 4 if $err =~ m/Can't resolve/;
      $rep = 4 if $err =~ m/Can't connect/;
      $rep = 5 if $err =~ m/Connection refused/;
      $rep = 6 if $err =~ m/timeout/;
      $stream->write(pack'C*', 5, $rep, 0, 1, 0, 0, 0, 0, 0, 0);
      if ($DEBUG) {
        say $err;
        _debug('Send', ver => 5, rep => $rep, rsv => 0, atyp => 1, addr => '0.0.0.0', port => 0);
        _debug('Close connection');
      }
      return $stream->close;
    }

    if (!$stream->handle or !$stream->handle->connected) {
      $stream->close;
      return $foriegn_stream->close;
    }

    $stream->timeout(0);
    $foriegn_stream->timeout(0);

    $stream->unsubscribe(read => $stream->subscribers('read')->[-1]);

    my $state = {};

    io_streams($state, 1, $stream, $foriegn_stream);
    io_streams($state, 0, $foriegn_stream, $stream);

    my $localaddr = $foriegn_stream->handle->sockaddr;
    my $localport = $foriegn_stream->handle->sockport;
    my $atyp = length $localaddr > 4 ? 4 : 1;

    $stream->write(pack('C*', 5, 0, 0, $atyp) . $localaddr . pack('n', $localport));
    if ($DEBUG) {
      my ($template, $separator) = $atyp == 1 ? ('C*', '.') : ('(H4)*', ':');
      my $localaddr_str = join $separator, unpack $template, $localaddr;
      _debug('Send', ver => 5, rep => 0, rsv => 0, atyp => $atyp, addr => $localaddr_str, port => $localport);
    }
  });
}

sub io_streams {
  my ($state, $is_client, $stream1, $stream2) = @_;

  $stream1->on('close' => sub {
    $stream2->close;
    undef $stream2;
  });

  $stream1->on('error' => sub {
    my ($stream, $err) = @_;
    $stream2->close;
    undef $stream2;
  });

  $stream1->on('read' => sub {
    my ($stream, $bytes) = @_;
    $stream2->write($bytes);
  });
}

Mojo::IOLoop->server({port => 3000} => sub {
  my ($loop, $stream) = @_;
  $stream->timeout(5);
  $stream->on(read => \&init_handshake);
});

Mojo::IOLoop->start unless Mojo::IOLoop->is_running;