in reply to Re^12: Can't decompress zlib compression stream with Compress:Zlib
in thread Can't decompress zlib compression stream with Compress:Zlib

Net::Telnet doesn't easily lend itself to subclassing, at least not in the way you want to use it. It calls the (private) subroutine _fillbuf as:

&_fillbuf($self, $s, 0);

[download]

... which will never respect inheritance.

Before copying and rewriting Net::Telnet in a more approachable manner, you can monkey-patch Net::Telnet instead of inheriting:

require Net::Telnet;
{
no warnings 'redefine';
*Net::Telnet::_fillbuf = sub {
    ...
};
};

my $connectObj = Net::Telnet->new();
$connectObj->open(
    Host        => 'iberiamud.mooo.com',
    Port        => 5900,
);

[download]

Replies are listed 'Best First'.
Re^14: Can't decompress zlib compression stream with Compress:Zlib
by lesrol (Initiate) on Oct 11, 2016 at 16:52 UTC

    Thanks. I have monkey patched the test script as you suggest, adding debug messages as suggested by pmqs.

    The first call to Compress::Zlib->inflate succeeds, and we see the expected 'Wrong password' message and a new prompt.

    Subsequent calls to Compress::Zlib->inflate fail

    *TEST* Success, inflated text size 28
Wrong password.  
>
*TEST* Error inflating: errnum: data error
*TEST*   msg: invalid code lengths set

    [download]

    The new, improved test script:

    #!/usr/bin/perl --

use strict;
use warnings;
use Compress::Zlib;
use Gtk2 '-init';

# --------------------------------------------------------------------
+---------
# Try to decompress a zlib stream using Compress::Zlib.
# This script works as a bare-bones telnet client. 
# During telnet option negotiation, we tell the server to use a zlib c
+ompression 
#   stream (RFC1950).
# Once option negotiation is complete, everything it sends us should b
+e 
#   compressed.
# The connection is managed by Net::Telnet, whose ->_fillbuf function 
+has been
#   modified so that incoming text can be decompressed (inflated) befo
+re being
#   displayed in the terminal window
# The first call to Compress::Zlib->inflate succeeds, subsequent calls
+ fail
# --------------------------------------------------------------------
+---------

# Compress::Zlib object
our ($ZLIB_OBJ, $ZLIB_STATUS, $STREAM_FLAG, $TELNET_OBJ);

# Monkey-patch Net::Telnet so this test file contains only the Net::Te
+lnet 
#   function we want to modify (following http://perlmonks.org/?node_i
+d=1173735)
require Net::Telnet;

{
    no warnings 'redefine';
    *Net::Telnet::_fillbuf = sub {
        
        # Modified ->_fillBuf. The modified section is clearly marked.
+ Also 
        #   removed some logging code we don't need
                
        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);
        ($timed_out, $timeout) = &Net::Telnet::_timeout_interval($endt
+ime);
        if ($timed_out) {
            $s->{timedout} = 1;
            return $self->error("read timed-out");
        }

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

        ## 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 #########################################
+#########
        if ($nread && $s->{opts}{86}{remote_enabled}) {
                
            my ($buff, $posn, $nout, $status);

            $buff = $s->{buf};

            # We're expecting telnet option negotiation IAC SB MCCP IA
+C SE,
            #   followed by chr(120), which marks the start of the zli
+b stream
            $posn = index($buff, chr(120));
            if ($posn > -1) {
                    
                # Ignore everything before the zlib stream
                $buff = substr($buff, $posn);
                # IAC... received
                $STREAM_FLAG = 1;
            }
            
            if ($buff && $STREAM_FLAG) {

                # zlib stream has started. Decompress everything
                ($nout, $status) = $ZLIB_OBJ->inflate($buff);
                if ( (! defined $nout) || ($buff && ! $nout) ) {
                        
                    print "*TEST* Error inflating: errnum: $status\n";
                    if ($ZLIB_OBJ->msg()) {
                        
                        print "*TEST*   msg: " . $ZLIB_OBJ->msg() . "\
+n";
                    }        

                } else {
                        
                    # Inflation successful
                    $s->{buf} = $nout;
                    $nread = length ($nout);
                    print "*TEST* Success, inflated text size $nread\n
+";
                }
            }
        }    
        ##############################################################
+#########
            
        ## Handle eof.
        if ($nread == 0) {  # eof read
            $s->{opened} = '';
            return;
        }
            
        ## 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);
            &Net::Telnet::_interpret_tcmd($self, $s, $unparsed_pos);
        }

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

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

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

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

        1;
        
    } # end sub _fillbuf
}   # end of monkey patch

