#!/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 compression 
#   stream (RFC854, RFC855).
# Once option negotiation is complete, everything it sends us should be 
#   compressed.
# The connection is managed by Net::Telnet. I have modified its ->_fillbuf 
#   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 using 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 stream\n";
if ($zlib == undef) {
    print "inflateInit failed with error code: $status\n";
} 
    
# Use a standard Glib::Timeout to check the connection for incoming data, 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_supported}) {
            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 sequence.
        $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_pos));
        }

        ## 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
}