Protocol wrapping?

[Anton Berezin]

Hi,

I have a task which involves doing multiple Telnet sessions.
I would like to use AnyEvent.
It is enough to support the bare basics of Telnet protocol
(basically replying WON'T and DON'T to any option negotiations),
so that in the end it is just an "issue command - get a response"
loop for a single connection.

So I've been thinking about abstracting away any Telnet specifics,
so that the application code just deals with the data.

To me this sounds like a job for a (rather thin) wrapper around
AnyEvent::Handle.
After a bit of thinking I decided that the cleanest way to do
it is to create a socket pair in addition to the actual remote
connection.  One handle out of the pair will be the one returned
to the user, and the second one (let's call it service handle)
will be used for reading the data user sends and for sending data back to
the user.  Whatever is received on the remote socket will get "unwrapped"
(stripped from Telnet sequences) and then sent via the service socket.
Whatever is received on the service socket will be "wrapped" (a no op
except \xff duplication) and then send back on the remote socket.

This seems to work reasonably well (the code is below), but
I am wondering whether this is a sane way of doing such things?

I am pretty new to AnyEvent, so I would not be surprized if I
missed a better, more idiomatic/less ugly way of achieving this.

Any thoughts?

The application code looks like this:

    my $handle; $handle = AnyEvent::Handle::Wrapped->new(
        connect => [ "somehost" => "telnet" ],
        on_error => sub {
            print "ERROR: $!\n";
            $handle->destroy;
        },
        on_eof => sub {
            print "EOF!\n";
            $handle->destroy;
        },
        on_read => sub {
            my $t = shift;
            print "$t->{rbuf}";
            $t->{rbuf} = "";
        },
    );
    $handle2->push_read(regex => qr<.*?\r\n(Login|Username):\s>s, sub {
        print "Got login prompt\n";
        $handle2->push_write("username\r\n");
    });
    $handle2->push_read(regex => qr<.*?\r\nPassword:\s>s, sub {
        print "Got pw prompt\n";
        $handle2->push_write("password\r\n");
    });
    $handle2->push_read(regex => qr[(.*?)\r\n\S+>]s, sub {
        print "Got output\n$1";
        $handle2->push_write("show version\r\n");
    });
	... etc ...

While the AnyEvent::Handle::Wrapped module is like this
(no error handling of any kind at the moment,
plus a bunch of debug output is there):

    package AnyEvent::Handle::Wrapped;
    use AnyEvent::Handle;
    use AnyEvent::Util;
    use Data::HexDump;
    
    BEGIN{ push our @ISA, 'AnyEvent::Handle'; }
    
    sub new
    {
        my $pkg = shift;
        my %args = @_;
        my ($user_fh, $service_fh) = portable_socketpair();
        my %remote_args = %args;
        my %service_args = %args;
        my %user_args = %args;
        delete @user_args{qw(fh connect on_prepare on_connect on_connect_error tls tls_ctx on_starttls on_stoptls)};
        delete @service_args{qw(fh connect on_prepare on_connect on_connect_error on_error on_read on_eof
            on_drain on_timeout on_rtimeout on_wtimeout tls tls_ctx on_starttls on_stoptls)};
        delete @remote_args{qw(on_read tls tls_ctx on_starttls on_stoptls)};
        my $user = $pkg->AnyEvent::Handle::new(%user_args, fh => $user_fh);
        $user->{wrap}{service} = AnyEvent::Handle->new(%service_args, fh => $service_fh, on_read => sub {
            $user->wrap($_[0]);
        });
        $user->{wrap}{remote} = AnyEvent::Handle->new(%remote_args, on_read => sub {
            $user->unwrap($_[0]);
        });
        return $user;
    }

    sub destroy
    {
        my $user = shift;
        my $service = $user->{wrap}{service};
        my $remote  = $user->{wrap}{remote};
        $service->destroy;
        $remote->destroy;
        $user->SUPER::destroy;
        print "Destruction commenced\n";
    }
    
    sub wrap
    {
        my ($user, $service) = @_;
        # XXX this should duplicate \xff's
        $user->{wrap}{remote}->push_write($service->{rbuf});
        $service->{rbuf} = "";
    }

    sub unwrap
    {
        my ($user, $remote) = @_;
        my $service = $user->{wrap}{service};
        if ($remote->{rbuf} =~ s/^\xff\xfc(.)//) {
            my $opt_char = $1;
            my $opt = ord $opt_char;
            print "Got WON'T $opt, ignoring\n";
        } elsif ($remote->{rbuf} =~ s/^\xff\xfe(.)//) {
            my $opt_char = $1;
            my $opt = ord $opt_char;
            print "Got DON'T $opt, ignoring\n";
        } elsif ($remote->{rbuf} =~ s/^\xff\xfd(.)//) {
            my $opt_char = $1;
            my $opt = ord $opt_char;
            print "Got DO $opt, sending WON'T $opt\n";
            $remote->push_write("\xff\xfc$opt_char");
        } elsif ($remote->{rbuf} =~ s/^\xff\xfb(.)//) {
            my $opt_char = $1;
            my $opt = ord $opt_char;
            print "Got WILL $opt, sending DON'T $opt\n";
            $remote->push_write("\xff\xfe$opt_char");
        } elsif ($remote->{rbuf} =~ s/^\xff\xff//) {
            print "Got FF data\n";
            $service->push_write("\xff");
        } elsif ($remote->{rbuf} =~ /^\xff/) {
            print "Got SOME command I don't grok, HELP\n";
            print HexDump $remote->rbuf;
        } elsif ($remote->{rbuf} =~ s/(.*?)\xff/\xff/) {
            my $input = $1;
            $service->push_write($input);
        } else {
            my $input = $remote->{rbuf};
            $service->push_write($input);
            $remote->rbuf = "";
        }
    }

Thanks in advance,
\Anton.
-- 
Our society can survive even a large amount of irrational regulation.
  -- John McCarthy