external/bsd/bind/dist/bin/tests/system/testsock.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (C) 2004, 2007, 2010-2013  Internet Systems Consortium, Inc. ("ISC")
   4 # Copyright (C) 2000, 2001  Internet Software Consortium.
   5 #
   6 # Permission to use, copy, modify, and/or distribute this software for any
   7 # purpose with or without fee is hereby granted, provided that the above
   8 # copyright notice and this permission notice appear in all copies.
   9 #
  10 # THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
  11 # REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
  12 # AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
  13 # INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  14 # LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  15 # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  16 # PERFORMANCE OF THIS SOFTWARE.
  17
  18 # Id: testsock.pl,v 1.20 2011/03/01 23:48:05 tbox Exp
  19
  20 # Test whether the interfaces on 10.53.0.* are up.
  21
  22 require 5.001;
  23
  24 use Socket;
  25 use Getopt::Long;
  26
  27 my $port = 0;
  28 my $id = 0;
  29 GetOptions("p=i" => \$port,
  30            "i=i" => \$id);
  31
  32 my @ids;
  33 if ($id != 0) {
  34         @ids = ($id);
  35 } else {
  36         @ids = (1..8);
  37 }
  38
  39 foreach $id (@ids) {
  40         my $addr = pack("C4", 10, 53, 0, $id);
  41         my $sa = pack_sockaddr_in($port, $addr);
  42         socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname("tcp"))
  43                 or die "$0: socket: $!\n";
  44         setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
  45
  46         bind(SOCK, $sa)
  47                 or die sprintf("$0: bind(%s, %d): $!\n",
  48                                inet_ntoa($addr), $port);
  49         close(SOCK);
  50 }