1#!/usr/bin/env perl
2
3# A simple TCP client that sends some data and expects a response.
4# Usage: tcp_client.pl HOSTNAME PORT DATA1 RESPONSE1
5#   DATA: hex-encoded data to send to the server
6#   RESPONSE: regexp that must match the server's response
7#
8# Copyright The Mbed TLS Contributors
9# SPDX-License-Identifier: Apache-2.0 OR GPL-2.0-or-later
10
11use warnings;
12use strict;
13use IO::Socket::INET;
14
15# Pack hex digits into a binary string, ignoring whitespace.
16sub parse_hex {
17    my ($hex) = @_;
18    $hex =~ s/\s+//g;
19    return pack('H*', $hex);
20}
21
22## Open a TCP connection to the specified host and port.
23sub open_connection {
24    my ($host, $port) = @_;
25    my $socket = IO::Socket::INET->new(PeerAddr => $host,
26                                       PeerPort => $port,
27                                       Proto => 'tcp',
28                                       Timeout => 1);
29    die "Cannot connect to $host:$port: $!" unless $socket;
30    return $socket;
31}
32
33## Close the TCP connection.
34sub close_connection {
35    my ($connection) = @_;
36    $connection->shutdown(2);
37    # Ignore shutdown failures (at least for now)
38    return 1;
39}
40
41## Write the given data, expressed as hexadecimal
42sub write_data {
43    my ($connection, $hexdata) = @_;
44    my $data = parse_hex($hexdata);
45    my $total_sent = 0;
46    while ($total_sent < length($data)) {
47        my $sent = $connection->send($data, 0);
48        if (!defined $sent) {
49            die "Unable to send data: $!";
50        }
51        $total_sent += $sent;
52    }
53    return 1;
54}
55
56## Read a response and check it against an expected prefix
57sub read_response {
58    my ($connection, $expected_hex) = @_;
59    my $expected_data = parse_hex($expected_hex);
60    my $start_offset = 0;
61    while ($start_offset < length($expected_data)) {
62        my $actual_data;
63        my $ok = $connection->recv($actual_data, length($expected_data));
64        if (!defined $ok) {
65            die "Unable to receive data: $!";
66        }
67        if (($actual_data ^ substr($expected_data, $start_offset)) =~ /[^\000]/) {
68            printf STDERR ("Received \\x%02x instead of \\x%02x at offset %d\n",
69                           ord(substr($actual_data, $-[0], 1)),
70                           ord(substr($expected_data, $start_offset + $-[0], 1)),
71                           $start_offset + $-[0]);
72            return 0;
73        }
74        $start_offset += length($actual_data);
75    }
76    return 1;
77}
78
79if (@ARGV != 4) {
80    print STDERR "Usage: $0 HOSTNAME PORT DATA1 RESPONSE1\n";
81    exit(3);
82}
83my ($host, $port, $data1, $response1) = @ARGV;
84my $connection = open_connection($host, $port);
85write_data($connection, $data1);
86if (!read_response($connection, $response1)) {
87    exit(1);
88}
89close_connection($connection);
90