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