# Connect to a random MUD that uses zlib compression, implemented usin
+g the 
#   MCCP protocol (RFC1950)
$TELNET_OBJ = Net::Telnet->new();
$TELNET_OBJ->open(
    Host        => 'iberiamud.mooo.com',
    Port        => 5900,
);

# Telnet option negotiation - accept zlib compression (must specify a 
+callback 
#   subroutine)
$TELNET_OBJ->option_callback(sub {
    
    my ($obj, $option, $isRemote, $isEnabled, $wasEnabled, $bufPosn) =
+ @_;

    print "MCCP enabled!\n";
    return 1;
});

$TELNET_OBJ->option_accept(Will => 86);
  
# Initiate Compress::Zlib
($ZLIB_OBJ, $ZLIB_STATUS) = inflateInit();
if (! defined $ZLIB_OBJ) {
    
    print "->inflateInit failed with error code: $ZLIB_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 {
        
    my $receive = $TELNET_OBJ->get(
        Errmode => sub {},                 
        Timeout => 0,
    );
    
    if (defined $receive && $receive =~ m/connect/) {
        
        # Send a few invalid logins, to generate some compressed text 
+for 
        #   Compress::Zlib to inflate
        my @invalidList = (
            'connect testing testing', 
            'connect elvis presley',
        );
        
        foreach my $cmd (@invalidList) {
                        
            $TELNET_OBJ->print($cmd);
        }
    }

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

## Use a Gtk2 main loop because 'while (1) {}' doesn't work
Gtk2->main();

    [download]
[reply]
[d/l]
[select]

      Here is a question - do you expect the complete compressed buffer to be present in the sysread you do directly before the call to inflate ?

      Looking at the code I'm guessing that it isn't. Please correct me if that is wrong.

      So, assuming that is the case, the code in its current state has a number of problems.

      Firstly, the code doesn't explicitly handle the end of the compressed data stream at all.

      In this section of code you are using the absence of any data in $nout to flag an error. That isn't safe 

                
            my ($nout, $status) = $zlib->inflate($s->{buf});
            if (! defined $nout) {
                
                print "Error inflating: errnum: $status\n";
            
            } else {
                
                # Inflation successful
                $s->{buf} = $nout;
                $nread = length ($nout);
            }

      [download]

      You should instead be checking the value of $status returned from inflate. If you get Z_OK, inflate has succeeded and the content from the next sysread (when _fillbuff gets called again) can be fed to inflate. If you get Z_STREAM_END that signals the end of the compressed data stream, so the next sysread can't be fed to inflate (unless the telnet protocol allows multiple zlib streams). Any other status code means an error of some sort in the compressed data stream.

      One other issue you need to take care of when you get Z_STREAM_END is the presence of trailing data directly after the end of the zlib data stream (don't know the details of how telnet works with zlib, so I don't know if this will happen in practice). If there is trailing data the $buf variable will contain it (inflate will remove all compressed data from the buffer parameter you pass it). In this case I think you can deak with that by changing this line 

       $s->{buf} = $nout

      [download]

      to this 

       $s->{buf} = $nout . $buff;

      [download]

      Next potential problem is pushback_buf. That looks like it is used to store data that hasn't been processed by the telnet protocol. The problem is that the data from sysread is prefixed by any pushback_buf that exists. If a previous call to __fillbuf made a call to inflate and the telnet module hasn't used up all of the data read, you end up trying to uncompress something that is prefixed with uncompressed data.

[reply]
[d/l]
[select]

        After implementing those changes, the script now works perfectly (as if by magic).

        I hardly have the words to express my thanks, so I'll settle for posting working code for the next poor sucker who tries to do the same thing.

        #!/usr/bin/perl --

use strict;
use warnings;
use Compress::Zlib;
use Gtk2 '-init';

# --------------------------------------------------------------------
+---------
# Try to decompress a zlib stream using Compress::Zlib.
# This script works as a bare-bones telnet client. 
# During telnet option negotiation, we tell the server to use a zlib c
+ompression 
#   stream (RFC1950).
# Once option negotiation is complete, everything it sends us should b
+e 
#   compressed.
# The connection is managed by Net::Telnet, whose ->_fillbuf function 
+has been
#   modified so that incoming text can be decompressed (inflated) befo
+re being
#   displayed in the terminal window
# All calls to Compress::Zlib->inflate now succeeds
# --------------------------------------------------------------------
+---------

# Compress::Zlib object
our ($ZLIB_OBJ, $ZLIB_STATUS, $STREAM_FLAG, $TELNET_OBJ);

# Monkey-patch Net::Telnet so this test file contains only the Net::Te
+lnet 
#   function we want to modify (following http://perlmonks.org/?node_i
+d=1173735)
require Net::Telnet;

