misc/httpbench.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat);
   8 use Parallel::ForkManager;
   9 use LWP::UserAgent;
  10 use Time::HiRes qw(sleep gettimeofday);
  11
  12 usage() if (@ARGV == 0);
  13
  14 GetOptions(
  15     'h|help'            => \ my $help,
  16     'i|inputfile=s'     => \ my $file,
  17     'c|concurrency=i'   => \ my $concurrency,
  18     'n|loops=i'         => \ my $loops,
  19     'w|wait=f'          => \ my $wait,
  20 ) or usage();
  21
  22 usage() if $help;
  23
  24 $concurrency ||= 1;
  25 $loops ||= 1;
  26 $wait ||= 0;
  27
  28 my @urls = file2urls($file) if ($file);
  29 push @urls, @ARGV;
  30
  31 my $num = scalar @urls;
  32 warn "$num urls with $concurrency clients, $loops loops\n";
  33 warn "Total: ", $num * $concurrency * $loops, " requests\n";
  34 warn "wait for $wait second between requests\n" if ($wait);
  35
  36 my $ua = LWP::UserAgent->new(
  37     ssl_opts => { verify_hostname => 0 },
  38 );
  39 my $transfer = 0;
  40 my $pm = Parallel::ForkManager->new($concurrency);
  41 $pm->run_on_finish(
  42     sub {
  43         my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $dataref) = @_;
  44         if (defined $dataref) {
  45             $transfer += $$dataref;
  46         }
  47     }
  48 );
  49
  50 my ($startsec, $startmicro) = gettimeofday();
  51 for (my $child = 0; $child < $concurrency; $child++) {
  52     use bytes;
  53     if ($pm->start) {
  54         # parent
  55         warn "forks $child/$concurrency child ...\n";
  56     }
  57     else {
  58         # child
  59         my $transfer = 0;
  60         for (my $i = 0; $i < $loops; $i++) {
  61             print STDERR "processing $i/$loops loop\r";
  62             foreach my $url (@urls) {
  63                 my $res = $ua->get($url);
  64                 if ($res->is_success) {
  65                     $transfer += length($res->content);
  66                 }
  67                 else {
  68                     print STDERR "\nfail: $url";
  69                 }
  70                 sleep($wait);
  71             }
  72         }
  73         $pm->finish(0, \$transfer);
  74     }
  75 }
  76 $pm->wait_all_children;
  77 my ($endsec, $endmicro) = gettimeofday();
  78 my $elapsed = ($endsec - $startsec) + ($endmicro - $startmicro) / 10**6;
  79 my $bytepersec = $transfer / $elapsed;
  80
  81 my @units = qw( B/s KiB/s MiB/s GiB/s );
  82 my $unit = 0;
  83 while ($bytepersec > 1024) {
  84     $bytepersec /= 1024;
  85     $unit++;
  86 }
  87 $bytepersec = sprintf("%.4g", $bytepersec);
  88
  89 warn "\n ...done.\n";
  90 warn "get $transfer bytes in $elapsed seconds ($bytepersec $units[$unit])\n";
  91
  92 sub usage {
  93     warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n",
  94          " OR...\n",
  95          "$0 url1 url2\n"
  96     ;
  97
  98     exit;
  99 }
 100
 101 sub file2urls {
 102     my $file = shift;
 103
 104     open my $fh, '<', $file or die "$file: $!";
 105
 106     my(@urls, $url);
 107     while ($url = <$fh>) {
 108         chomp $url;
 109         push @urls, $url;
 110     }
 111
 112     return @urls;
 113 }