Perl read from socket missing first character - perl

Question

I am trying to read from an instrument connected over network using TCP protocol from Perl.
The code I have used is below:
$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;
}
What happens is the first character of every line that is read over the TCP is not printed. Instead it is replace with a space. Why does this happen?
Example:
Expected output
Copyright (c) ACME Corporation
2009 - 2010
Actual Output
opyright (c) ACME Corporation
009 - 2010
Thanks...

Answer 1

The telnet protocol has a little bit of negotiation at its startup, something I sometimes jokingly refer to as a “secret handshake”. You should use a more straight-through service/port to get up to speed with sockets.
Also, you really need two different threads of control for this sort of thing; otherwise it’s too hard. Here’s a simple telnetish program from 1998:
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;
And here’s a more complete implementation, a program that sits on your firewall and waits for internal connections to some outside port:
#!/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;
};
As I said, that’s from 1998. These days I’d use warnings and possibly use autodie, but you still should be able to learn a good bit from it.