set editor to 'vim'

[lab.git] / misc / httpbench.pl

diff --git a/misc/httpbench.pl b/misc/httpbench.pl
index c36ed64..5fdd9fb 100755 (executable)
--- a/misc/httpbench.pl
+++ b/misc/httpbench.pl
@@ -6,14 +6,17 @@ use utf8;
 
 use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat);
 use Parallel::ForkManager;
-use LWP::Simple;
-use Time::HiRes qw(sleep);
+use LWP::UserAgent;
+use Time::HiRes qw(sleep gettimeofday);
+
+usage() if (@ARGV == 0);
 
 GetOptions(
     'h|help'            => \ my $help,
     'i|inputfile=s'     => \ my $file,
     'c|concurrency=i'   => \ my $concurrency,
     'n|loops=i'         => \ my $loops,
+    'd|duration=i'      => \ my $duration,
     'w|wait=f'          => \ my $wait,
 ) or usage();
 
@@ -21,37 +24,83 @@ usage() if $help;
 
 $concurrency ||= 1;
 $loops ||= 1;
+$duration ||= 0;
 $wait ||= 0;
 
 my @urls = file2urls($file) if ($file);
 push @urls, @ARGV;
 
 my $num = scalar @urls;
-warn "$num urls with $concurrency clients, $loops loops\n";
-warn "Total: ", $num * $concurrency * $loops, " requests\n";
-warn "wait for $wait second between requests\n";
-
-
+my $l = ($duration) ? "$duration seconds loops" : "$loops loops";
+warn "$num urls with $concurrency clients, $l\n";
+warn "Total: ", $num * $concurrency * $loops, " requests\n" if (! $duration);
+warn "wait for $wait second between requests\n" if ($wait);
 
+my $ua = LWP::UserAgent->new(
+    ssl_opts => { verify_hostname => 0 },
+);
+my $transfer = 0;
 my $pm = Parallel::ForkManager->new($concurrency);
+$pm->run_on_finish(
+    sub {
+        my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $dataref) = @_;
+        if (defined $dataref) {
+            $transfer += $$dataref;
+        }
+    }
+);
+
+my ($startsec, $startmicro) = gettimeofday();
 for (my $child = 0; $child < $concurrency; $child++) {
+    use bytes;
     if ($pm->start) {
+        # parent
         warn "forks $child/$concurrency child ...\n";
-        next;
     }
-        for (my $i = 0; $i < $loops; $i++) {
+    else {
+        # child
+        my $transfer = 0;
+        my $i = 0;
+        while (1) {
+            if ($duration) {
+                last if (time() - $startsec > $duration);
+            }
+            else {
+                last if ($i >= $loops);
+            }
+            
             print STDERR "processing $i/$loops loop\r";
             foreach my $url (@urls) {
-                get($url) or warn "fail: $url\n";
+                my $res = $ua->get($url);
+                if ($res->is_success) {
+                    $transfer += length($res->content);
+                }
+                else {
+                    print STDERR "\nfail: $url";
+                }
                 sleep($wait);
             }
+            
+            $i++;
         }
-    $pm->finish;
+        $pm->finish(0, \$transfer);
+    }
 }
 $pm->wait_all_children;
+my ($endsec, $endmicro) = gettimeofday();
+my $elapsed = ($endsec - $startsec) + ($endmicro - $startmicro) / 10**6;
+my $bytepersec = $transfer / $elapsed;
 
-warn "\n ...done.\n";
+my @units = qw( B/s KiB/s MiB/s GiB/s );
+my $unit = 0;
+while ($bytepersec > 1024) {
+    $bytepersec /= 1024;
+    $unit++;
+}
+$bytepersec = sprintf("%.4g", $bytepersec);
 
+warn "\n ...done.\n";
+warn "get $transfer bytes in $elapsed seconds ($bytepersec $units[$unit])\n";
 
 sub usage {
     warn "$0 -i urls.txt -c concurrency -n loops -w wait_interval\n",