[512faed] | 1 | #! /usr/bin/perl -w |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | use utf8; |
---|
| 6 | |
---|
[cff45ef] | 7 | use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat); |
---|
[512faed] | 8 | use Parallel::ForkManager; |
---|
[8c96802] | 9 | use LWP::UserAgent; |
---|
[560dfd2] | 10 | use Time::HiRes qw(sleep gettimeofday); |
---|
[512faed] | 11 | |
---|
[0035554] | 12 | usage() if (@ARGV == 0); |
---|
| 13 | |
---|
[512faed] | 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, |
---|
[178d578] | 19 | 'd|duration=i' => \ my $duration, |
---|
[512faed] | 20 | 'w|wait=f' => \ my $wait, |
---|
| 21 | ) or usage(); |
---|
| 22 | |
---|
| 23 | usage() if $help; |
---|
| 24 | |
---|
| 25 | $concurrency ||= 1; |
---|
| 26 | $loops ||= 1; |
---|
[178d578] | 27 | $duration ||= 0; |
---|
[512faed] | 28 | $wait ||= 0; |
---|
| 29 | |
---|
| 30 | my @urls = file2urls($file) if ($file); |
---|
| 31 | push @urls, @ARGV; |
---|
| 32 | |
---|
| 33 | my $num = scalar @urls; |
---|
[178d578] | 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); |
---|
[560dfd2] | 37 | warn "wait for $wait second between requests\n" if ($wait); |
---|
[512faed] | 38 | |
---|
[8c96802] | 39 | my $ua = LWP::UserAgent->new( |
---|
| 40 | ssl_opts => { verify_hostname => 0 }, |
---|
| 41 | ); |
---|
[560dfd2] | 42 | my $transfer = 0; |
---|
[512faed] | 43 | my $pm = Parallel::ForkManager->new($concurrency); |
---|
[560dfd2] | 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 | } |
---|
[d6dd05b] | 50 | } |
---|
[560dfd2] | 51 | ); |
---|
| 52 | |
---|
| 53 | my ($startsec, $startmicro) = gettimeofday(); |
---|
[45d3453] | 54 | for (my $child = 0; $child < $concurrency; $child++) { |
---|
[560dfd2] | 55 | use bytes; |
---|
[45d3453] | 56 | if ($pm->start) { |
---|
| 57 | # parent |
---|
| 58 | warn "forks $child/$concurrency child ...\n"; |
---|
| 59 | } |
---|
| 60 | else { |
---|
| 61 | # child |
---|
| 62 | my $transfer = 0; |
---|
[178d578] | 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 | |
---|
[45d3453] | 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); |
---|
[560dfd2] | 77 | } |
---|
[45d3453] | 78 | else { |
---|
| 79 | print STDERR "\nfail: $url"; |
---|
| 80 | } |
---|
| 81 | sleep($wait); |
---|
[560dfd2] | 82 | } |
---|
[178d578] | 83 | |
---|
| 84 | $i++; |
---|
[45d3453] | 85 | } |
---|
[560dfd2] | 86 | $pm->finish(0, \$transfer); |
---|
| 87 | } |
---|
[512faed] | 88 | } |
---|
[45d3453] | 89 | $pm->wait_all_children; |
---|
[560dfd2] | 90 | my ($endsec, $endmicro) = gettimeofday(); |
---|
| 91 | my $elapsed = ($endsec - $startsec) + ($endmicro - $startmicro) / 10**6; |
---|
| 92 | my $bytepersec = $transfer / $elapsed; |
---|
[512faed] | 93 | |
---|
[560dfd2] | 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); |
---|
[512faed] | 101 | |
---|
[560dfd2] | 102 | warn "\n ...done.\n"; |
---|
| 103 | warn "get $transfer bytes in $elapsed seconds ($bytepersec $units[$unit])\n"; |
---|
[512faed] | 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 | } |
---|