我试图从使用Perl的TCP协议通过网络连接的仪器上读取。 我使用的代码如下：
$socket = new IO::Socket::INET (
PeerHost => '210.232.14.204',
PeerPort => '23',
Proto => 'tcp',
) or die "ERROR in Socket Creation";
while(!($data=~m/"ABC"/))
{
$temp = <$socket>;
$data = $data + $temp;
print $temp;
}
不会打印通过TCP读取的每一行的第一个字符。相反，它被替换为空格。为什么会这样？
示例：
预期输出
Copyright (c) ACME Corporation
2009 - 2010
实际输出
opyright (c) ACME Corporation
009 - 2010
...谢谢
答案 0 :(得分：5)
telnet协议在启动时有一点谈判，我有时开玩笑地称之为“秘密握手”。您应该使用更直接的服务/端口来加快套接字的速度。
另外，你真的需要两种不同的控制线来做这种事情;否则太难了。这是1998年的一个简单的telnetish程序：
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);
unless (@ARGV == 2) { die "usage: $0 host port" }
($host, $port) = @ARGV;
# create a tcp connection to the specified host and port
$handle = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
PeerPort => $port)
or die "can't connect to port $port on $host: $!";
$handle->autoflush(1); # so output gets there right away
print STDERR "[Connected to $host:$port]\n";
# split the program into two processes, identical twins
die "can't fork: $!" unless defined($kidpid = fork());
if ($kidpid) {
# parent copies the socket to standard output
while (defined ($line = <$handle>)) {
print STDOUT $line;
}
kill("TERM" => $kidpid); # send SIGTERM to child
}
else {
# child copies standard input to the socket
while (defined ($line = <STDIN>)) {
print $handle $line;
}
}
exit;
这是一个更完整的实现，一个位于防火墙上的程序，等待内部连接到一些外部端口：
#!/usr/bin/perl -w
# fwdport -- act as proxy forwarder for dedicated services
use strict; # require declarations
use Getopt::Long; # for option processing
use Net::hostent; # by-name interface for host info
use IO::Socket; # for creating server and client sockets
use POSIX ":sys_wait_h"; # for reaping our dead children
my (
%Children, # hash of outstanding child processes
$REMOTE, # whom we connect to on the outside
$LOCAL, # where we listen to on the inside
$SERVICE, # our service name or port number
$proxy_server, # the socket we accept() from
$ME, # basename of this program
);
($ME = $0) =~ s,.*/,,; # retain just basename of script name
check_args(); # processing switches
start_proxy(); # launch our own server
service_clients(); # wait for incoming
die "NOT REACHED"; # you can't get here from there
# process command line switches using the extended
# version of the getopts library.
sub check_args {
GetOptions(
"remote=s" => \$REMOTE,
"local=s" => \$LOCAL,
"service=s" => \$SERVICE,
) or die <<EOUSAGE;
usage: $0 [ --remote host ] [ --local interface ] [ --service service ]
EOUSAGE
die "Need remote" unless $REMOTE;
die "Need local or service" unless $LOCAL || $SERVICE;
}
# begin our server
sub start_proxy {
my @proxy_server_config = (
Proto => 'tcp',
Reuse => 1,
Listen => SOMAXCONN,
);
push @proxy_server_config, LocalPort => $SERVICE if $SERVICE;
push @proxy_server_config, LocalAddr => $LOCAL if $LOCAL;
$proxy_server = IO::Socket::INET->new(@proxy_server_config)
or die "can't create proxy server: $@";
print "[Proxy server on ", ($LOCAL || $SERVICE), " initialized.]\n";
}
sub service_clients {
my (
$local_client, # someone internal wanting out
$lc_info, # local client's name/port information
$remote_server, # the socket for escaping out
@rs_config, # temp array for remote socket options
$rs_info, # remote server's name/port information
$kidpid, # spawned child for each connection
);
$SIG{CHLD} = \&REAPER; # harvest the moribund
accepting();
# an accepted connection here means someone inside wants out
while ($local_client = $proxy_server->accept()) {
$lc_info = peerinfo($local_client);
set_state("servicing local $lc_info");
printf "[Connect from $lc_info]\n";
@rs_config = (
Proto => 'tcp',
PeerAddr => $REMOTE,
);
push(@rs_config, PeerPort => $SERVICE) if $SERVICE;
print "[Connecting to $REMOTE...";
set_state("connecting to $REMOTE"); # see below
$remote_server = IO::Socket::INET->new(@rs_config)
or die "remote server: $@";
print "done]\n";
$rs_info = peerinfo($remote_server);
set_state("connected to $rs_info");
$kidpid = fork();
die "Cannot fork" unless defined $kidpid;
if ($kidpid) {
$Children{$kidpid} = time(); # remember his start time
close $remote_server; # no use to master
close $local_client; # likewise
next; # go get another client
}
# at this point, we are the forked child process dedicated
# to the incoming client. but we want a twin to make i/o
# easier.
close $proxy_server; # no use to slave
$kidpid = fork();
die "Cannot fork" unless defined $kidpid;
# now each twin sits around and ferries lines of data.
# see how simple the algorithm is when you can have
# multiple threads of control?
# this is the fork's parent, the master's child
if ($kidpid) {
set_state("$rs_info --> $lc_info");
select($local_client); $| = 1;
print while <$remote_server>;
kill('TERM', $kidpid); # kill my twin cause we're done
}
# this is the fork's child, the master's grandchild
else {
set_state("$rs_info <-- $lc_info");
select($remote_server); $| = 1;
print while <$local_client>;
kill('TERM', getppid()); # kill my twin cause we're done
}
exit; # whoever's still alive bites it
} continue {
accepting();
}
}
# helper function to produce a nice string in the form HOST:PORT
sub peerinfo {
my $sock = shift;
my $hostinfo = gethostbyaddr($sock->peeraddr);
return sprintf("%s:%s",
$hostinfo->name || $sock->peerhost,
$sock->peerport);
}
# reset our $0, which on some systems make "ps" report
# something interesting: the string we set $0 to!
sub set_state { $0 = "$ME [@_]" }
# helper function to call set_state
sub accepting {
set_state("accepting proxy for " . ($REMOTE || $SERVICE));
}
# somebody just died. keep harvesting the dead until
# we run out of them. check how long they ran.
sub REAPER {
my $child;
my $start;
while (($child = waitpid(-1,WNOHANG)) > 0) {
if ($start = $Children{$child}) {
my $runtime = time() - $start;
printf "Child $child ran %dm%ss\n",
$runtime / 60, $runtime % 60;
delete $Children{$child};
} else {
print "Bizarre kid $child exited $?\n";
}
}
# If I had to choose between System V and 4.2, I'd resign. --Peter Honeyman
$SIG{CHLD} = \&REAPER;
};
正如我所说，那是从1998年开始的。这些天我use warnings，可能use autodie，但你仍然可以从中学到很多东西。