Perl IO :: Socket последовательное чтение / запись

Question

В настоящее время у меня есть проблема при связи с внешней системой (устройства записи Redbox для тех, кто знает об этом).Их система основывается на отправке и получении команд, которые построены в виде шестнадцатеричного значения, за которым следует длина данных, а затем сами данные, которые составляют длинную-короткую позицию.что он делает успешно, когда я получаю ожидаемый ответ.

Моя проблема заключается в том, что, когда я отправляю следующую команду, я ожидаю, что это завершающие данные из исходного ответа.Кто-нибудь сможет направить меня в нужном направлении?

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

Вывод:

======================================================================
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

Если это поможет, это фрагмент tcpdump

loginrequest

    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

логин 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

статус запроса

    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 2a42 3843 0909 8018  .....y.w*B8C....
    0x0030:  002e 31bf 0000 0101 080a 6734 1dc6 00de  ..1.......g4....
    0x0040:  e48f 0201 0088 0000 00  

Answer 1

1. Вы никогда не читаете больше 4 байтов с сервера после каждого запроса.Поскольку вы не читаете весь ответ, вы не можете декодировать весь ответ, и вы не в правильном положении для чтения следующего ответа.

2. Использование вамиШаблон "h*" упаковок кажется неправильным каждый раз, когда вы его используете - если ничего другого, он должен быть "h8".В частности, unpack "h*sx" * не может работать и выдает здесь ошибку.

3. Использование reverse также вызывает тревогу - почему бы просто не использовать шаблоны пакетов, которые имеютправильный порядковый номер для начала?

4. Хватит повторяться!Напишите функции для выполнения операций отправки и получения вместо того, чтобы переписывать один и тот же код для каждой отдельной команды.

Начало некоторого полезного кода будет следующим:

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);
}

, хотявсе это весьма умозрительно без какой-либо вменяемой спецификации для протокола - показанные вами дампы пакетов, похоже, не имеют большого отношения к предоставленному вами коду.