RFC854 and RFC855 specify a protocol for using zlib compression streams in telnet connections.

I'm trying to implement this in Perl but, of course, it doesn't work.

The call to Compress::Zlib->inflate fails. This script should display some nice decompressed text in the terminal window, instead we see some weird and wonderful ASCII characters.

Been trying for months to get it working. Any ideas?

#!/usr/bin/perl --

use Compress::Zlib;
use Glib;
use Gtk2 '-init';

# --------------------------------------------------------------------
+---------
# Try to decompress a zlib stream using Compress::Zlib.
# This script is a bare-bones telnet client. 
# During telnet option negotiation, we tell the server to use a zlib c
+ompression 
#   stream (RFC854, RFC855).
# Once option negotiation is complete, everything it sends us should b
+e 
#   compressed.
# The connection is managed by Net::Telnet. I have modified its ->_fil
+lbuf 
#   function, so that incoming text can be decompressed, before being 
+displayed 
#   in the terminal window.
# The call to Compress::Zlib->inflate at line 158 does not decompress 
+anything 
#   for reasons unknown.
# Instead of decompressed text, we see random ASCII characters.
# --------------------------------------------------------------------
+---------

# Connect to a random MUD that uses zlib compression, implemented usin
+g the MCCP 
#   protocol (RFC854, RFC855)
my $connectObj = MyTelnet->new();
$connectObj->open(
    Host        => 'iberiamud.mooo.com',
    Port        => 5900,
);

# Telnet option negotiation - accept MCCP compression
$connectObj->option_callback(sub {
    
    my ($obj, $option, $isRemote, $isEnabled, $wasEnabled, $bufPosn) =
+ @_;

    print "MCCP enabled!\n";
    return 1;
});
$connectObj->option_accept(Will => 86);
  
# Initiate Compress::Zlib
my ($zlib, $status) = inflateInit() or die "Cannot init inflation stre
+am\n";
if ($zlib == undef) {
    print "inflateInit failed with error code: $status\n";
} 
    
# Use a standard Glib::Timeout to check the connection for incoming da
+ta, and to 
#   display it in the user's terminal window
my $id = Glib::Timeout->add(100, sub { &checkIncoming() } );

sub checkIncoming {
        
    my $receive = $connectObj->get(
        Errmode => sub {},                 
        Timeout => 0,
    );
    
    if ($receive =~ m/connect/) {
        
        # Send a few random commands, to generate some compressed text
        $connectObj->print('connect testing testing');
        $connectObj->print('look');
    }

    if ($receive) {
        
        print $receive;
    }    
        
    return 1;
}

# Use a Gtk2 main loop because, why the hell not
Gtk2->main();

### Modified Net::Telnet package #####################################
+#########

{ package MyTelnet;

    use base ("Net::Telnet");

    # Modified ->_fillBuf. The only modified lines are clearly marked.
    # Everything else is inherited from Net::Telnet.
    
    sub _fillbuf {
        my ($self, $s, $endtime) = @_;
        my (
        $msg,
        $nfound,
        $nread,
        $pushback_len,
        $read_pos,
        $ready,
        $timed_out,
        $timeout,
        $unparsed_pos,
        );
                        
        ## If error from last read not yet reported then do it now.
        if ($s->{pending_errormsg}) {
        $msg = $s->{pending_errormsg};
        $s->{pending_errormsg} = "";
        return $self->error($msg);
        }

        return unless $s->{opened};

        while (1) {
        ## Maximum buffer size exceeded?
        return $self->error("maximum input buffer length exceeded: ",
                    $s->{maxbufsize}, " bytes")
            unless length($s->{buf}) <= $s->{maxbufsize};

        ## Determine how long to wait for input ready.
        ($timed_out, $timeout) = &_timeout_interval($endtime);
        if ($timed_out) {
            $s->{timedout} = 1;
            return $self->error("read timed-out");
        }

        ## Wait for input ready.
        $nfound = select $ready=$s->{fdmask}, "", "", $timeout;

        ## Handle any errors while waiting.
        if ((!defined $nfound or $nfound <= 0) and $s->{select_support
+ed}) {
            if (defined $nfound and $nfound == 0) {  # timed-out
            $s->{timedout} = 1;
            return $self->error("read timed-out");
            }
            else {  # error waiting for input ready
            if (defined $EINTR) {
                next if $! == $EINTR;  # restart select()
            }
            else {
                next if $! =~ /^interrupted/i;  # restart select()
            }

            $s->{opened} = '';
            return $self->error("read error: $!");
            }
        }

        ## Append to buffer any partially processed telnet or CR seque
+nce.
        $pushback_len = length $s->{pushback_buf};
        if ($pushback_len) {
            $s->{buf} .= $s->{pushback_buf};
            $s->{pushback_buf} = "";
        }

        ## Read the waiting data.
        $read_pos = length $s->{buf};
        $unparsed_pos = $read_pos - $pushback_len;
        $nread = sysread $self, $s->{buf}, $s->{blksize}, $read_pos;

        ### Modified section #########################################
+#########
        ### This part should decompress the zlib stream, but it doesn'
+t work ##
        if ($nread && $s->{opts}{86}{remote_enabled}) {
            
            my ($nout, $status) = $y->inflate($s->{buf});
            if (! defined $nout) {
                
                print "Error inflating: errnum: $status\n";
            
            } else {
                
                # Inflation successful
                $s->{buf} = $nout;
                $nread = length ($nout);
            }
        }    
        ##############################################################
+#########
        
        ## Handle any read errors.
        if (!defined $nread) {  # read failed
            if (defined $EINTR) {
            next if $! == $EINTR;  # restart sysread()
            }
            else {
            next if $! =~ /^interrupted/i;  # restart sysread()
            }

            $s->{opened} = '';
            return $self->error("read error: $!");
        }

        ## Handle eof.
        if ($nread == 0) {  # eof read
            $s->{opened} = '';
            return;
        }

        ## Display network traffic if requested.
        if ($s->{dumplog}) {
            &_log_dump('<', $s->{dumplog}, \$s->{buf}, $read_pos);
        }

        ## Process any telnet commands in the data stream.
        if ($s->{telnet_mode} and index($s->{buf},"\377",$unparsed_pos
+) > -1) {
            &_interpret_tcmd($self, $s, $unparsed_pos);
        }

        ## Process any carriage-return sequences in the data stream.
        &_interpret_cr($s, $unparsed_pos);

        ## Read again if all chars read were consumed as telnet cmds.
        next if $unparsed_pos >= length $s->{buf};

        ## Log the input if requested.
        if ($s->{inputlog}) {
            &_log_print($s->{inputlog}, substr($s->{buf}, $unparsed_po
+s));
        }

        ## Save the last line read.
        &_save_lastline($s);

        ## We've successfully read some data into the buffer.
        last;
        } # end while(1)

        1;
    } # end sub _fillbuf
}
[download]