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