diff options
Diffstat (limited to 'externals/mbedtls/tests/scripts/tcp_client.pl')
| -rwxr-xr-x | externals/mbedtls/tests/scripts/tcp_client.pl | 128 |
1 files changed, 0 insertions, 128 deletions
diff --git a/externals/mbedtls/tests/scripts/tcp_client.pl b/externals/mbedtls/tests/scripts/tcp_client.pl deleted file mode 100755 index 6b198960c9..0000000000 --- a/externals/mbedtls/tests/scripts/tcp_client.pl +++ /dev/null @@ -1,128 +0,0 @@ -#!/usr/bin/env perl - -# A simple TCP client that sends some data and expects a response. -# Usage: tcp_client.pl HOSTNAME PORT DATA1 RESPONSE1 -# DATA: hex-encoded data to send to the server -# RESPONSE: regexp that must match the server's response -# -# Copyright The Mbed TLS Contributors -# SPDX-License-Identifier: Apache-2.0 OR GPL-2.0-or-later -# -# This file is provided under the Apache License 2.0, or the -# GNU General Public License v2.0 or later. -# -# ********** -# Apache License 2.0: -# -# Licensed under the Apache License, Version 2.0 (the "License"); you may -# not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -# WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# ********** -# -# ********** -# GNU General Public License v2.0 or later: -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with this program; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# ********** - -use warnings; -use strict; -use IO::Socket::INET; - -# Pack hex digits into a binary string, ignoring whitespace. -sub parse_hex { - my ($hex) = @_; - $hex =~ s/\s+//g; - return pack('H*', $hex); -} - -## Open a TCP connection to the specified host and port. -sub open_connection { - my ($host, $port) = @_; - my $socket = IO::Socket::INET->new(PeerAddr => $host, - PeerPort => $port, - Proto => 'tcp', - Timeout => 1); - die "Cannot connect to $host:$port: $!" unless $socket; - return $socket; -} - -## Close the TCP connection. -sub close_connection { - my ($connection) = @_; - $connection->shutdown(2); - # Ignore shutdown failures (at least for now) - return 1; -} - -## Write the given data, expressed as hexadecimal -sub write_data { - my ($connection, $hexdata) = @_; - my $data = parse_hex($hexdata); - my $total_sent = 0; - while ($total_sent < length($data)) { - my $sent = $connection->send($data, 0); - if (!defined $sent) { - die "Unable to send data: $!"; - } - $total_sent += $sent; - } - return 1; -} - -## Read a response and check it against an expected prefix -sub read_response { - my ($connection, $expected_hex) = @_; - my $expected_data = parse_hex($expected_hex); - my $start_offset = 0; - while ($start_offset < length($expected_data)) { - my $actual_data; - my $ok = $connection->recv($actual_data, length($expected_data)); - if (!defined $ok) { - die "Unable to receive data: $!"; - } - if (($actual_data ^ substr($expected_data, $start_offset)) =~ /[^\000]/) { - printf STDERR ("Received \\x%02x instead of \\x%02x at offset %d\n", - ord(substr($actual_data, $-[0], 1)), - ord(substr($expected_data, $start_offset + $-[0], 1)), - $start_offset + $-[0]); - return 0; - } - $start_offset += length($actual_data); - } - return 1; -} - -if (@ARGV != 4) { - print STDERR "Usage: $0 HOSTNAME PORT DATA1 RESPONSE1\n"; - exit(3); -} -my ($host, $port, $data1, $response1) = @ARGV; -my $connection = open_connection($host, $port); -write_data($connection, $data1); -if (!read_response($connection, $response1)) { - exit(1); -} -close_connection($connection); |
