tcp_client.pl 3.2 KB

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