RFC1950指定了使用zlib压缩数据流的协议。
我试图编写一个可以解压缩传入数据的简单telnet客户端。但是，我没有尝试任何工作。下面的脚本使用Compress :: Zlib-＆gt; inflate，但是失败了。
我还尝试过IO :: Uncompress :: Inflate，IO :: Uncompress :: AnyInflate和Compress :: Raw :: Zlib。由于它们都不起作用，我猜测我错过了一些关键步骤。
编辑：以下代码现在可以完美运行。谢谢，全部。
#!/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 compression
# stream (RFC1950).
# Once option negotiation is complete, everything it sends us should be
# compressed.
# The connection is managed by Net::Telnet, whose ->_fillbuf function has been
# modified so that incoming text can be decompressed (inflated) before 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::Telnet
# function we want to modify (following http://perlmonks.org/?node_id=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($endtime);
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 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 ##################################################
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 IAC SE,
# followed by chr(120), which marks the start of the zlib 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 portion
$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 using 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 data, 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();