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
10#
11# Licensed under the Apache License, Version 2.0 (the "License"); you may
12# not use this file except in compliance with the License.
13# You may obtain a copy of the License at
14#
15# http://www.apache.org/licenses/LICENSE-2.0
16#
17# Unless required by applicable law or agreed to in writing, software
18# distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
19# WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
20# See the License for the specific language governing permissions and
21# limitations under the License.
22
23use warnings;
24use strict;
25use IO::Socket::INET;
26
27# Pack hex digits into a binary string, ignoring whitespace.
28sub parse_hex {
29    my ($hex) = @_;
30    $hex =~ s/\s+//g;
31    return pack('H*', $hex);
32}
33
34## Open a TCP connection to the specified host and port.
35sub open_connection {
36    my ($host, $port) = @_;
37    my $socket = IO::Socket::INET->new(PeerAddr => $host,
38                                       PeerPort => $port,
39                                       Proto => 'tcp',
40                                       Timeout => 1);
41    die "Cannot connect to $host:$port: $!" unless $socket;
42    return $socket;
43}
44
45## Close the TCP connection.
46sub close_connection {
47    my ($connection) = @_;
48    $connection->shutdown(2);
49    # Ignore shutdown failures (at least for now)
50    return 1;
51}
52
53## Write the given data, expressed as hexadecimal
54sub write_data {
55    my ($connection, $hexdata) = @_;
56    my $data = parse_hex($hexdata);
57    my $total_sent = 0;
58    while ($total_sent < length($data)) {
59        my $sent = $connection->send($data, 0);
60        if (!defined $sent) {
61            die "Unable to send data: $!";
62        }
63        $total_sent += $sent;
64    }
65    return 1;
66}
67
68## Read a response and check it against an expected prefix
69sub read_response {
70    my ($connection, $expected_hex) = @_;
71    my $expected_data = parse_hex($expected_hex);
72    my $start_offset = 0;
73    while ($start_offset < length($expected_data)) {
74        my $actual_data;
75        my $ok = $connection->recv($actual_data, length($expected_data));
76        if (!defined $ok) {
77            die "Unable to receive data: $!";
78        }
79        if (($actual_data ^ substr($expected_data, $start_offset)) =~ /[^\000]/) {
80            printf STDERR ("Received \\x%02x instead of \\x%02x at offset %d\n",
81                           ord(substr($actual_data, $-[0], 1)),
82                           ord(substr($expected_data, $start_offset + $-[0], 1)),
83                           $start_offset + $-[0]);
84            return 0;
85        }
86        $start_offset += length($actual_data);
87    }
88    return 1;
89}
90
91if (@ARGV != 4) {
92    print STDERR "Usage: $0 HOSTNAME PORT DATA1 RESPONSE1\n";
93    exit(3);
94}
95my ($host, $port, $data1, $response1) = @ARGV;
96my $connection = open_connection($host, $port);
97write_data($connection, $data1);
98if (!read_response($connection, $response1)) {
99    exit(1);
100}
101close_connection($connection);
102