{
    no warnings 'redefine';
    *Net::Telnet::_fillbuf = sub {
        
        # Modified ->_fillBuf. The modified section is clearly marked.
+ Also 
        #   removed some logging code we don't need
                
        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);
        ($timed_out, $timeout) = &Net::Telnet::_timeout_interval($endt
+ime);
        if ($timed_out) {
            $s->{timedout} = 1;
            return $self->error("read timed-out");
        }

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

        ## 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 #########################################
+#########
        if ($nread && $s->{opts}{86}{remote_enabled}) {
                
            my ($buff, $posn, $previous, $nout, $status);

            $buff = $s->{buf};
            
            # We're expecting telnet option negotiation IAC SB MCCP IA
+C SE,
            #   followed by chr(120), which marks the start of the zli
+b stream
            if (! $STREAM_FLAG) {
                
                $posn = index($buff, chr(120));
                if ($posn > -1) {
                        
                    # Ignore everything before the zlib stream
                    $buff = substr($buff, $posn);
                    # IAC... received
                    $STREAM_FLAG = 1;
                }
            
            } elsif ($pushback_len) {
                
                # If any partially processed telnet or CR sequence was
+ appended 
                #   to the buffer, we mustn't try to inflate that port
+ion
                $previous = substr($buff, 0, $pushback_len);
                $buff = substr($buff, $pushback_len);
            }
                                        
            if ($buff && $STREAM_FLAG) {

                # zlib stream has started. Decompress stuff
                ($nout, $status) = $ZLIB_OBJ->inflate($buff);
                
                # Respond to stream end or inflation errors
                if ($status == Z_STREAM_END) {
                    
                    print "*TEST* End of zlib stream\n";
                    # (Don't inflate anything after this point)
                    $STREAM_FLAG = 0;
                    # Append anything after the end of the data stream
                    if (defined $previous) {
                        $s->{buf} = $previous . $nout . $buff;
                    } else {
                        $s->{buf} = $nout . $buff;
                    }
                
                    $nread = length $s->{buf};
                                        
                } elsif ($status != Z_OK) {
                        
                    print "*TEST* Error inflating: errnum: $status\n";
                    if ($ZLIB_OBJ->msg()) {
                        print "*TEST*   msg: " . $ZLIB_OBJ->msg() . "\
+n";
                    } else {
                        print "*TEST*   msg: <none>\n";
                    }

                } else {
                        
                    # Inflation successful!
                    if (defined $previous) {
                        $s->{buf} = $previous . $nout;
                    } else {
                        $s->{buf} = $nout;
                    }
                    
                    $nread = length $s->{buf};
                }
            }
        }    
        ##############################################################
+#########
            
        ## Handle eof.
        if ($nread == 0) {  # eof read
            $s->{opened} = '';
            return;
        }
            
        ## 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);
            &Net::Telnet::_interpret_tcmd($self, $s, $unparsed_pos);
        }

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

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

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

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

        1;
        
    } # end sub _fillbuf
}   # end of monkey patch

# Connect to a random MUD that uses zlib compression, implemented usin
+g the 
#   MCCP protocol (RFC1950)
$TELNET_OBJ = Net::Telnet->new();
$TELNET_OBJ->open(
    Host        => 'iberiamud.mooo.com',
    Port        => 5900,
);

# Telnet option negotiation - accept zlib compression (must specify a 
+callback 
#   subroutine)
$TELNET_OBJ->option_callback(sub {
    
    my ($obj, $option, $isRemote, $isEnabled, $wasEnabled, $bufPosn) =
+ @_;

    print "MCCP enabled!\n";
    return 1;
});

$TELNET_OBJ->option_accept(Will => 86);
  
# Initiate Compress::Zlib
($ZLIB_OBJ, $ZLIB_STATUS) = inflateInit();
if (! defined $ZLIB_OBJ) {
    
    print "->inflateInit failed with error code: $ZLIB_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 {
        
    my $receive = $TELNET_OBJ->get(
        Errmode => sub {},                 
        Timeout => 0,
    );
    
    if (defined $receive && $receive =~ m/connect/) {
        
        # Send a few invalid logins, to generate some compressed text 
+for 
        #   Compress::Zlib to inflate
        my @invalidList = (
            'connect testing testing', 
            'connect elvis presley',
            'connect samson delilah',
        );
        
        foreach my $cmd (@invalidList) {
                        
            $TELNET_OBJ->print($cmd);
        }
    }

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

## Use a Gtk2 main loop because 'while (1) {}' doesn't work
Gtk2->main();

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom