Perl IO::Socket successive read/writes

I currently have an issue communicating with an external system (redbox recorders for those that are aware of it). Their system relies on sending and recieving commands which are built as a hex value followed by length of data then the data itself which amounts to a long-short-whatever.

The code below illustrates how to connect and login, which it does successfully as I recieve the expected response.

My issue is when I send the next command, the response I expect is the trailing data from the original response. Would anyone be able to guide me in the right direction?

#!/usr/bin/perl

use IO::Socket;
use strict;

$| = 1;
print "======================================================================\n";
my $login = "88000100";
my $username = ""; # total = 11
my $password = ""; # total = 12

print "Attempting to connect ... \n";

my $sock = IO::Socket::INET->new(
    PeerAddr  => '10.8.12.20',
    PeerPort  => 1401,
    Proto => 'tcp');
die "Could not create socket: $!\n" unless $sock;

print "Connected\n";

####################################################################
#Login

my $packed_cmd = pack "h* s x Z11 Z12", scalar(reverse($login)), '23', $username, $password;
print "Transmitting : Login cmd\n";

$sock->send($packed_cmd) or die "didn't send anything";

my $data;
$sock->recv($data,4);

$data = unpack( 'h*sx', $data );
my $response = substr($data,0,8);
$response = reverse($response);
print "Response is : $response \n" if $data;
print "Received from Server : $data\n" if $data;

#####################################################################
#Status
sleep(5);

my $socketStatus =  $sock->connected;
print "Socket Active\n" if $socketStatus;


print "===== Recorder Status =====\n";
my $status_cmd = "88000102";
#print scalar reverse $suppress_call_cmd;
my $packed_cmd = pack "h*sx", scalar(reverse($status_cmd)), '0';
print "Transmitting : Status cmd\n";
$sock->send($packed_cmd);
##########################
$data = undef;
$sock->recv($data,4);
$data  = unpack( 'h*sxlllll', $data );

my $response = substr($data,0,8);
$response = reverse($response);
print "Response is : $response \n." if $data;
print "Received from Server : $data\n." if $data;

Output:

======================================================================
Attempting to connect ...
Connected
Transmitting : Login cmd
Response is : 98000100
Received from Server : 00100089
Socket Active
===== Recorder Status =====
Transmitting : Status cmd
Response is : 00010004
.Received from Server : 40001000

If it helps, this is a snippet of the tcpdump

login request

    0x0000:  0000 5e00 0101 000c 2964 dc15 0800 4500  ..^.....)d....E.
    0x0010:  0052 2320 4000 4006 e5f4 0a08 116e 0a08  .R#.@.@......n..
    0x0020:  0c14 89e0 0579 0777 2a24 3843 08ff 8018  .....y.w*$8C....
    0x0030:  002e 31d6 0000 0101 080a 6734 093d 0000  ..1.......g4.=..
    0x0040:  0000 0001 0088 1700 0061 646d 696e 0000  .........admin..
    0x0050:  0000 0000 xxxx xxxx xxxx xxxx xxxx xxxx  ....xxxxxxxxxxxx

login respose

    0x0000:  000c 2964 dc15 001b 3f49 8400 0800 4500  ..)d....?I....E.
    0x0010:  003e 73dd 4000 7f06 564b 0a08 0c14 0a08  .>s.@...VK......
    0x0020:  116e 0579 89e0 3843 08ff 0777 2a42 8018  .n.y..8C...w*B..
    0x0030:  ffe1 e76a 0000 0101 080a 00de e48f 6734  ...j..........g4
    0x0040:  093d 0001 0098 0400 0100 0000

status request

    0x0000:  0000 5e00 0101 000c 2964 dc15 0800 4500  ..^.....)d....E.
    0x0010:  003b 2322 4000 4006 e609 0a08 116e 0a08  .;#"@.@......n..
    0x0020:  0c14 89e0 0579 0777 2开发者_运维百科a42 3843 0909 8018  .....y.w*B8C....
    0x0030:  002e 31bf 0000 0101 080a 6734 1dc6 00de  ..1.......g4....
    0x0040:  e48f 0201 0088 0000 00  

1. You're never reading more than 4 bytes from the server after each request. Since you're not reading the entire response, you can't decode the entire response, and you're not in the correct position to read the next response.

2. Your use of the "h*" pack template seems to be wrong every single time you use it -- if nothing else, it should be "h8". In particular, unpack "h*sx" *can't possibly work and makes an error here.

3. The use of reverse is also pretty alarming -- why not just use pack templates that have the correct endianness to begin with?

4. Stop repeating yourself! Write functions to do send and receive operations instead of rewriting the same code for every single command.

A start at some useful code would be:

sub send_packet {
    my ($sock, $cmd, $data) = @_;
    my $packed = pack "H8Sxa*", $cmd, length $data, $data;
    $sock->send($packed) or die "$! sending command";
}

sub recv_packet {
    my ($sock) = @_;
    my ($header, $data);
    $sock->recv($header, 9) or die "$! receiving header";
    my ($type, $length) = unpack "H8S", $header;
    $sock->recv($data, $length) or die "$! receiving data";
    return ($type, $data);
}

although that's all highly speculative without some kind of sane specification for the protocol -- the packet dumps you show don't seem to bear very much relation at all to the code you provided.