Feb 25

Netcat Clone in Three Languages – Part III (Perl)

So for the final segment in the netcat clone series (see this and this) I’m going to write it in Perl…

NOTE: apparently not everyone is having great success. I have tried this out under cygwin and redhat enterprise linux 5, but if it doesn’t work for you please leave a comment and I’ll see what I can do.

Perl

As always the source for this script is available here

The final language is Perl the most popular of UNIX scripting languages. I’m afraid I’m hardly the Perl expert so there is a limit to how obscure I can make this. I’ll go ahead and use perl objects just to be consistent though I’m not sure Perl objects ever really took off among a large portion of the Perl community. As always the first step:

The Command Line Arguments

The first task, as always is to parse the command line arguments:

#!/usr/bin/perl
 
use Getopt::Long;
 
package NetTool;
 
sub new{
    my $self = {}; 
    bless($self);
    return $self;
}
 
sub run {
    my ($self) = @_; 
    $self->parse_options();
}
 
sub usage{
    print "net_tool.pl [options]\n";
    print "  --connect connect to remote host.\n";
    print "  --listen listen for connection.\n";
    print "  --remote-host HOST host to connect to.\n";
    print "  --port PORT specify TCP port.\n";
    print "  --help print this message.\n"
}
 
sub parse_options{
    my ($self) = @_; 
    my $result = Getopt::Long::GetOptions(
                "connect"=> \$self->{connect},
                "listen" => sub { $self->{connect} = 0},
                "remote-host=s" => \$self->{hostname},
                "port=i" => \$self->{port},
                "help" => sub {usage(); exit(0);}); 
    if(!$result){
        usage();
        exit(1);
    }   
    if(!defined($self->{connect})){
        print("must specify either --connect or --listen\n");
        usage();
        exit(1);
    }   
    if(!$self->{port}){
        print("must specify a TCP port\n");
        usage();
        exit(1);
    }   
 
    if($self->{connect} && !defined($self->{hostname})){
        print("connect type requires a hostname\n");
        usage();
        exit(1);
    }   
}
 
package main;
 
$main::tool = NetTool->new();
 
$main::tool->run();

All in all I’m a bit disappointed with Perl here. There were about 30 different option parsing libraries only a few of which were beyond version .2 . Of those only this one provided long options and half way decent documentation. It gets the job done, but it seems to take a bit more work.

Also, perl object syntax is by far the worst of the three. It is clearly a hack onto the language and in the basics a lot less clear to the average object oriented developer. There is a lot of extra syntax required to force the Perl language into an OO shaped hole that just clutters up the definition and produces weird errors when absent.

To be fair most Perl developers don’t seem to bother a lot with it and I suppose at least using the object is straight forward even if defining it isn’t.

Starting up the Socket

Now we need to set up the socket specified in the options

package NetTool;
....
sub connect_socket{
    my ($self) = @_;
    if($self->{connect}){
        $self->{socket} = new IO::Socket::INET (
            PeerAddr => $self->{hostname},
            PeerPort => $self->{port},
            Proto => 'tcp'
        ); 
        die "Could not connect: $!\n" unless $self->{socket};
    }else{
        my $server = new IO::Socket::INET (
            LocalHost => 'localhost',
            LocalPort => $self->{port},
            Listen => 1,
            Reuse => 1);
        die "Could not listen on port $self->{port}: $!\n" 
            unless $server;
        $self->{socket} = $server->accept();
    }
}

This was pretty straight forward, but some of the error messages were terrible. I tried

./net_tool.pl --connect -p 12345 --remote-host bob

And got “Could not connect: Invalid argument” instead of a message indicating bob could not be resolved as a hostname. On the other hand, at
least some of the set up is a bit clearer.

Asynchronous IO

So now to actually pass data from STDIN to socket out and socket in to STDOUT.

package NetTool;
....
sub forward_data{
    my ($self) = @_; 
    my $set = new IO::Select();
    $set->add($self->{socket});
    $set->add(STDIN);
    my $socket_set = new IO::Select();
    $socket_set->add($self->{socket});
    my $stdin_set = new IO::Select();
    $stdin_set->add(STDIN);
    $self->{socket}->blocking(0) 
        or die("unable to set socket to nonblocking");
    STDIN->blocking(0) 
        or die("unable to set stdin to nonblocking");
    while(1){
        my $select_set = IO::Select->select($set, undef, undef); 
        my $buffer = '0';
        while( $socket_set->can_read(0) ){
            my $bytes = 
                $self->{socket}->read($buffer, 100) or return;
            STDOUT->write($buffer);
        }
 
        $buffer = '0';
        while( $stdin_set->can_read(0) ){
            STDIN->read($buffer, 100) or return;
            $self->{socket}->write($buffer);
        }
    }
}

The perl documentation when it comes to non-blocking IO is so poor as to be basically nonexistant, but still I suppose it all worked out. And unlike python Perl handled the IO properly without a whole lot of mucking about.

The Author

Michael Smit is a software engineer in Seattle, Washington who works for amazon

14 comments

14 Comments so far

  1. 4thmouse.com » Embedding Rhino (Part I) March 11th, 2008 6:39 pm

    [...] into your Java applications. I thought I’d try writing yet another implementation of the net_tool application using Rhino. Originally this was going to be a single article, but it turns out to be a [...]