Commenting out half of Net::Telnet seems to do the trick.
#!/usr/bin/perl -- use strict; use warnings; use diagnostics; 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 (! defined $zlib) { 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 (defined $receive && $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_suppor +ted}) { # 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) = $zlib->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_p +os)); # } ## 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 }
In reply to Re^8: Can't decompress zlib compression stream with Compress:Zlib
by Anonymous Monk
in thread Can't decompress zlib compression stream with Compress:Zlib
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |