scripts/tcp-banger.pl

   1 #!/usr/local/bin/perl
   2 #
   3 ## Copyright (C) 1996-2016 The Squid Software Foundation and contributors
   4 ##
   5 ## Squid software is distributed under GPLv2+ license and includes
   6 ## contributions from numerous individuals and organizations.
   7 ## Please see the COPYING and CONTRIBUTORS files for details.
   8 ##
   9
  10 # tcp-banger.pl
  11 #
  12 # Duane Wessels, Dec 1995
  13 #
  14 # Usage: tcp-banger.pl [host [port]] < url-list
  15 #
  16 # Sends a continuous stream of HTTP proxy requests to a cache.  Stdin is a
  17 # list of URLs to request.  Run N of these at the same time to simulate a
  18 # heavy client load.
  19 #
  20 # NOTE: does not simulate "real-world" events such as aborted requests
  21 # (connections) and other network problems.
  22
  23 $|=1;
  24
  25 $host=(shift || 'localhost') ;
  26 $port=(shift || '3128') ;
  27
  28 require 'sys/socket.ph';
  29
  30 $sockaddr = 'S n a4 x8';
  31 ($name, $aliases, $proto) = getprotobyname("tcp");
  32 ($fqdn, $aliases, $type, $len, $thataddr) = gethostbyname($host);
  33 $thissock = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");
  34 $that = pack($sockaddr, &AF_INET, $port, $thataddr);
  35
  36 while (<>) {
  37         chop ($url = $_);
  38
  39         die "socket: $!\n" unless
  40                 socket (SOCK, &AF_INET, &SOCK_STREAM, $proto);
  41         die "bind: $!\n" unless
  42                 bind (SOCK, $thissock);
  43         die "$host:$port: $!\n" unless
  44                 connect (SOCK, $that);
  45         select (SOCK); $| = 1;
  46         select (STDOUT);
  47
  48         print SOCK "GET $url HTTP/1.0\r\nAccept: */*\r\n\r\n";
  49         $_ = <SOCK>;
  50         ($ver,$code,$junk) = split;
  51         printf "%s %s\n", $code ? $code : 'FAIL', $url;
  52         1 while (read(SOCK,$_,4096));
  53         close SOCK;
  54 }